From 220ae7bff28c34e4e0653766f3ff0939ab837e34 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 3 Aug 2020 13:16:38 -0700 Subject: [PATCH 0001/1017] Revert "[flang] Run non-gtest unit tests with lit." This reverts commit 4ef2e594d5be2e0e6d4446c8082b15466bc7ffcb. --- flang/CMakeLists.txt | 1 + flang/test/CMakeLists.txt | 7 -- flang/test/NonGtestUnit/lit.cfg.py | 16 ----- flang/test/NonGtestUnit/lit.site.cfg.py.in | 27 ------- flang/unittests/Decimal/CMakeLists.txt | 8 ++- flang/unittests/Evaluate/CMakeLists.txt | 82 ++++++++++++++++++---- llvm/utils/lit/lit/formats/__init__.py | 3 +- llvm/utils/lit/lit/formats/base.py | 17 ----- 8 files changed, 79 insertions(+), 82 deletions(-) delete mode 100644 flang/test/NonGtestUnit/lit.cfg.py delete mode 100644 flang/test/NonGtestUnit/lit.site.cfg.py.in diff --git a/flang/CMakeLists.txt b/flang/CMakeLists.txt index 009092247c001..0cccbce4b7d4b 100644 --- a/flang/CMakeLists.txt +++ b/flang/CMakeLists.txt @@ -403,6 +403,7 @@ endif() add_subdirectory(runtime) if (FLANG_INCLUDE_TESTS) + enable_testing() add_subdirectory(test) if (FLANG_GTEST_AVAIL) add_subdirectory(unittests) diff --git a/flang/test/CMakeLists.txt b/flang/test/CMakeLists.txt index 905d491708eb4..7282b8ced3208 100644 --- a/flang/test/CMakeLists.txt +++ b/flang/test/CMakeLists.txt @@ -21,13 +21,6 @@ configure_lit_site_cfg( ${CMAKE_CURRENT_SOURCE_DIR}/Unit/lit.cfg.py ) -configure_lit_site_cfg( - ${CMAKE_CURRENT_SOURCE_DIR}/NonGtestUnit/lit.site.cfg.py.in - ${CMAKE_CURRENT_BINARY_DIR}/NonGtestUnit/lit.site.cfg.py - MAIN_CONFIG - ${CMAKE_CURRENT_SOURCE_DIR}/NonGtestUnit/lit.cfg.py -) - set(FLANG_TEST_PARAMS flang_site_config=${CMAKE_CURRENT_BINARY_DIR}/lit.site.cfg.py) diff --git a/flang/test/NonGtestUnit/lit.cfg.py b/flang/test/NonGtestUnit/lit.cfg.py deleted file mode 100644 index 7f53f861bc65c..0000000000000 --- a/flang/test/NonGtestUnit/lit.cfg.py +++ /dev/null @@ -1,16 +0,0 @@ -import os - -import lit.Test - -config.name = 'flang-OldUnit' - -config.suffixes = [".test"] - -config.test_source_root = os.path.join(config.flang_obj_root, 'unittests') -config.test_exec_root = config.test_source_root - -config.test_format = lit.formats.ExecutableTest() - -path = os.path.pathsep.join((config.flang_libs_dir, config.llvm_libs_dir, - config.environment.get('LD_LIBRARY_PATH',''))) -config.environment['LD_LIBRARY_PATH'] = path diff --git a/flang/test/NonGtestUnit/lit.site.cfg.py.in b/flang/test/NonGtestUnit/lit.site.cfg.py.in deleted file mode 100644 index 3218fe0b5ce3d..0000000000000 --- a/flang/test/NonGtestUnit/lit.site.cfg.py.in +++ /dev/null @@ -1,27 +0,0 @@ -@LIT_SITE_CFG_IN_HEADER@ - -config.llvm_src_root = "@LLVM_SOURCE_DIR@" -config.llvm_obj_root = "@LLVM_BINARY_DIR@" -config.llvm_tools_dir = "@LLVM_TOOLS_DIR@" -config.llvm_libs_dir = "@LLVM_LIBS_DIR@" -config.llvm_build_mode = "@LLVM_BUILD_MODE@" -config.lit_tools_dir = "@LLVM_LIT_TOOLS_DIR@" -config.flang_obj_root = "@FLANG_BINARY_DIR@" -config.flang_src_root = "@FLANG_SOURCE_DIR@" -config.flang_libs_dir = "@LLVM_LIBRARY_OUTPUT_INTDIR@" -config.flang_tools_dir = "@LLVM_RUNTIME_OUTPUT_INTDIR@" -config.target_triple = "@TARGET_TRIPLE@" -config.python_executable = "@Python3_EXECUTABLE@" - -# Support substitution of the tools and libs dirs with user parameters. This is -# used when we can't determine the tool dir at configuration time. -try: - config.llvm_tools_dir = config.llvm_tools_dir % lit_config.params - config.llvm_libs_dir = config.llvm_libs_dir % lit_config.params - config.llvm_build_mode = config.llvm_build_mode % lit_config.params -except KeyError as e: - key, = e.args - lit_config.fatal("unable to find %r parameter, use '--param=%s=VALUE'" % (key,key)) - -# Let the main config do the real work. -lit_config.load_config(config, "@FLANG_SOURCE_DIR@/test/NonGtestUnit/lit.cfg.py") diff --git a/flang/unittests/Decimal/CMakeLists.txt b/flang/unittests/Decimal/CMakeLists.txt index d301a9d3628c5..028bcbf7a3508 100644 --- a/flang/unittests/Decimal/CMakeLists.txt +++ b/flang/unittests/Decimal/CMakeLists.txt @@ -1,5 +1,9 @@ set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}) -add_flang_nongtest_unittest(quick-sanity-test +add_executable(quick-sanity-test + quick-sanity-test.cpp +) + +target_link_libraries(quick-sanity-test FortranDecimal ) @@ -8,3 +12,5 @@ add_flang_nongtest_unittest(thorough-test SLOW_TEST FortranDecimal ) + +add_test(NAME Sanity COMMAND quick-sanity-test) diff --git a/flang/unittests/Evaluate/CMakeLists.txt b/flang/unittests/Evaluate/CMakeLists.txt index ffd821ac65eb3..ce94d99d18a8d 100644 --- a/flang/unittests/Evaluate/CMakeLists.txt +++ b/flang/unittests/Evaluate/CMakeLists.txt @@ -11,19 +11,40 @@ endif() target_link_libraries(FortranEvaluateTesting ${llvm_libs}) -add_flang_nongtest_unittest(leading-zero-bit-count +add_executable(leading-zero-bit-count-test + leading-zero-bit-count.cpp +) + +target_link_libraries(leading-zero-bit-count-test FortranEvaluateTesting ) -add_flang_nongtest_unittest(bit-population-count +add_executable(bit-population-count-test + bit-population-count.cpp +) + +target_link_libraries(bit-population-count-test FortranEvaluateTesting ) -add_flang_nongtest_unittest(uint128 +add_executable(uint128-test + uint128.cpp +) + +target_link_libraries(uint128-test FortranEvaluateTesting ) -add_flang_nongtest_unittest(expression +# These routines live in lib/Common but we test them here. +add_test(UINT128 uint128-test) +add_test(Leadz leading-zero-bit-count-test) +add_test(PopPar bit-population-count-test) + +add_executable(expression-test + expression.cpp +) + +target_link_libraries(expression-test FortranCommon FortranEvaluateTesting FortranEvaluate @@ -31,13 +52,21 @@ add_flang_nongtest_unittest(expression FortranParser ) -add_flang_nongtest_unittest(integer +add_executable(integer-test + integer.cpp +) + +target_link_libraries(integer-test FortranEvaluateTesting FortranEvaluate FortranSemantics ) -add_flang_nongtest_unittest(intrinsics +add_executable(intrinsics-test + intrinsics.cpp +) + +target_link_libraries(intrinsics-test FortranCommon FortranEvaluateTesting FortranEvaluate @@ -47,7 +76,11 @@ add_flang_nongtest_unittest(intrinsics FortranRuntime ) -add_flang_nongtest_unittest(logical +add_executable(logical-test + logical.cpp +) + +target_link_libraries(logical-test FortranEvaluateTesting FortranEvaluate FortranSemantics @@ -59,31 +92,56 @@ add_flang_nongtest_unittest(logical # C++ exceptions are enabled for this test. set(LLVM_REQUIRES_EH ON) set(LLVM_REQUIRES_RTTI ON) -add_flang_nongtest_unittest(real +add_executable(real-test + real.cpp +) +llvm_update_compile_flags(real-test) + +target_link_libraries(real-test FortranEvaluateTesting FortranEvaluate FortranDecimal FortranSemantics ) -llvm_update_compile_flags(real.test) -add_flang_nongtest_unittest(reshape +add_executable(reshape-test + reshape.cpp +) + +target_link_libraries(reshape-test FortranEvaluateTesting FortranSemantics FortranEvaluate FortranRuntime ) -add_flang_nongtest_unittest(ISO-Fortran-binding +add_executable(ISO-Fortran-binding-test + ISO-Fortran-binding.cpp +) + +target_link_libraries(ISO-Fortran-binding-test FortranEvaluateTesting FortranEvaluate FortranSemantics FortranRuntime ) -add_flang_nongtest_unittest(folding +add_executable(folding-test + folding.cpp +) + +target_link_libraries(folding-test FortranCommon FortranEvaluateTesting FortranEvaluate FortranSemantics ) + +add_test(Expression expression-test) +add_test(Integer integer-test) +add_test(Intrinsics intrinsics-test) +add_test(Logical logical-test) +add_test(Real real-test) +add_test(RESHAPE reshape-test) +add_test(ISO-binding ISO-Fortran-binding-test) +add_test(folding folding-test) diff --git a/llvm/utils/lit/lit/formats/__init__.py b/llvm/utils/lit/lit/formats/__init__.py index 7a357657670f3..3ff46e93ead2e 100644 --- a/llvm/utils/lit/lit/formats/__init__.py +++ b/llvm/utils/lit/lit/formats/__init__.py @@ -1,8 +1,7 @@ from lit.formats.base import ( # noqa: F401 TestFormat, FileBasedTest, - OneCommandPerFileTest, - ExecutableTest + OneCommandPerFileTest ) from lit.formats.googletest import GoogleTest # noqa: F401 diff --git a/llvm/utils/lit/lit/formats/base.py b/llvm/utils/lit/lit/formats/base.py index b44a606e76a82..6721d17e334e6 100644 --- a/llvm/utils/lit/lit/formats/base.py +++ b/llvm/utils/lit/lit/formats/base.py @@ -115,20 +115,3 @@ def execute(self, test, litConfig): report += """Output:\n--\n%s--""" % diags return lit.Test.FAIL, report - - -### - -# Check exit code of a simple executable with no input -class ExecutableTest(FileBasedTest): - def execute(self, test, litConfig): - if test.config.unsupported: - return lit.Test.UNSUPPORTED - - out, err, exitCode = lit.util.executeCommand(test.getSourcePath()) - - if not exitCode: - return lit.Test.PASS, '' - - return lit.Test.FAIL, out+err - From 06bb542cc7ec2d596c99851a4d0e61739653621e Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 9 Apr 2020 08:59:33 -0700 Subject: [PATCH 0002/1017] This rolls up over a year's worth of work on the flang middle-end and merges it onto a working branch. --- flang/CMakeLists.txt | 109 +- flang/LAPACK-bugs.txt | 23 + flang/README.md | 178 +- flang/documentation/BurnsideToFIR.md | 823 ++++++ flang/include/flang/Lower/ConvertExpr.h | 73 + flang/include/flang/Lower/IO.h | 4 + flang/include/flang/Lower/Intrinsics.h | 74 + flang/include/flang/Lower/Runtime.h | 4 + .../Analysis/IteratedDominanceFrontier.h | 95 + .../flang/Optimizer/Transforms/Passes.h | 1 + flang/include/flang/Version.h | 61 + flang/lib/CMakeLists.txt | 9 +- flang/lib/Decimal/binary-to-decimal.cpp | 40 +- flang/lib/Lower/Bridge.cpp | 1470 ++++++++++ flang/lib/Lower/CMakeLists.txt | 4 + flang/lib/Lower/ConvertExpr.cpp | 1478 +++++++++- flang/lib/Lower/Intrinsics.cpp | 739 +++++ flang/lib/Lower/Runtime.cpp | 108 + flang/lib/Optimizer/CMakeLists.txt | 9 +- flang/lib/Optimizer/CodeGen.cpp | 2404 +++++++++++++++++ .../Optimizer/IteratedDominanceFrontier.cpp | 107 + flang/lib/Optimizer/StdConverter.cpp | 231 ++ flang/lib/Optimizer/Transforms/CMakeLists.txt | 14 + flang/lib/Optimizer/Transforms/CSE.cpp | 325 +++ flang/lib/Optimizer/Transforms/MemToReg.cpp | 761 ++++++ .../lib/Optimizer/Transforms/RewriteLoop.cpp | 202 ++ flang/lib/Semantics/CMakeLists.txt | 2 + flang/not-test/fir/addrof.1.fir | 7 + flang/not-test/fir/aggregate.fir | 11 + flang/not-test/fir/alloc.fir | 21 + flang/not-test/fir/arrayset.fir | 16 + flang/not-test/fir/bugs/bug0001.fir | 41 + flang/not-test/fir/bugs/bug0002.fir | 12 + flang/not-test/fir/character.fir | 12 + flang/not-test/fir/commute.fir | 21 + flang/not-test/fir/compare.fir | 29 + flang/not-test/fir/complex.fir | 22 + flang/not-test/fir/complex.mlir | 6 + flang/not-test/fir/constant.fir | 19 + flang/not-test/fir/dynlayout.fir | 38 + flang/not-test/fir/embox.fir | 6 + flang/not-test/fir/fir-dt.fir | 5 + flang/not-test/lower/expr-test-generator.cc | 692 +++++ .../lower/test_expression_lowering.sh | 55 + flang/runtime/CMakeLists.txt | 8 +- flang/runtime/io-api.h | 4 + flang/test/CMakeLists.txt | 14 +- flang/test/Examples/hello.f90 | 14 + flang/test/Examples/main.c | 14 + flang/test/Fir/char01.fir | 13 + flang/test/Fir/complex.fir | 82 + flang/test/Fir/coordinate01.fir | 19 + flang/test/Fir/cse.fir | 50 + flang/test/Fir/embox-write.fir | 18 + flang/test/Fir/global.fir | 34 + flang/test/Fir/loop.fir | 22 + flang/test/Fir/loop10.fir | 24 + flang/test/Fir/print_complex.c | 5 + flang/test/Fir/real.fir | 51 + flang/test/Fir/recursive-type.fir | 11 + flang/test/Fir/select-type.fir | 22 + flang/test/Fir/select.fir | 63 + flang/test/Fir/widechar.fir | 22 + flang/test/Lower/arguments.f90 | 23 + flang/test/Lower/array-init-driver.c | 24 + flang/test/Lower/array-init.f90 | 48 + flang/test/Lower/call-site-mangling.f90 | 52 + flang/test/Lower/character-assignment.f90 | 106 + flang/test/Lower/control-flow.f90 | 25 + ...end-to-end-character-assignment-driver.cpp | 357 +++ .../Lower/end-to-end-character-assignment.f90 | 76 + flang/test/Lower/integer-operations.f90 | 111 + flang/test/Lower/io-stmt.f90 | 52 + flang/test/Lower/logical-operations.f90 | 67 + .../test/Lower/program-units-fir-mangling.f90 | 117 + flang/test/Lower/real-operations.f90 | 111 + flang/test/lit.cfg.py | 20 + flang/test/lit.site.cfg.py.in | 7 +- flang/tools/CMakeLists.txt | 15 +- flang/tools/bbc/CMakeLists.txt | 20 + flang/tools/bbc/bbc.cpp | 274 ++ flang/tools/f18/CMakeLists.txt | 3 + flang/tools/tco/CMakeLists.txt | 1 + flang/tools/tco/tco.cpp | 56 +- 84 files changed, 12234 insertions(+), 182 deletions(-) create mode 100644 flang/LAPACK-bugs.txt create mode 100644 flang/documentation/BurnsideToFIR.md create mode 100644 flang/include/flang/Lower/ConvertExpr.h create mode 100644 flang/include/flang/Lower/Intrinsics.h create mode 100644 flang/include/flang/Optimizer/Analysis/IteratedDominanceFrontier.h create mode 100644 flang/include/flang/Version.h create mode 100644 flang/lib/Lower/Bridge.cpp create mode 100644 flang/lib/Lower/Intrinsics.cpp create mode 100644 flang/lib/Lower/Runtime.cpp create mode 100644 flang/lib/Optimizer/CodeGen.cpp create mode 100644 flang/lib/Optimizer/IteratedDominanceFrontier.cpp create mode 100644 flang/lib/Optimizer/StdConverter.cpp create mode 100644 flang/lib/Optimizer/Transforms/CMakeLists.txt create mode 100644 flang/lib/Optimizer/Transforms/CSE.cpp create mode 100644 flang/lib/Optimizer/Transforms/MemToReg.cpp create mode 100644 flang/lib/Optimizer/Transforms/RewriteLoop.cpp create mode 100644 flang/not-test/fir/addrof.1.fir create mode 100644 flang/not-test/fir/aggregate.fir create mode 100644 flang/not-test/fir/alloc.fir create mode 100644 flang/not-test/fir/arrayset.fir create mode 100644 flang/not-test/fir/bugs/bug0001.fir create mode 100644 flang/not-test/fir/bugs/bug0002.fir create mode 100644 flang/not-test/fir/character.fir create mode 100644 flang/not-test/fir/commute.fir create mode 100644 flang/not-test/fir/compare.fir create mode 100644 flang/not-test/fir/complex.fir create mode 100644 flang/not-test/fir/complex.mlir create mode 100644 flang/not-test/fir/constant.fir create mode 100644 flang/not-test/fir/dynlayout.fir create mode 100644 flang/not-test/fir/embox.fir create mode 100644 flang/not-test/fir/fir-dt.fir create mode 100644 flang/not-test/lower/expr-test-generator.cc create mode 100755 flang/not-test/lower/test_expression_lowering.sh create mode 100644 flang/test/Examples/hello.f90 create mode 100644 flang/test/Examples/main.c create mode 100644 flang/test/Fir/char01.fir create mode 100644 flang/test/Fir/complex.fir create mode 100644 flang/test/Fir/coordinate01.fir create mode 100644 flang/test/Fir/cse.fir create mode 100644 flang/test/Fir/embox-write.fir create mode 100644 flang/test/Fir/global.fir create mode 100644 flang/test/Fir/loop.fir create mode 100644 flang/test/Fir/loop10.fir create mode 100644 flang/test/Fir/print_complex.c create mode 100644 flang/test/Fir/real.fir create mode 100644 flang/test/Fir/recursive-type.fir create mode 100644 flang/test/Fir/select-type.fir create mode 100644 flang/test/Fir/select.fir create mode 100644 flang/test/Fir/widechar.fir create mode 100644 flang/test/Lower/arguments.f90 create mode 100644 flang/test/Lower/array-init-driver.c create mode 100644 flang/test/Lower/array-init.f90 create mode 100644 flang/test/Lower/call-site-mangling.f90 create mode 100644 flang/test/Lower/character-assignment.f90 create mode 100644 flang/test/Lower/control-flow.f90 create mode 100644 flang/test/Lower/end-to-end-character-assignment-driver.cpp create mode 100644 flang/test/Lower/end-to-end-character-assignment.f90 create mode 100644 flang/test/Lower/integer-operations.f90 create mode 100644 flang/test/Lower/io-stmt.f90 create mode 100644 flang/test/Lower/logical-operations.f90 create mode 100644 flang/test/Lower/program-units-fir-mangling.f90 create mode 100644 flang/test/Lower/real-operations.f90 create mode 100644 flang/tools/bbc/CMakeLists.txt create mode 100644 flang/tools/bbc/bbc.cpp diff --git a/flang/CMakeLists.txt b/flang/CMakeLists.txt index 0cccbce4b7d4b..368378f859f7c 100644 --- a/flang/CMakeLists.txt +++ b/flang/CMakeLists.txt @@ -2,6 +2,8 @@ cmake_minimum_required(VERSION 3.13.4) set(CMAKE_BUILD_WITH_INSTALL_NAME_DIR ON) +option(FLANG_BUILD_NEW_DRIVER "Build the flang compiler driver" OFF) + # Flang requires C++17. set(CMAKE_CXX_STANDARD 17) set(CMAKE_CXX_STANDARD_REQUIRED TRUE) @@ -17,7 +19,17 @@ if (CMAKE_SOURCE_DIR STREQUAL CMAKE_BINARY_DIR AND NOT MSVC_IDE) `CMakeFiles'. Please delete them.") endif() -option(FLANG_ENABLE_WERROR "Fail and stop building flang if a warning is triggered." OFF) +# Add Flang-centric modules to cmake path. +list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/cmake/modules") +include(AddFlang) + +if (MSVC) + set(_FLANG_ENABLE_WERROR_DEFAULT OFF) +else () + set(_FLANG_ENABLE_WERROR_DEFAULT "${LLVM_ENABLE_WERROR}") +endif() +option(FLANG_ENABLE_WERROR "Fail and stop building flang if a warning is triggered." + "${_FLANG_ENABLE_WERROR_DEFAULT}") # Check for a standalone build and configure as appropriate from # there. @@ -26,11 +38,6 @@ if (CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) project(Flang) set(FLANG_STANDALONE_BUILD ON) - # For in-tree builds, this variable is inherited from - # llvm-project/llvm/CMakeLists.txt. For out-of-tree builds, we need a - # separate definition. - option(FLANG_BUILD_NEW_DRIVER "Build the flang compiler driver" ON) - set(FLANG_BINARY_DIR ${CMAKE_CURRENT_BINARY_DIR}) if (NOT MSVC_IDE) set(LLVM_ENABLE_ASSERTIONS ${ENABLE_ASSERTIONS} @@ -39,7 +46,7 @@ if (CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) mark_as_advanced(LLVM_ENABLE_ASSERTIONS) endif() - # We need a pre-built/installed version of LLVM. + # We need a pre-built/installed version of LLVM and MLIR. find_package(LLVM REQUIRED HINTS "${LLVM_CMAKE_PATH}") # If the user specifies a relative path to LLVM_DIR, the calls to include # LLVM modules fail. Append the absolute path to LLVM_DIR instead. @@ -47,33 +54,23 @@ if (CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) list(APPEND CMAKE_MODULE_PATH ${LLVM_DIR_ABSOLUTE}) if(FLANG_BUILD_NEW_DRIVER) - # Users might specify a path to CLANG_DIR that's: - # * a full path, or - # * a path relative to the path of this script. - # Append the absolute path to CLANG_DIR so that find_package works in both - # cases. - get_filename_component( - CLANG_DIR_ABSOLUTE - ${CLANG_DIR} - REALPATH - ${CMAKE_CURRENT_SOURCE_DIR}) - list(APPEND CMAKE_MODULE_PATH ${CLANG_DIR_ABSOLUTE}) - # TODO: Remove when libclangDriver is lifted out of Clang - find_package(Clang REQUIRED PATHS "${CLANG_DIR_ABSOLUTE}" NO_DEFAULT_PATH) - if (NOT Clang_FOUND) - message(FATAL_ERROR "Failed to find Clang") - endif() + list(APPEND CMAKE_MODULE_PATH ${CLANG_DIR}) + find_package(Clang REQUIRED HINTS "${CLANG_DIR}") endif() + find_package(MLIR REQUIRED HINTS "${MLIR_CMAKE_PATH}") + list(APPEND CMAKE_MODULE_PATH ${MLIR_DIR}) + # If LLVM links to zlib we need the imported targets so we can too. if(LLVM_ENABLE_ZLIB) find_package(ZLIB REQUIRED) endif() option(LLVM_ENABLE_PEDANTIC "Compile with pedantic enabled." ON) - if(CMAKE_COMPILER_IS_GNUCXX) - set(USE_NO_MAYBE_UNINITIALIZED 1) - endif() + + # They are used as destination of target generators. + set(LLVM_RUNTIME_OUTPUT_INTDIR ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_CFG_INTDIR}/bin) + set(LLVM_LIBRARY_OUTPUT_INTDIR ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_CFG_INTDIR}/lib${LLVM_LIBDIR_SUFFIX}) include(CMakeParseArguments) include(AddLLVM) @@ -111,6 +108,8 @@ if (CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) # should not be suppressed). include_directories(SYSTEM ${LLVM_INCLUDE_DIRS}) add_definitions(${LLVM_DEFINITIONS}) + include_directories(SYSTEM ${MLIR_INCLUDE_DIRS}) + add_definitions(${MLIR_DEFINITIONS}) # LLVM's cmake configuration files currently sneak in a c++11 flag. # We look for it here and remove it from Flang's compile flags to @@ -128,6 +127,10 @@ if (CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) link_directories("${LLVM_LIBRARY_DIR}") + set(LLVM_TOOLS_BINARY_DIR ${TOOLS_BINARY_DIR} CACHE PATH "Path to llvm/bin") + find_program(MLIR_TABLEGEN_EXE "mlir-tblgen" ${LLVM_TOOLS_BINARY_DIR} + NO_DEFAULT_PATH) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin) set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib${LLVM_LIBDIR_SUFFIX}) @@ -189,12 +192,7 @@ else() ${LLVM_INCLUDE_TESTS}) set(FLANG_GTEST_AVAIL 1) - if(FLANG_STANDALONE_BUILD) - set(FLANG_BINARY_DIR ${CMAKE_BINARY_DIR}/tools/flang) - else() - set(FLANG_BINARY_DIR ${CMAKE_CURRENT_BINARY_DIR}) - endif() - + set(FLANG_BINARY_DIR ${CMAKE_BINARY_DIR}/tools/flang) set(BACKEND_PACKAGE_STRING "${PACKAGE_STRING}") set(MLIR_MAIN_SRC_DIR ${LLVM_MAIN_SRC_DIR}/../mlir/include ) # --src-root set(MLIR_INCLUDE_DIR ${LLVM_MAIN_SRC_DIR}/../mlir/include ) # --includedir @@ -203,8 +201,6 @@ else() include_directories(SYSTEM ${MLIR_INCLUDE_DIR}) include_directories(SYSTEM ${MLIR_TABLEGEN_OUTPUT_DIR}) endif() -set(FLANG_INTRINSIC_MODULES_DIR ${CMAKE_BINARY_DIR}/include/flang) -set(FLANG_INCLUDE_DIR ${FLANG_BINARY_DIR}/include) if(FLANG_BUILD_NEW_DRIVER) # TODO: Remove when libclangDriver is lifted out of Clang @@ -229,13 +225,34 @@ endif() # Always build tco tool set(LLVM_BUILD_TOOLS ON) +# Add Flang-centric modules to cmake path. include_directories(BEFORE ${FLANG_BINARY_DIR}/include ${FLANG_SOURCE_DIR}/include) +if(MLIR_SOURCE_DIR) + include_directories(BEFORE + ${FLANG_BINARY_DIR}/include + ${FLANG_SOURCE_DIR}/include + ${MLIR_BINARY_DIR}/include + ${MLIR_SOURCE_DIR}/include + ) + set(MLIR_MAIN_SRC_DIR ${MLIR_SOURCE_DIR}) + set(MLIR_INCLUDE_DIR ${MLIR_SOURCE_DIR}/include) +else() + include_directories(BEFORE + ${FLANG_BINARY_DIR}/include + ${FLANG_SOURCE_DIR}/include + ${MLIR_BINARY_DIR}/include + ) + set(MLIR_MAIN_SRC_DIR ${MLIR_BINARY_DIR}) + set(MLIR_INCLUDE_DIR ${MLIR_BINARY_DIR}/include) +endif() + +set(MLIR_TABLEGEN_EXE mlir-tblgen) + # Add Flang-centric modules to cmake path. list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/cmake/modules") -include(AddFlang) if (NOT DEFAULT_SYSROOT) set(DEFAULT_SYSROOT "" CACHE PATH @@ -322,6 +339,9 @@ if (FLANG_ENABLE_WERROR) append("-Werror" CMAKE_C_FLAGS CMAKE_CXX_FLAGS) append("-Wno-error" CMAKE_REQUIRED_FLAGS) endif( LLVM_COMPILER_IS_GCC_COMPATIBLE ) + if (NOT LLVM_ENABLE_WERROR) + message(WARNING "FLANG_ENABLE_WERROR setting is different from LLVM_ENABLE_WERROR.") + endif() endif() # Builtin check_cxx_compiler_flag doesn't seem to work correctly @@ -358,6 +378,10 @@ if (LLVM_COMPILER_IS_GCC_COMPATIBLE) set(CMAKE_CXX_FLAGS_DEBUG "${CMAKE_CXX_FLAGS_DEBUG} -DDEBUGF18") set(CMAKE_CXX_FLAGS_MINSIZEREL "${CMAKE_CXX_FLAGS_MINSIZEREL} -DCHECK=\"(void)\"") + if (GCC) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} --gcc-toolchain=${GCC}") + endif() + # Building shared libraries is bad for performance with GCC by default # due to the need to preserve the right to override external entry points if (BUILD_SHARED_LIBS AND NOT (CMAKE_CXX_COMPILER_ID MATCHES "Clang")) @@ -410,6 +434,11 @@ if (FLANG_INCLUDE_TESTS) endif () endif() +option(FLANG_INCLUDE_TESTS + "Generate build targets for the Flang unit tests." + ON) +enable_testing() + option(FLANG_INCLUDE_DOCS "Generate build targets for the Flang docs." ${LLVM_INCLUDE_DOCS}) if (FLANG_INCLUDE_DOCS) @@ -448,12 +477,6 @@ if (NOT LLVM_INSTALL_TOOLCHAIN_ONLY) PATTERN "*.td" PATTERN "config.h" EXCLUDE PATTERN ".git" EXCLUDE - PATTERN "CMakeFiles" EXCLUDE) - - install(DIRECTORY ${FLANG_INCLUDE_DIR}/flang - DESTINATION include - COMPONENT flang-headers - FILES_MATCHING - PATTERN "*.inc" - ) + PATTERN "CMakeFiles" EXCLUDE + PATTERN "*") endif() diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt new file mode 100644 index 0000000000000..b1da627c1127b --- /dev/null +++ b/flang/LAPACK-bugs.txt @@ -0,0 +1,23 @@ +NEED ATTENTION +______________ + +[Eric] error: branch has N operands for successor #M, but target block has K +[Eric] UNREACHABLE executed at Lower/ConvertExpr.cpp:403! CHAR comparison + +[Varun] UNREACHABLE executed at Lower/Bridge.cpp:1061! DATA +[Varun] UNREACHABLE executed at Lower/Bridge.cpp:1241! local w/ initializer (implied SAVE) + +UNREACHABLE executed at Lower/Bridge.cpp:1236! adjustable array? +UNREACHABLE executed at Lower/ConvertExpr.cpp:798! intrinsic subroutine + +FIXED +_____ + +UNREACHABLE executed at Lower/IO.cpp:764! FORMAT + +UNREACHABLE executed at Lower/ConvertExpr.cpp:848! temps on call? + +Block.cpp:200: mlir::Operation *mlir::Block::getTerminator(): Assertion `!empty() && !back().isKnownNonTerminator()' failed. + +error: 'std.return' op must be the last operation in the parent block + diff --git a/flang/README.md b/flang/README.md index 326505eb1ee3b..a8a5080d3ab2c 100644 --- a/flang/README.md +++ b/flang/README.md @@ -1,26 +1,13 @@ -# Flang -Flang is a ground-up implementation of a Fortran front end written in modern -C++. It started off as the f18 project (https://github.com/flang-compiler/f18) -with an aim to replace the previous flang project -(https://github.com/flang-compiler/flang) and address its various deficiencies. -F18 was subsequently accepted into the LLVM project and rechristened as Flang. +# FIR -## Getting Started +This file should not be upstreamed to llvm-project. -Read more about flang in the [docs directory](docs). -Start with the [compiler overview](docs/Overview.md). +## Monorepo now contains Flang! -To better understand Fortran as a language -and the specific grammar accepted by flang, -read [Fortran For C Programmers](docs/FortranForCProgrammers.md) -and -flang's specifications of the [Fortran grammar](docs/f2018-grammar.md) -and -the [OpenMP grammar](docs/OpenMP-4.5-grammar.md). +### In-tree build -Treatment of language extensions is covered -in [this document](docs/Extensions.md). +1. Get the stuff. To understand the compilers handling of intrinsics, see the [discussion of intrinsics](docs/Intrinsics.md). @@ -36,122 +23,105 @@ also review [how flang uses modern C++ features](docs/C++17.md). If you are interested in writing new documentation, follow [markdown style guide from LLVM](https://github.com/llvm/llvm-project/blob/main/llvm/docs/MarkdownQuickstartTemplate.md). -## Supported C++ compilers +2. Get "on" the right branches. -Flang is written in C++17. +``` + (cd f18-llvm-project ; git checkout fir-dev) +``` -The code has been compiled and tested with -GCC versions from 7.2.0 to 9.3.0. +3. (not needed!) + +4. Create a build space for cmake and make (or ninja) -The code has been compiled and tested with -clang version 7.0, 8.0, 9.0 and 10.0 -using either GNU's libstdc++ or LLVM's libc++. +``` + mkdir build + cd build + cmake ../f18-llvm-project/llvm -DCMAKE_BUILD_TYPE=RelWithDebInfo -DLLVM_TARGETS_TO_BUILD=X86 -DLLVM_ENABLE_PROJECTS="flang;mlir" -DCMAKE_CXX_STANDARD=17 -DLLVM_BUILD_TOOLS=On -DLLVM_INSTALL_UTILS=On +``` -The code has been compiled on -AArch64, x86\_64 and ppc64le servers -with CentOS7, Ubuntu18.04, Rhel, MacOs, Mojave, XCode and -Apple Clang version 10.0.1. +5. Build everything -The code does not compile with Windows and a compiler that does not have -support for C++17. +``` + make + make check-flang + make install +``` -## Building Flang out of tree -These instructions are for building Flang separately from LLVM; if you are -building Flang alongside LLVM then follow the standard LLVM build instructions -and add flang to `LLVM_ENABLE_PROJECTS` instead, as detailed there. +### Out-of-tree build -### LLVM dependency +Assuming someone was nice enough to build MLIR and LLVM libraries and +install them in a convenient place for you, then you may want to do a +standalone build. -The instructions to build LLVM can be found at -https://llvm.org/docs/GettingStarted.html. If you are building flang as part -of LLVM, follow those instructions and add flang to `LLVM_ENABLE_PROJECTS`. +1. Get the stuff is the same as above. Get the code from the same repos. -We highly recommend using the same compiler to compile both llvm and flang. +2. Get on the right branches. Again, same as above. -The flang CMakeList.txt file uses -* `LLVM_DIR` to find the installed LLVM components -* `MLIR_DIR` to find the installed MLIR components -* `CLANG_DIR` to find the installed Clang components +3. Create a build space for cmake and make (or ninja) -To get the correct LLVM, MLIR and Clang libraries included in your flang build, -define `LLVM_DIR`, `MLIR_DIR` and `CLANG_DIR` on the cmake command line. ``` -LLVM=/lib/cmake/llvm \ -MLIR=/lib/cmake/mlir \ -CLANG=/lib/cmake/clang \ -cmake -DLLVM_DIR=$LLVM -DMLIR_DIR=$MLIR -DCLANG_DIR=$CLANG ... + mkdir build + cd build + export CC= + export CXX= + cmake -GNinja ../f18-llvm-project/llvm -DCMAKE_BUILD_TYPE=Release -DLLVM_TARGETS_TO_BUILD=X86 -DLLVM_ENABLE_PROJECTS=mlir -DCMAKE_CXX_STANDARD=17 -DLLVM_BUILD_TOOLS=On -DLLVM_INSTALL_UTILS=On -DCMAKE_INSTALL_PREFIX= ``` -where `LLVM_BUILD_DIR` is -the top-level directory where LLVM was built. - -### Building flang with GCC - -By default, -cmake will search for g++ on your PATH. -The g++ version must be one of the supported versions -in order to build flang. -Or, cmake will use the variable CXX to find the C++ compiler. CXX should include -the full path to the compiler or a name that will be found on your PATH, e.g. -g++-8.3, assuming g++-8.3 is on your PATH. +5. Build and install ``` -export CXX=g++-8.3 + ninja + ninja install ``` -or + +6. Add the new installation to your PATH + ``` -CXX=/opt/gcc-8.3/bin/g++-8.3 cmake ... + PATH=/bin:$PATH ``` -### Building flang with clang - -To build flang with clang, -cmake needs to know how to find clang++ -and the GCC library and tools that were used to build clang++. +7. Create a build space for another round of cmake and make (or ninja) -CXX should include the full path to clang++ -or clang++ should be found on your PATH. ``` -export CXX=clang++ + mkdir build-flang + cd build-flang + cmake -GNinja ../f18 -DLLVM_DIR= -DCMAKE_BUILD_TYPE=RelWithDebInfo -DLLVM_TARGETS_TO_BUILD=X86 -DCMAKE_CXX_STANDARD=17 -DLLVM_BUILD_TOOLS=On -DCMAKE_INSTALL_PREFIX= ``` +Note: if you plan on running lit regression tests, you should either: +- Use `-DLLVM_DIR=` instead of `-DLLVM_DIR=` +- Or, keep `-DLLVM_DIR=` but add `-DLLVM_EXTERNAL_LIT=`. +A valid `llvm-lit` path is `/bin/llvm-lit`. +Note that LLVM must also have been built with `-DLLVM_INSTALL_UTILS=On` so that tools required by tests like `FileCheck` are available in ``. -### Installation Directory +8. Build and install -To specify a custom install location, -add -`-DCMAKE_INSTALL_PREFIX=` -to the cmake command -where `` -is the path where flang should be installed. - -### Build Types +``` + ninja + ninja check-flang + ninja install +``` -To create a debug build, -add -`-DCMAKE_BUILD_TYPE=Debug` -to the cmake command. -Debug builds execute slowly. +### Running regression tests -To create a release build, -add -`-DCMAKE_BUILD_TYPE=Release` -to the cmake command. -Release builds execute quickly. +Inside `build` for in-tree builds or inside `build-flang` for out-of-tree builds: -### Build Flang out of tree ``` -cd ~/flang/build -cmake -DLLVM_DIR=$LLVM -DMLIR_DIR=$MLIR -DCLANG_DIR=$CLANG ~/flang/src -make + ninja check-flang ``` -### Disable The New Flang Driver -The new Flang compiler driver, `flang-new`, is implemented in terms of -`clangDriver` and hence it introduces a dependency on Clang. This dependency is -otherwise not required. If you do not require the new driver, you can disable -it by adding `-DFLANG_BUILD_NEW_DRIVER=OFF` to your CMake invocation. With the -new driver disabled, you no longer need to add `clang` to -`LLVM_ENABLE_PROJECTS` (or to specify `CLANG_DIR` when building out-of-tree). +### Build The New Flang Driver +The new Flang driver, `flang-new`, is currently under active development and +should be considered as an experimental feature. For this reason it is disabled +by default. This will change once the new driver replaces the _throwaway_ +driver, `flang`. + +In order to build the new driver, add `-DFLANG_BUILD_NEW_DRIVER=ON` to your +CMake invocation line. Additionally, when building out-of-tree, use `CLANG_DIR` +(similarly to `LLVM_DIR` and `MLIR_DIR`) to find the installed Clang +components. + +**Note:** `CLANG_DIR` is only required when building the new Flang driver, +which currently depends on Clang. # How to Run Tests @@ -212,7 +182,7 @@ make check-flang # How to Generate Documentation ## Generate FIR Documentation -If flang was built with `-DLINK_WITH_FIR=On` (`On` by default), it is possible to +It is possible to generate FIR language documentation by running `make flang-doc`. This will create `docs/Dialect/FIRLangRef.md` in flang build directory. diff --git a/flang/documentation/BurnsideToFIR.md b/flang/documentation/BurnsideToFIR.md new file mode 100644 index 0000000000000..de4d1ff44dd9b --- /dev/null +++ b/flang/documentation/BurnsideToFIR.md @@ -0,0 +1,823 @@ +## Burnside: The Bridge from the Fortran front-end to FIR + +This document sketches the translation of various Fortran snippets from +their syntactic level to how they ought to be represented in FIR. These +translations are representative and written in pseudo-code. + +This document shows examples of how Fortran fragments might be lowered into +FIR fragments. The style used throughout the document is to first show the +Fortran code fragment above a line and the FIR code fragment below the +line. + +### Program Units (PROGRAM, MODULE, and SUBMODULE) + +FIR has one flat global namespace. The global namespace can be populated +by Ops that represent code (functions), data (variables, constants), and +auxiliary structures (dispatch tables). + +Name collisions and scoping will be handled by a name mangling scheme. This +scheme ought to be a bijection from the tree of Fortran syntactic symbols +to and from the set of mangled names. + +A `PROGRAM` will necessarily have its executable definition wrapped in a +FIR `func` like a `SUBROUTINE`. Again, it is assumed the name mangling +scheme will provide a mapping to a distinct name. + +### Procedures (FUNCTION and SUBROUTINE) + +```fortran + FUNCTION foo (arg1, arg2) RESULT retval + + SUBROUTINE bar (arg1, arg2) +``` +---- +```mlir + func @foo(!fir.ref, !fir.ref) -> !TR + func @bar(!fir.ref, !fir.ref) +``` + +MLIR is strongly typed, so the types of the arguments and return value(s), +if any, must be explicitly specified. (Here, `arg1`, `arg2`, and `retval` +have the types `!T1`, `!T2`, and `!TR`, resp.) Also reflected is the +default calling convention: Fortran passes arguments by reference. + +#### Internal subprograms + +These will be lowered as any other `SUBROUTINE`. The difference will be +that they may take an extra `tuple` reference argument to refer to +variables in the host context. Host associated variables must be bundled +and passed explicitly on the FIR side. An example will be detailed below. + +#### Statement functions + +These are very simple internal subroutines, in a sense. They will be +lowered in the same way. + +### Non-executable statements + +#### Data + +Some non-executable statements may create constant (`PARAMETER`) or +variable data. This information should be lowered. + +##### Constants + +```fortran + INTEGER, PARAMETER :: x = 1 + CHARACTER (LEN = 10), PARAMETER :: DIGITS = "0123456789" +``` +---- +```mlir + %0 = constant 1 : i32 + + fir.global @_QG_digits constant : !fir.array<10:!fir.char<1>> { + constant '0' : !fir.char<1> + ... + constant '9' : !fir.char<1> + } +``` + +##### Local Variable + +```fortran + CHARACTER (LEN = 1) :: digit + INTEGER :: i +``` +---- +```mlir + %len = constant 1 : i32 + %digit = fir.alloca !fir.char<1>, %len : !fir.ref> + %i = fir.alloca i32 : !fir.ref +``` + +Note that in MLIR, the `%` sigil denotes an ssa-value, the `@` sigil +denotes a global symbol, and the `!` sigil denotes a type. + +##### Process lifetime variable + +```fortran + COMMON /X/ A(10),B(10) + + MODULE mymod + INTEGER a + + SUBROUTINE subr() + REAL, SAVE :: s + DATA s/12.0/ +``` +---- +```mlir + fir.global @common_x : tuple, !fir.array<10 : f32>> {} + + fir.global @mymod_a : i32 {} + + fir.global @subr_s : f32 { + constant 12.0 : f32 + } +``` + +The empty initializer region could mean these variables are placed in the +`.bss` section. + +#### Other non-executable statements + +These statements will define other properties of how the Fortran gets +lowered. For example, a variable in a `COMMON` block needs to reside in a +`fir.global`, or the structure of a derived type (user-defined record), +which would be reflected in a `!fir.type`. + +#### A note on TYPEs + +A FIR type is an synthesis of the Fortran concepts of type, attributes, and +type parameters. + +##### Intrinsic types + +For Fortran intrinsic types, there is a direct translation to a FIR type. + +```fortran + REAL(4) a + COMPLEX(8) b + CHARACTER(1,LEN=4) c + LOGICAL(1) d + INTEGER(4) e + + CHARACTER(1,LEN=*) f +``` +---- +```mlir + %a = ... : !fir.real<4> + %b = ... : !fir.complex<8> + %c = ... : !fir.array<4:!fir.char<1>> + %d = ... : !fir.logical<1> + %e = ... : !fir.int<4> + + %f_data = ... : !fir.ref>> + %f_len = ... : i32 + %f = fir.emboxchar %f_data, %f_len : !fir.boxchar<1> +``` + +The bridge will have a mapping of what the front-end kind value must map to +in the internal representation. For example, the f18 front-end maps kind +values for integers to the size in bytes of the integer representation. +Such mappings must be provided for all intrinsic type kind values. + +The Fortran `CHARACTER` variable, `f`, is a bit more complicated as there +is both a reference to a buffer (that contains the characters) and an +extra, assumed length, `LEN` type parameter to keep track of the length of +the buffer. The buffer is a sequence of `!fir.char<1>` values in memory. +The pair, `(buffer, len)`, may be boxed in a `!fir.boxchar<1>` type +object. + +##### Derived types + +Fortran also has derived types and these are supported with a more +elaborate record syntax. + +```fortran + TYPE :: person + CHARACTER(LEN=20) :: name + INTEGER :: age + END TYPE + + TYPE(person) :: george +``` +---- +```mlir + %george = ... : !fir.type>, age : i32}> +``` + +Fortran allows the compiler to reorder the fields in the derived type. +`SEQUENCE` can be used to disable reordering. (Name mangling can provide a +compile-time distinction, as needed.) + +Fortran allows a derived type to have type parameters. There are `KIND` +type parameters and `LEN` type parameters. A `KIND` type parameter is a +compile-time known constant. As such, it is possible for the compiler +implementation to create a distinct type for each set of `KIND` type +parameters (by name mangling, for instance). + +The `LEN` type parameters are runtime constant and not necessarily known at +compile-time. These values must be provided when constructing a value of +derived type in FIR, just as regular fields must be provided. (That does +not preclude an optimizer from eliminating unused `LEN` parameters.) + +Because of Fortran's `LEN` type parameters, an implementation is allowed to +defer the size and layout of an entity of derived type until runtime. + +Lowering may also exploit ad hoc product types created as needed. This can +be done using the standard dialect `tuple` type. + +##### Arrays + +An entity with type _T_ and a `DIMENSION` attribute is an array with +elements of type _T_ in Fortran. + +```fortran + INTEGER arr + DIMENSION arr(10,20) +``` +---- +```mlir + %arr = ... : !fir.array<10x20 : i32> +``` + +A FIR array is laid out in column-major order exactly like a Fortran array. + +##### Pointer and reference types + +The attribute `POINTER` can be used similarly to create a pointer entity. +The `ALLOCATABLE` attribute is another Fortran attribute that can be used +to indicate an entity's storage is to be allocated at runtime. As mentiond +previosuly, Fortran uses pass-by-reference calling semantics too. + +```fortran + INTEGER, POINTER :: ptr + REAL, ALLOCATABLE, DIMENSION(1000) :: al + + INTERFACE + SUBROUTINE fun(ptr, al) + INTEGER, POINTER :: p + REAL, ALLOCATABLE :: a + END SUBROUTINE + END INTERFACE +``` +---- +```mlir + %ptr = ... : !fir.ptr + %al = ... : !fir.heap> + + func @fun(!fir.ref>, !fir.ref>) +``` + +Note that references to pointers and heap allocatables are +allowed. However, a pointer/heap cannot point directly to a pointer/heap. + +```mlir + %err1 = ... : !fir.ptr> // Invalid type + %err2 = ... : !fir.heap> // Invalid type +``` + +Note that a value of function type is also considered a reference. + +```mlir + %fun = ... : (i32, f64) -> i1 // %fun is a reference to a func object +``` + +##### Boxed types + +Boxed types are reference types. A boxed entity is implicitly located in +memory. The only way to construct a boxed value is by providing a memory +reference type, discussed above. Any reference can be emboxed. + +There are additionally, two special-purpose box types. A `!fir.boxchar` +value is a `CHARACTER` variable (in memory) including both a pointer to the +buffer and the `LEN` type parameter. `boxchar` was discussed above. + +The second special case is the `!fir.boxproc` type. A Fortran internal +procedure can reference variables in its host's scope. Fortran also allows +pointers to procedures. A value of type `!fir.boxproc` then is a pair of +references, one for the procedure pointer and the other a pointer to a +tuple of host associated values. + +```fortran + SUBROUTINE host + REAL X + PROCEDURE(), POINTER :: procptr + ... + procptr => intern + ... + CALL procptr + CONTAINS + SUBROUTINE intern + X = ... +``` +---- +```mlir + func @host() { + %x = ... : !fir.ref + ... + %bag_val = fir.insert_value %b, %x, %0 : ... -> tuple, ...> + %bag = ... : !fir.ref, ...>> + fir.store %bag_val to %bag : !fir.ref, ...>> + %procptr = fir.emboxproc @intern, %bag : ... -> !fir.boxproc<() -> ()> + ... + fir.call %procptr() : () -> () +``` + +Here, the call to the boxed procedure implicitly passes the extra argument, the +reference to `%bag`, which contains the value of the variable `x`. + +##### Miscellaneous types + +Fortran uses triple notation to describe array sections, strided views of +multidimensional arrays. These sections can be captured using the +`fir.gendims` instruction which produces a value of type `!fir.dims`. + +```fortran + DIMENSION (10,10) a + ... a(2:6:2,1:7:4) ... +``` +---- +```mlir + // the following line is pseudocode + %1 = fir.gendims 2,6,2, 1,7,4 : !fir.dims<2> +``` + +Fortran also allows the implementation to reorder fields in a derived +type. Furthermore, the sizes of these fields and the layout may be left up +to the runtime. This could mean that the backend needs to generate runtime +calls to determine the offsets and sizes of fields. + +```fortran + TYPE ding(k) + ... + TYPE(T(k)) :: field_name +``` +---- +```mlir + %2 = fir.field("field_name") : !fir.field +``` + +When lowering a boxed value, the compiler may need to test what the exact +type of the value is at runtime. (For example, when generating code for +`SELECT TYPE`.) + +```fortran + CLASS(*) :: x + SELECT TYPE (x) + ... +``` +---- +```mlir + %1 = fir.box_tdesc %x : (!fir.box) -> !fir.tdesc +``` + +The `none` type is used when the entity has unlimited polymorphic type. See +below for a larger example of `SELECT TYPE`. + +### Executable statements + +The main purpose of lowering is to lower all the executable statements from +Fortran into FIR in a semantics preserving way. + +#### Substrings + +```fortran + ID(4:9) +``` +---- +```mlir + %id = ... : !fir.ref>> + %1 = fir.coordinate_of %id, %c3 : ... -> !fir.ref> + %2 = fir.emboxchar %1, %c5 : ... -> !fir.boxchar<1> +``` + +#### Structure components + +```fortran + scalar_parent%scalar_field +``` +---- +```mlir + %sf = fir.field("scalar_field") : !fir.field + %1 = fir.coordinate_of %scalar_parent, %sf : ... -> !fir.ref +``` + +#### Type parameters + +```fortran + TYPE ding(dim) + INTEGER, LEN :: dim + REAL :: values(dim) + END TYPE ding + + ding(x) :: a_ding + ... a_ding%dim ... +``` +---- +```mlir + %1 = fir.len_param_index("dim") : !fir.field + %2 = fir.coordinate_of %a_ding, %1 : ... -> !fir.ref + %3 = fir.load %2 : !fir.ref +``` + +#### Arrays + +```fortran + ... A ... ! whole array + ... B(4) ... ! array element + ... C(1:10) ... ! array section + ... D(1:10:2) ... ! array section with stride + INTEGER, DIMENSION :: V(4) + ... E(V) ... ! array section with vector subscript +``` +---- +```mlir + %1 = fir.load %a : !fir.ref> + + %2 = fir.extract_element %b, %c4 : (!fir.array, i32) -> f32 + + %3 = fir.coordinate_of %c, %c1 : (!fir.ref>, i32) -> !fir.ref + %4 = fir.convert %3 : (!fir.ref) -> !fir.ref> + %5 = fir.load %4 : (!fir.ref>) -> !fir.array<10:f32> + + %6 = fir.gendims %c1, %c10, %c2 : (i32, i32, i32) -> !fir.dims<1> + %7 = fir.embox %d, %6 : (!fir.ref>, !fir.dims<1>) -> !fir.embox> + + // create a temporary to hold E(V) + %v = ... : !fir.array<4:i32> + %8 = fir.alloca !fir.array<4:f32> : !fir.ref> + fir.loop %i = %c1 to %c4 unordered { + %9 = fir.extract_value %v, %i : (!fir.array<4:i32>, index) -> i32 + %10 = fir.extract_value %e, %9 : (!fir.array, i32) -> f32 + %11 = fir.coordinate_of %8, %i : (!fir.ref>, index) -> !fir.ref + fir.store %10 to %11 : !fir.ref + } +``` + +In the fourth case, lowering could also create a temporary and copy the +values from the section `D(1:10:2)` into it, but the preference should be +to defer copying data until it is necessary (as in the fifth non-affine +case, `E(V)`). + +#### Image selector + +```fortran + REAL :: A(10)[5,*] + + ... A(:)[1,4] ... ! selects image 16 (if available) +``` +---- +```mlir + %1 = fir.call @runtime_fetch_array(%a, %c_1, %c_4, ...) : (!fir.box>, i32, i32, ...) -> !fir.ref> +``` + +#### Dynamic association + +```fortran + ALLOCATE (x(n), b(-3:m, 0:9)) + + NULLIFY (p) + + DEALLOCATE (x, b) +``` +---- +```mlir + %x = fir.allocmem f32, %n : !fir.heap> + + %c4 = constant 4 : i32 + %1 = addi %m, %c4 : i32 + %2 = constant 10 : i32 + %b = fir.allocmem f32, %1, %2 : !fir.heap> + + %zero = constant 0 : i64 + %null = fir.convert %zero : (i64) -> !fir.ptr + fir.store %null to %p : !fir.ref> + + fir.freemem %x : !fir.heap> + fir.freemem %b : !fir.heap> +``` + +#### Basic operators + +Operators like `**`, `*`, `/`, etc. will be lowered into standard dialect +operations or runtime calls as needed. + +```fortran + a * b + c .LE. d +``` +---- +```mlir + %0 = mulf %a, %b : f32 + %1 = cmp "le" %c, %d : (f32, f32) -> i1 +``` + +#### Calls + +```fortran + CALL foo(v1) + ... func(v2, v3) ... + + pp => bar + CALL pp(v4) + + CALL object%method(arg) +``` +---- +```mlir + fir.call @foo(%v1) : (!fir.ref) -> () + %1 = fir.call @func(%v2, %v3) : (!fir.ref) -> i64 + + %pp = fir.address_of(@bar) : ((!fir.ref) -> ()) -> !fir.ref<(!fir.ref) -> ()> + fir.icall %pp(%v4) : (!fir.ref) -> () + + fir.dispatch "method"(%object, %arg) : (!fir.box>, !fir.ref) -> () +``` + +There are two modes of argument passing in Fortran: calls that are "Fortran +77" style and use an implicit interface, and calls that require an +interface. In FIR, this translates to passing a simple reference to an +entity's data versus passing a boxed reference value. The following calls +illustrate this distinction. + +```fortran + SUBROUTINE sub1(a) + INTEGER :: a(10,10) ! F77 style + ... + INTERFACE + SUBROUTINE sub2(a) + INTEGER :: a(:,:) ! assumed shape + ... + PROGRAM p + INTEGER :: a(10,10) + CALL sub1(a) + CALL sub2(a) +``` +---- +```mlir + func @sub1(!fir.ref>) -> () + func @sub1(!fir.box>) -> () + + func @_QP_p() { + %c1 = constant 1 : i32 + %c10 = constant 10 : i32 + %a1 = fir.alloca !fir.array<10x10:i32> : !fir.ref> + fir.call @sub1(%a1) : (!fir.ref>) -> () + %1 = fir.gendims %c1, %c10, %c1, %c1, %c10, %c1 : (i32,i32,i32,i32,i32,i32) -> !fir.dims<2> + %a2 = fir.embox %a1, %1 : (!fir.ref>, !fir.dims<2>) -> !fir.box> + fir.call @sub2(%a2) : (!fir.box>) -> () +``` + +When lowering into FIR, the bridge must explicitly perform any allocation, +copying, deallocation, and finalization on temporary entities as required +by the Fortran standard, preserving the copy-in copy-out calling +convention. + +#### Parentheses (10.1.8) + +```fortran + (a + b) + (a + c) ! cannot rewrite as (2 * a) + b + c +``` +---- +```mlir + %1 = addf %a, %b : f32 + %2 = fir.no_reassoc %1 : f32 // to prevent reassociation + %3 = addf %a, %c : f32 + %4 = fir.no_reassoc %3 : f32 + %5 = addf %2, %4 : f32 +``` + +One must also specify to LLVM that these operations will not be reassociated. + +#### Assignment + +```fortran + scalar = e1 ! intrinsic scalar assignment + array = e2 ! intrinsic array assignment + object = e3 ! defined assignment + pntr => e4 ! pointer assignment + pproc => func ! procedure pointer assignment +``` +---- +```mlir + %e1 = ... : f32 + fir.store %e1 to %scalar : !fir.ref + + %e2 = ... : !fir.array<10x10 : i32> + fir.store %e2 to %array : !fir.ref> + + %e3 = ... !fir.ref + %object = ... !fir.ref + fir.call @defd_assn(%object, %e3) : ... -> () + + %e4 = ... : !fir.ptr + %pntr = ... : !fir.ref> + fir.store %e4 to %pntr : !fir.ref> + + @func(i32, i32) -> i32 + %fn = fir.address_of(@func) : ((i32, i32) -> i32) -> !fir.ptr<(i32, i32) -> i32> + %pproc = ... : !fir.ref i32>> + fir.store %fn to %pproc : !fir.ref i32>> +``` + +#### Masked assignment + +```fortran + WHERE (arr < threshold) + arr = arr + increment + ELSEWHERE + arr = threshold + END WHILE +``` +---- +```mlir + %arr = ... : !fir.array + %threshold = ... : !fir.array + fir.loop %i = %c1 to %size { + %arr_i = fir.extract_value %arr, %i : ... -> !T + %threshold_i = fir.extract_value %threshold, %i : ... -> !T + %1 = cmp "lt" %arr_i, %threshold_i : ... -> i1 + fir.where %1 { + %2 = addf %arr_i, %increment : !T + %3 = fir.coordinate_of %arr, %i : ... -> !fir.ref + fir.store %2 to %3 : !fir.ref + } otherwise { + %4 = fir.coordinate_of %arr, %i : ... -> !fir.ref + fir.store %threshold_i to %4 + } + } +``` + +#### FORALL + +```fortran + FORALL (i = 1:100) + a(i) = b(i) / c(i) + END FORALL +``` +---- +```mlir + fir.loop %i = %c1 to %c100 unordered { + %1 = fir.extract_value %b, %i : (!fir.array, index) -> f32 + %2 = fir.extract_value %c, %i : (!fir.array, index) -> f32 + %3 = divf %1, %2 : f32 + %4 = fir.coordinate_of %a, %i : (!fir.ref>, index) -> !fir.ref + fir.store %3 to %4 : !fir.ref + } +``` + +#### ASSOCIATE construct + +```fortran + ASSOCIATE (z => EXP(-(x**2+y**2)) * COS(theta)) + CALL foo(z) + END ASSOCIATE +``` +---- +```mlir + %1 = ... : f32 + %2 = fir.call @exp(%1) : (f32) -> f32 + %3 = fir.load %theta : !fir.ref + %4 = fir.call @cos(%3) : (f32) -> f32 + %5 = mulf %2, %4 : f32 + fir.store %5 to %z : !fir.ref + fir.call @foo(%z) : (!fir.ref) -> () +``` + +#### DO construct + +```fortran + DIMENSION a(10,10,10), b(10,10,10) + + DO i = 1, m + DO j = 1, n + c(i,j) = dot_prod(a(i,j,:), b(:,i,j)) + END DO + END DO +``` +---- +```mlir + %c1 = constant 1 : index + %c10 = constant 10 : index + %c100 = constant 100 : index + %c1000 = constant 1000 : index + %1 = fir.gendims %c1, %c1000, %c100 : !fir.dims<1> + %2 = fir.gendims %c1, %c10, %c1 : !fir.dims<1> + + fir.loop %i = %c1 to %m { + fir.loop %i = %c1 to %n { + %13 = fir.coordinate_of %a, %i, %j : !fir.ref> + %14 = fir.embox %13, %1 : (!fir.ref>, !fir.dims<1>) -> !fir.box> + %15 = fir.coordinate_of %b, %c1, %i, %j : !fir.ref + %16 = fir.convert %15 : (!fir.ref) -> !fir.ref> + %17 = fir.embox %16, %2 : (!fir.ref>, !fir.dims<1>) -> !fir.box> + %18 = fir.call @dot_prod(%14, %17) : (!fir.box>, !fir.box>) -> f32 + %19 = fir.coordinate_of %c, %i, %j : (!fir.box>, index, index) -> !fir.ref + fir.store %18 to %19 : !fir.ref + } + } +``` + +In this lowering, the array sections from the arrays `a` and `b` are _not_ +copied to a temporary memory buffer, but are instead captured in boxed +values (`%14` and `%17`). + +#### IF construct + +```fortran + IF (a > 0) THEN + ... + ELSE + ... + END IF +``` +---- +```mlir + %1 = ... : i1 + cond_br %1, ^bb1(%2:i32), ^bb2(%3:i32) +``` + +#### SELECT CASE construct + +```fortran + SELECT CASE (p) + CASE (1, 3:5) + ... + CASE (:-1) + ... + CASE (10:) + ... + CASE DEFAULT + ... + END SELECT CASE +``` +---- +```mlir + fir.select_case %p : i32 [#fir.point,%c1,^bb1, #fir.interval,%c3,%c5,^bb1, #fir.upper,%cn1,^bb2, #fir.lower,%c10,^bb3, unit,^bb4] +``` + +#### SELECT RANK construct + +```fortran + SELECT RANK (p) + RANK (2) + ... + RANK (*) + ... + RANK DEFAULT + ... + END SELECT RANK +``` +---- +```mlir + fir.select_rank %p : i32 [2,^bb1(%1:f32), -1,^bb2, unit,^bb3(%2:f32,%3:i32)] +``` + +#### SELECT TYPE construct + +```fortran + SELECT TYPE (p) + TYPE IS (type_a) + ... + CLASS IS (super_b) + ... + CLASS DEFAULT + ... + END SELECT TYPE +``` +---- +```mlir + fir.select_type %p : !fir.box [#fir.instance>,^bb_1(%1:i32,%2:i64), #fir.subsumed>,^bb_2(%3:f32,%4:f64,%5:i32), unit,^bb_3] +``` +---- +```mlir + %type_a_desc = fir.gentypedesc !fir.type : !fir.tdesc> + %super_b_desc = fir.gentypedesc !fir.type : !fir.tdesc> + %11 = fir.box_tdesc %p : (!fir.box) -> !fir.tdesc + %12 = cmp "eq" %11, %type_a_desc : (!fir.tdesc, !fir.tdesc>) -> i1 + cond_br %2, ^bb1(%1:i32,%2:i64), ^bb1b(%3:f32,%4:f64,%5:i32) + ^bb1(%a1,%a2 : i32,i64): + ... + ^bb1b(%b1,%b2,%b3 : f32,f64,i32): + %13 = fir.call @is_subtype_of(%11, %super_b_desc) : ... -> i1 + cond_br %13, ^bb2(%b1,%b2,%b3), ^bb3 + ^bb2(%b1,%b2,%b3 : f32,f64,i32): + ... + ^bb3: + ... +``` + +#### Jumping statements + +```fortran + STOP + ERROR STOP + FAIL IMAGE + CONTINUE loop + EXIT a_construct + GOTO label1 + GOTO (label2,label3,label4), i +``` +---- +```mlir + fir.call @stop() + fir.unreachable + + fir.call @error_stop() + fir.unreachable + + fir.call @fail_image() + fir.unreachable + + br ^bb_continue + + br ^bb_exit + + br ^bb_label1 + + fir.select %i : i32 [1,^bb_label2(%1:i32), 2,^bb_label3, 3,^bb_label4, unit,^fallthru] + ^fallthru: +``` + diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h new file mode 100644 index 0000000000000..3c7676a3956c2 --- /dev/null +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -0,0 +1,73 @@ +//===-- Lower/ConvertExpr.h -- lowering of expressions ----------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_CONVERT_EXPR_H_ +#define FORTRAN_LOWER_CONVERT_EXPR_H_ + +#include "Intrinsics.h" + +/// [Coding style](https://llvm.org/docs/CodingStandards.html) + +namespace mlir { +class Location; +class OpBuilder; +class Type; +class Value; +} // namespace mlir + +namespace fir { +class AllocaExpr; +} // namespace fir + +namespace Fortran { +namespace common { +class IntrinsicTypeDefaultKinds; +} // namespace common + +namespace evaluate { +template +class Expr; +struct SomeType; +} // namespace evaluate + +namespace semantics { +class Symbol; +} // namespace semantics + +namespace lower { + +class AbstractConverter; +class FirOpBuilder; +class SymMap; + +/// Create an expression. +/// Lowers `expr` to the FIR dialect of MLIR. The expression is lowered to a +/// value result. +mlir::Value createSomeExpression(mlir::Location loc, + AbstractConverter &converter, + const evaluate::Expr &expr, + SymMap &symMap, + const IntrinsicLibrary &intrinsics); + +mlir::Value +createI1LogicalExpression(mlir::Location loc, AbstractConverter &converter, + const evaluate::Expr &expr, + SymMap &symMap, const IntrinsicLibrary &intrinsics); + +/// Create an address. +/// Lowers `expr` to the FIR dialect of MLIR. The expression must be an entity +/// and the address of the entity is returned. +mlir::Value createSomeAddress(mlir::Location loc, AbstractConverter &converter, + const evaluate::Expr &expr, + SymMap &symMap, + const IntrinsicLibrary &intrinsics); + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_CONVERT_EXPR_H_ diff --git a/flang/include/flang/Lower/IO.h b/flang/include/flang/Lower/IO.h index cbfd6dffaed76..69908511525dc 100644 --- a/flang/include/flang/Lower/IO.h +++ b/flang/include/flang/Lower/IO.h @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_IO_H #define FORTRAN_LOWER_IO_H diff --git a/flang/include/flang/Lower/Intrinsics.h b/flang/include/flang/Lower/Intrinsics.h new file mode 100644 index 0000000000000..fe9687d59db75 --- /dev/null +++ b/flang/include/flang/Lower/Intrinsics.h @@ -0,0 +1,74 @@ +//===-- Lower/Intrinsics.h -- lowering of intrinsics ------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Builder routines for constructing the FIR dialect of MLIR. As FIR is a +// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding +// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this +// module. +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_INTRINSICS_H_ +#define FORTRAN_LOWER_INTRINSICS_H_ + +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "llvm/ADT/StringRef.h" +#include + +namespace Fortran::lower { + +class FirOpBuilder; + +/// IntrinsicLibrary generates FIR+MLIR operations that implement Fortran +/// generic intrinsic function calls. It operates purely on FIR+MLIR types so +/// that it can be used at different lowering level if needed. +/// IntrinsicLibrary is not in charge of generating code for the argument +/// expressions/symbols. These must be generated before and the resulting +/// mlir::Values are inputs for the IntrinsicLibrary operation generation. +/// +/// The operations generated can be as simple as a single runtime library call +/// or they may fully implement the intrinsic without runtime help. This +/// depends on the IntrinsicLibrary::Implementation. +/// +/// IntrinsicLibrary should not be assumed cheap to build since they may need +/// to build a representation of the target runtime before they can be used. +/// Once built, they are stateless and cannot be modified. +/// + +class IntrinsicLibrary { +public: + /// Available runtime library versions. + enum class Version { PgmathFast, PgmathRelaxed, PgmathPrecise, LLVM }; + + /// Create an IntrinsicLibrary targeting the desired runtime library version. + IntrinsicLibrary(Version, mlir::MLIRContext &); + ~IntrinsicLibrary(); + /// Generate the FIR+MLIR operations for the generic intrinsic "name". + /// On failure, returns a nullptr, else the returned mlir::Value is + /// the returned Fortran intrinsic value. + mlir::Value genval(mlir::Location loc, Fortran::lower::FirOpBuilder &builder, + llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef args) const; + + // TODO: Expose interface to get specific intrinsic function address. + // TODO: Handle intrinsic subroutine. + // TODO: Intrinsics that do not require their arguments to be defined + // (e.g shape inquiries) might not fit in the current interface that + // requires mlir::Value to be provided. + // TODO: Error handling interface ? + // TODO: Implementation is incomplete. Many intrinsics to tbd. + +private: + /// Actual implementation is hidden. + class Implementation; + std::unique_ptr impl; +}; + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_INTRINSICS_H_ diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h index dcfce8ff63c31..1f8bd0f0b1d99 100644 --- a/flang/include/flang/Lower/Runtime.h +++ b/flang/include/flang/Lower/Runtime.h @@ -6,6 +6,10 @@ // //===----------------------------------------------------------------------===// // +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// +// // Builder routines for constructing the FIR dialect of MLIR. As FIR is a // dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding // style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this diff --git a/flang/include/flang/Optimizer/Analysis/IteratedDominanceFrontier.h b/flang/include/flang/Optimizer/Analysis/IteratedDominanceFrontier.h new file mode 100644 index 0000000000000..5f686d5947456 --- /dev/null +++ b/flang/include/flang/Optimizer/Analysis/IteratedDominanceFrontier.h @@ -0,0 +1,95 @@ +//===- IteratedDominanceFrontier.h - Calculate IDF --------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +/// \file +/// Compute iterated dominance frontiers using a linear time algorithm. +/// +/// The algorithm used here is based on: +/// +/// Sreedhar and Gao. A linear time algorithm for placing phi-nodes. +/// In Proceedings of the 22nd ACM SIGPLAN-SIGACT Symposium on Principles of +/// Programming Languages +/// POPL '95. ACM, New York, NY, 62-73. +/// +/// It has been modified to not explicitly use the DJ graph data structure and +/// to directly compute pruned SSA using per-variable liveness information. +// +//===----------------------------------------------------------------------===// + +#ifndef OPTIMIZER_ANALYSIS_IDF_H +#define OPTIMIZER_ANALYSIS_IDF_H + +#include "mlir/Support/LLVM.h" + +namespace mlir { +class Block; +class DominanceInfo; +} // namespace mlir + +namespace fir { + +/// Determine the iterated dominance frontier, given a set of defining +/// blocks, and optionally, a set of live-in blocks. +/// +/// In turn, the results can be used to place phi nodes. +/// +/// This algorithm is a linear time computation of Iterated Dominance Frontiers, +/// pruned using the live-in set. +/// By default, liveness is not used to prune the IDF computation. +/// The template parameters should be either BasicBlock* or Inverse, depending on if you want the forward or reverse IDF. +template +class IDFCalculator { +public: + IDFCalculator(mlir::DominanceInfo &DT) : DT(DT), useLiveIn(false) {} + + /// Give the IDF calculator the set of blocks in which the value is + /// defined. This is equivalent to the set of starting blocks it should be + /// calculating the IDF for (though later gets pruned based on liveness). + /// + /// Note: This set *must* live for the entire lifetime of the IDF calculator. + void setDefiningBlocks(const llvm::SmallPtrSetImpl &Blocks) { + DefBlocks = &Blocks; + } + + /// Give the IDF calculator the set of blocks in which the value is + /// live on entry to the block. This is used to prune the IDF calculation to + /// not include blocks where any phi insertion would be dead. + /// + /// Note: This set *must* live for the entire lifetime of the IDF calculator. + void setLiveInBlocks(const llvm::SmallPtrSetImpl &Blocks) { + LiveInBlocks = &Blocks; + useLiveIn = true; + } + + /// Reset the live-in block set to be empty, and tell the IDF + /// calculator to not use liveness anymore. + void resetLiveInBlocks() { + LiveInBlocks = nullptr; + useLiveIn = false; + } + + /// Calculate iterated dominance frontiers + /// + /// This uses the linear-time phi algorithm based on DJ-graphs mentioned in + /// the file-level comment. It performs DF->IDF pruning using the live-in + /// set, to avoid computing the IDF for blocks where an inserted PHI node + /// would be dead. + void calculate(llvm::SmallVectorImpl &IDFBlocks); + +private: + mlir::DominanceInfo &DT; + bool useLiveIn; + const llvm::SmallPtrSetImpl *LiveInBlocks; + const llvm::SmallPtrSetImpl *DefBlocks; +}; + +typedef IDFCalculator ForwardIDFCalculator; + +} // namespace fir + +#endif // OPTIMIZER_ANALYSIS_IDF_H diff --git a/flang/include/flang/Optimizer/Transforms/Passes.h b/flang/include/flang/Optimizer/Transforms/Passes.h index 5e71995736e6a..8235e0b8d577a 100644 --- a/flang/include/flang/Optimizer/Transforms/Passes.h +++ b/flang/include/flang/Optimizer/Transforms/Passes.h @@ -50,6 +50,7 @@ bool canLegallyInline(mlir::Operation *op, mlir::Region *reg, #define GEN_PASS_REGISTRATION #include "flang/Optimizer/Transforms/Passes.h.inc" +bool isAlwaysExecuteLoopBody(); } // namespace fir #endif // OPTIMIZER_TRANSFORMS_PASSES_H diff --git a/flang/include/flang/Version.h b/flang/include/flang/Version.h new file mode 100644 index 0000000000000..e1d78eca58d06 --- /dev/null +++ b/flang/include/flang/Version.h @@ -0,0 +1,61 @@ +//===- Version.h - Flang Version Number -------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +/// +/// \file +/// Defines version macros and version-related utility functions +/// for Flang. +/// +//===----------------------------------------------------------------------===// + +#ifndef LLVM_FLANG_VERSION_H +#define LLVM_FLANG_VERSION_H + +#include "flang/Version.inc" +#include "llvm/ADT/StringRef.h" + +namespace flang { + /// Retrieves the repository path (e.g., Subversion path) that + /// identifies the particular Flang branch, tag, or trunk from which this + /// Flang was built. + std::string getFlangRepositoryPath(); + + /// Retrieves the repository path from which LLVM was built. + /// + /// This supports LLVM residing in a separate repository from flang. + std::string getLLVMRepositoryPath(); + + /// Retrieves the repository revision number (or identifier) from which + /// this Flang was built. + std::string getFlangRevision(); + + /// Retrieves the repository revision number (or identifier) from which + /// LLVM was built. + /// + /// If Flang and LLVM are in the same repository, this returns the same + /// string as getFlangRevision. + std::string getLLVMRevision(); + + /// Retrieves the full repository version that is an amalgamation of + /// the information in getFlangRepositoryPath() and getFlangRevision(). + std::string getFlangFullRepositoryVersion(); + + /// Retrieves a string representing the complete flang version, + /// which includes the flang version number, the repository version, + /// and the vendor tag. + std::string getFlangFullVersion(); + + /// Like getFlangFullVersion(), but with a custom tool name. + std::string getFlangToolFullVersion(llvm::StringRef ToolName); + + /// Retrieves a string representing the complete flang version suitable + /// for use in the CPP __VERSION__ macro, which includes the flang version + /// number, the repository version, and the vendor tag. + std::string getFlangFullCPPVersion(); +} + +#endif // LLVM_FLANG_VERSION_H diff --git a/flang/lib/CMakeLists.txt b/flang/lib/CMakeLists.txt index 9ebb9f6a72ca5..28602d8fbc1dd 100644 --- a/flang/lib/CMakeLists.txt +++ b/flang/lib/CMakeLists.txt @@ -1,13 +1,18 @@ +if ((CMAKE_CXX_COMPILER_ID MATCHES "Clang")) + if (APPLE) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-string-conversion -Wno-covered-switch-default") + endif() +endif() + add_subdirectory(Common) add_subdirectory(Evaluate) add_subdirectory(Decimal) add_subdirectory(Lower) add_subdirectory(Parser) +add_subdirectory(Optimizer) add_subdirectory(Semantics) if(FLANG_BUILD_NEW_DRIVER) add_subdirectory(Frontend) add_subdirectory(FrontendTool) endif() - -add_subdirectory(Optimizer) diff --git a/flang/lib/Decimal/binary-to-decimal.cpp b/flang/lib/Decimal/binary-to-decimal.cpp index 68ee345b89352..e124135607762 100644 --- a/flang/lib/Decimal/binary-to-decimal.cpp +++ b/flang/lib/Decimal/binary-to-decimal.cpp @@ -276,7 +276,45 @@ void BigRadixFloatingPointNumber::Minimize( Normalize(); } -template +template +void BigRadixFloatingPointNumber::LoseLeastSignificantDigit() { + Digit LSD{digit_[0]}; + for (int j{0}; j < digits_ - 1; ++j) { + digit_[j] = digit_[j + 1]; + } + digit_[digits_ - 1] = 0; + bool incr{false}; + switch (rounding_) { + case RoundNearest: + case RoundDefault: + incr = LSD > radix / 2 || (LSD == radix / 2 && digit_[0] % 2 != 0); + break; + case RoundUp: + incr = LSD > 0 && !isNegative_; + break; + case RoundDown: + incr = LSD > 0 && isNegative_; + break; + case RoundToZero: + break; + case RoundCompatible: + incr = LSD >= radix / 2; + break; + } + for (int j{0}; (digit_[j] += incr) == radix; ++j) { + digit_[j] = 0; + } +} + +template void BigRadixFloatingPointNumber<8,16>::LoseLeastSignificantDigit(); +template void BigRadixFloatingPointNumber<11,16>::LoseLeastSignificantDigit(); +template void BigRadixFloatingPointNumber<24,16>::LoseLeastSignificantDigit(); +template void BigRadixFloatingPointNumber<53,16>::LoseLeastSignificantDigit(); +template void BigRadixFloatingPointNumber<64,16>::LoseLeastSignificantDigit(); +template void BigRadixFloatingPointNumber<113,16>::LoseLeastSignificantDigit(); + +template ConversionToDecimalResult ConvertToDecimal(char *buffer, std::size_t size, enum DecimalConversionFlags flags, int digits, enum FortranRounding rounding, BinaryFloatingPointNumber x) { diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp new file mode 100644 index 0000000000000..65fc9c776ddfa --- /dev/null +++ b/flang/lib/Lower/Bridge.cpp @@ -0,0 +1,1470 @@ +//===-- Bridge.cc -- bridge to lower to MLIR ------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/Bridge.h" +#include "flang/Lower/ConvertExpr.h" +#include "flang/Lower/ConvertType.h" +#include "flang/Lower/FIRBuilder.h" +#include "flang/Lower/IO.h" +#include "flang/Lower/Intrinsics.h" +#include "flang/Lower/Mangler.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/Runtime.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Semantics/tools.h" +#include "mlir/Dialect/LLVMIR/LLVMDialect.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/Parser.h" +#include "mlir/Target/LLVMIR.h" +#include "llvm/Support/CommandLine.h" +#include "llvm/Support/ErrorHandling.h" +#include "llvm/Support/MD5.h" + +#undef TODO +#define TODO() \ + { \ + if (disableToDoAssertions) \ + mlir::emitError(toLocation(), __FILE__) \ + << ':' << __LINE__ << " not implemented"; \ + else \ + llvm_unreachable("not yet implemented"); \ + } + +static llvm::cl::opt + dumpBeforeFir("fdebug-dump-pre-fir", llvm::cl::init(false), + llvm::cl::desc("dump the IR tree prior to FIR")); + +static llvm::cl::opt + disableToDoAssertions("disable-burnside-todo", + llvm::cl::desc("disable burnside bridge asserts"), + llvm::cl::init(false), llvm::cl::Hidden); + +static llvm::cl::opt + nameLengthHashSize("length-to-hash-string-literal", + llvm::cl::desc("string literals that exceed this length" + " will use a hash value as their symbol " + "name"), + llvm::cl::init(32)); + +namespace { +/// Information for generating a structured or unstructured increment loop. +struct IncrementLoopInfo { + explicit IncrementLoopInfo( + Fortran::semantics::Symbol *sym, + const Fortran::parser::ScalarExpr &lowerExpr, + const Fortran::parser::ScalarExpr &upperExpr, + const std::optional &stepExpr, + mlir::Type type) + : loopVariableSym{sym}, lowerExpr{lowerExpr}, upperExpr{upperExpr}, + stepExpr{stepExpr}, loopVariableType{type} {} + + bool isStructured() const { return headerBlock == nullptr; } + + // Data members for both structured and unstructured loops. + Fortran::semantics::Symbol *loopVariableSym; + const Fortran::parser::ScalarExpr &lowerExpr; + const Fortran::parser::ScalarExpr &upperExpr; + const std::optional &stepExpr; + mlir::Type loopVariableType; + mlir::Value loopVariable{}; + mlir::Value stepValue{}; // possible uses in multiple blocks + + // Data members for structured loops. + fir::LoopOp doLoop{}; + mlir::OpBuilder::InsertPoint insertionPoint{}; + + // Data members for unstructured loops. + mlir::Value tripVariable{}; + mlir::Block *headerBlock{nullptr}; // loop entry and test block + mlir::Block *bodyBlock{nullptr}; // first loop body block + mlir::Block *successorBlock{nullptr}; // loop exit target block +}; +} // namespace + +//===----------------------------------------------------------------------===// +// FirConverter +//===----------------------------------------------------------------------===// + +namespace { +/// Walk over the pre-FIR tree (PFT) and lower it to the FIR dialect of MLIR. +/// +/// After building the PFT, the FirConverter processes that representation +/// and lowers it to the FIR executable representation. +class FirConverter : public Fortran::lower::AbstractConverter { +public: + explicit FirConverter(Fortran::lower::LoweringBridge &bridge, + fir::NameUniquer &uniquer) + : mlirContext{bridge.getMLIRContext()}, cooked{bridge.getCookedSource()}, + module{bridge.getModule()}, defaults{bridge.getDefaultKinds()}, + intrinsics{Fortran::lower::IntrinsicLibrary( + Fortran::lower::IntrinsicLibrary::Version::LLVM, + bridge.getMLIRContext())}, + uniquer{uniquer} {} + virtual ~FirConverter() = default; + + /// Convert the PFT to FIR + void run(Fortran::lower::pft::Program &pft) { + // do translation + for (auto &u : pft.getUnits()) { + std::visit( + Fortran::common::visitors{ + [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); }, + [&](Fortran::lower::pft::ModuleLikeUnit &m) { lowerMod(m); }, + [&](Fortran::lower::pft::BlockDataUnit &) { TODO(); }, + }, + u); + } + } + + mlir::FunctionType genFunctionType(Fortran::lower::SymbolRef sym) { + return Fortran::lower::translateSymbolToFIRFunctionType(&mlirContext, + defaults, sym); + } + + //===--------------------------------------------------------------------===// + // AbstractConverter overrides + //===--------------------------------------------------------------------===// + + mlir::Value genExprAddr(const Fortran::lower::SomeExpr &expr, + mlir::Location *loc = nullptr) override final { + return createFIRAddr(loc ? *loc : toLocation(), &expr); + } + mlir::Value genExprValue(const Fortran::lower::SomeExpr &expr, + mlir::Location *loc = nullptr) override final { + return createFIRExpr(loc ? *loc : toLocation(), &expr); + } + + mlir::Type genType(const Fortran::evaluate::DataRef &data) override final { + return Fortran::lower::translateDataRefToFIRType(&mlirContext, defaults, + data); + } + mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final { + return Fortran::lower::translateSomeExprToFIRType(&mlirContext, defaults, + &expr); + } + mlir::Type genType(Fortran::lower::SymbolRef sym) override final { + return Fortran::lower::translateSymbolToFIRType(&mlirContext, defaults, + sym); + } + mlir::Type genType(Fortran::common::TypeCategory tc, + int kind) override final { + return Fortran::lower::getFIRType(&mlirContext, defaults, tc, kind); + } + mlir::Type genType(Fortran::common::TypeCategory tc) override final { + return Fortran::lower::getFIRType(&mlirContext, defaults, tc); + } + + mlir::Location getCurrentLocation() override final { return toLocation(); } + + /// Generate a dummy location. + mlir::Location genLocation() override final { + // Note: builder may not be instantiated yet + return mlir::UnknownLoc::get(&mlirContext); + } + + /// Generate a `Location` from the `CharBlock`. + mlir::Location + genLocation(const Fortran::parser::CharBlock &block) override final { + if (cooked) { + auto loc = cooked->GetSourcePositionRange(block); + if (loc.has_value()) { + // loc is a pair (begin, end); use the beginning position + auto &filePos = loc->first; + return mlir::FileLineColLoc::get(filePos.file.path(), filePos.line, + filePos.column, &mlirContext); + } + } + return genLocation(); + } + + Fortran::lower::FirOpBuilder &getFirOpBuilder() override final { + return *builder; + } + + mlir::ModuleOp &getModuleOp() override final { return module; } + + std::string + mangleName(const Fortran::semantics::Symbol &symbol) override final { + return Fortran::lower::mangle::mangleName(uniquer, symbol); + } + + std::string uniqueCGIdent(llvm::StringRef name) override final { + // For "long" identifiers use a hash value + if (name.size() > nameLengthHashSize) { + llvm::MD5 hash; + hash.update(name); + llvm::MD5::MD5Result result; + hash.final(result); + llvm::SmallString<32> str; + llvm::MD5::stringifyResult(result, str); + std::string hashName = "h."; + hashName.append(str.c_str()); + return uniquer.doGenerated(hashName); + } + // "Short" identifiers use a reversible hex string + return uniquer.doGenerated(llvm::toHex(name)); + } + +private: + FirConverter() = delete; + FirConverter(const FirConverter &) = delete; + FirConverter &operator=(const FirConverter &) = delete; + + //===--------------------------------------------------------------------===// + // Helper member functions + //===--------------------------------------------------------------------===// + + mlir::Value createFIRAddr(mlir::Location loc, + const Fortran::semantics::SomeExpr *expr) { + return createSomeAddress(loc, *this, *expr, localSymbols, intrinsics); + } + + mlir::Value createFIRExpr(mlir::Location loc, + const Fortran::semantics::SomeExpr *expr) { + return createSomeExpression(loc, *this, *expr, localSymbols, intrinsics); + } + mlir::Value createLogicalExprAsI1(mlir::Location loc, + const Fortran::semantics::SomeExpr *expr) { + return createI1LogicalExpression(loc, *this, *expr, localSymbols, + intrinsics); + } + mlir::Value createTemporary(mlir::Location loc, + const Fortran::semantics::Symbol &sym) { + return builder->createTemporary(loc, localSymbols, genType(sym), llvm::None, + &sym); + } + + mlir::FuncOp genFunctionFIR(llvm::StringRef callee, + mlir::FunctionType funcTy) { + if (auto func = builder->getNamedFunction(callee)) + return func; + return builder->createFunction(callee, funcTy); + } + + bool isNumericScalarCategory(Fortran::common::TypeCategory cat) { + return cat == Fortran::lower::IntegerCat || + cat == Fortran::lower::RealCat || + cat == Fortran::lower::ComplexCat || + cat == Fortran::lower::LogicalCat; + } + + bool isCharacterCategory(Fortran::common::TypeCategory cat) { + return cat == Fortran::lower::CharacterCat; + } + + void genFIRUnconditionalBranch(mlir::Block *targetBlock) { + assert(targetBlock && "missing unconditional target block"); + builder->create(toLocation(), targetBlock); + } + + void + genFIRUnconditionalBranch(Fortran::lower::pft::Evaluation *targetEvaluation) { + genFIRUnconditionalBranch(targetEvaluation->block); + } + + void genFIRConditionalBranch(mlir::Value &cond, mlir::Block *trueTarget, + mlir::Block *falseTarget) { + builder->create(toLocation(), cond, trueTarget, + llvm::None, falseTarget, llvm::None); + } + + void genFIRConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr, + Fortran::lower::pft::Evaluation *trueTarget, + Fortran::lower::pft::Evaluation *falseTarget) { + assert(trueTarget && "missing conditional branch true block"); + assert(falseTarget && "missing conditional branch true block"); + mlir::Value cond = + createLogicalExprAsI1(toLocation(), Fortran::semantics::GetExpr(expr)); + genFIRConditionalBranch(cond, trueTarget->block, falseTarget->block); + } + + // + // Termination of symbolically referenced execution units + // + + /// END of program + /// + /// Generate the cleanup block before the program exits + void genExitRoutine() { builder->create(toLocation()); } + void genFIRProgramExit() { genExitRoutine(); } + void genFIR(const Fortran::parser::EndProgramStmt &) { genFIRProgramExit(); } + + /// END of procedure-like constructs + /// + /// Generate the cleanup block before the procedure exits + void genExitFunction(mlir::Value val) { + builder->create(toLocation(), val); + } + void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) { + const auto &details = + functionSymbol.get(); + auto resultRef = localSymbols.lookupSymbol(details.result()); + mlir::Value r = builder->create(toLocation(), resultRef); + genExitFunction(r); + } + + void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit, + const Fortran::semantics::Symbol &symbol) { + if (Fortran::semantics::IsFunction(symbol)) { + // FUNCTION + genReturnSymbol(symbol); + return; + } + + // SUBROUTINE + if (Fortran::semantics::HasAlternateReturns(symbol)) { + // lower to a the constant expression (or zero); the return value will + // drive a SelectOp in the calling context to branch to the alternate + // return LABEL block + TODO(); + mlir::Value intExpr{}; + genExitFunction(intExpr); + return; + } + if (funit.finalBlock) + builder->setInsertionPoint(funit.finalBlock, funit.finalBlock->end()); + genExitRoutine(); + } + + // + // Statements that have control-flow semantics + // + + void switchInsertionPointToWhere(fir::WhereOp &where) { + builder->setInsertionPointToStart(&where.whereRegion().front()); + } + void switchInsertionPointToOtherwise(fir::WhereOp &where) { + builder->setInsertionPointToStart(&where.otherRegion().front()); + } + + template + mlir::OpBuilder::InsertPoint genWhereCondition(fir::WhereOp &where, + const A *stmt) { + auto cond = createLogicalExprAsI1( + toLocation(), + Fortran::semantics::GetExpr( + std::get(stmt->t))); + where = builder->create(toLocation(), cond, true); + auto insPt = builder->saveInsertionPoint(); + switchInsertionPointToWhere(where); + return insPt; + } + + mlir::Value genFIRLoopIndex(const Fortran::parser::ScalarExpr &x, + mlir::Type t) { + mlir::Value v = genExprValue(*Fortran::semantics::GetExpr(x)); + return builder->create(toLocation(), t, v); + } + + mlir::Value genFIRLoopIndex(const Fortran::parser::ScalarExpr &x) { + return genFIRLoopIndex(x, mlir::IndexType::get(&mlirContext)); + } + + mlir::FuncOp getFunc(llvm::StringRef name, mlir::FunctionType ty) { + if (auto func = builder->getNamedFunction(name)) { + assert(func.getType() == ty); + return func; + } + return builder->createFunction(name, ty); + } + + /// Lowering of CALL statement + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CallStmt &stmt) { + setCurrentPosition(stmt.v.source); + assert(stmt.typedCall && "Call was not analyzed"); + // The actual lowering is forwarded to expression lowering + // where the code is shared with function reference. + Fortran::semantics::SomeExpr expr{*stmt.typedCall}; + auto res = createFIRExpr(toLocation(), &expr); + if (res) + TODO(); // Alternate returns + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::IfStmt &stmt) { + if (eval.lowerAsUnstructured()) { + genFIRConditionalBranch( + std::get(stmt.t), + eval.lexicalSuccessor, eval.controlSuccessor); + return; + } + + // Generate fir.where. + fir::WhereOp where; + auto insPt = genWhereCondition(where, &stmt); + genFIR(*eval.lexicalSuccessor, /*unstructuredContext*/ false); + eval.lexicalSuccessor->skip = true; + builder->restoreInsertionPoint(insPt); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WaitStmt &stmt) { + genWaitStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WhereStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ComputedGotoStmt &stmt) { + auto *exp = Fortran::semantics::GetExpr( + std::get(stmt.t)); + auto e1{genExprValue(*exp)}; + (void)e1; + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ForallStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ArithmeticIfStmt &stmt) { + auto *exp = + Fortran::semantics::GetExpr(std::get(stmt.t)); + auto e1{genExprValue(*exp)}; + (void)e1; + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssignedGotoStmt &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssociateConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::BlockConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ChangeTeamConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CriticalConstruct &) { + TODO(); + } + + /// Generate FIR for a DO construct. There are six variants: + /// - unstructured infinite and while loops + /// - structured and unstructured increment loops + /// - structured and unstructured concurrent loops + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::DoConstruct &) { + bool unstructuredContext{eval.lowerAsUnstructured()}; + Fortran::lower::pft::Evaluation &doStmtEval = eval.evaluationList->front(); + auto *doStmt = doStmtEval.getIf(); + assert(doStmt && "missing DO statement"); + const auto &loopControl = + std::get>(doStmt->t); + llvm::SmallVector incrementLoopInfo; + const Fortran::parser::ScalarLogicalExpr *whileCondition = nullptr; + bool infiniteLoop = !loopControl.has_value(); + if (infiniteLoop) { + assert(unstructuredContext && "infinite loop must be unstructured"); + startBlock(doStmtEval.localBlocks[0]); // header block + } else if ((whileCondition = + std::get_if( + &loopControl->u))) { + assert(unstructuredContext && "while loop must be unstructured"); + startBlock(doStmtEval.localBlocks[0]); // header block + genFIRConditionalBranch(*whileCondition, doStmtEval.lexicalSuccessor, + doStmtEval.parentConstruct->constructExit); + } else if (const auto *bounds = + std::get_if( + &loopControl->u)) { + // "Normal" increment loop. + incrementLoopInfo.emplace_back(bounds->name.thing.symbol, bounds->lower, + bounds->upper, bounds->step, + genType(*bounds->name.thing.symbol)); + if (unstructuredContext) { + maybeStartBlock(doStmtEval.block); // preheader block + incrementLoopInfo[0].headerBlock = doStmtEval.localBlocks[0]; + incrementLoopInfo[0].bodyBlock = doStmtEval.lexicalSuccessor->block; + incrementLoopInfo[0].successorBlock = + doStmtEval.parentConstruct->constructExit->block; + } + } else { + const auto *concurrentInfo = + std::get_if( + &loopControl->u); + assert(concurrentInfo && "DO loop variant is invalid"); + TODO(); + // Add entries to incrementLoopInfo. (Define extra members for a mask.) + } + auto n = incrementLoopInfo.size(); + for (decltype(n) i = 0; i < n; ++i) { + genFIRIncrementLoopBegin(incrementLoopInfo[i]); + } + + // Generate loop body code. + for (auto &e : *eval.evaluationList) { + genFIR(e, unstructuredContext); + } + + // Generate end loop code. + if (infiniteLoop || whileCondition) { + genFIRUnconditionalBranch(doStmtEval.localBlocks[0]); + } else { + for (auto i = incrementLoopInfo.size(); i > 0;) + genFIRIncrementLoopEnd(incrementLoopInfo[--i]); + } + } + + /// Generate FIR to begin a structured or unstructured increment loop. + void genFIRIncrementLoopBegin(IncrementLoopInfo &info) { + auto location = toLocation(); + mlir::Type type = info.isStructured() + ? mlir::IndexType::get(builder->getContext()) + : info.loopVariableType; + auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); + auto upperValue = genFIRLoopIndex(info.upperExpr, type); + info.stepValue = + info.stepExpr.has_value() + ? genFIRLoopIndex(*info.stepExpr, type) + : (info.isStructured() + ? builder->create(location, 1) + : builder->createIntegerConstant(info.loopVariableType, 1)); + assert(info.stepValue && "step value must be set"); + info.loopVariable = createTemporary(location, *info.loopVariableSym); + + // Structured loop - generate fir.loop. + if (info.isStructured()) { + info.insertionPoint = builder->saveInsertionPoint(); + info.doLoop = builder->create(location, lowerValue, + upperValue, info.stepValue); + builder->setInsertionPointToStart(info.doLoop.getBody()); + // Always store iteration ssa-value to the LCV to avoid missing any + // aliasing of the LCV. + auto lcv = builder->create( + location, info.loopVariableType, info.doLoop.getInductionVar()); + builder->create(location, lcv, info.loopVariable); + return; + } + + // Unstructured loop preheader code - initialize tripVariable, loopVariable. + auto distance = + builder->create(location, upperValue, lowerValue); + auto adjusted = + builder->create(location, distance, info.stepValue); + auto tripCount = + builder->create(location, adjusted, info.stepValue); + info.tripVariable = + builder->createTemporary(location, localSymbols, info.loopVariableType); + builder->create(location, tripCount, info.tripVariable); + builder->create(location, lowerValue, info.loopVariable); + + // Unstructured loop header code - generate loop condition. + startBlock(info.headerBlock); + mlir::Value tripVariable = + builder->create(location, info.tripVariable); + mlir::Value zero = builder->createIntegerConstant(info.loopVariableType, 0); + mlir::Value cond = builder->create( + location, mlir::CmpIPredicate::sgt, tripVariable, zero); + genFIRConditionalBranch(cond, info.bodyBlock, info.successorBlock); + } + + /// Generate FIR to end a structured or unstructured increment loop. + void genFIRIncrementLoopEnd(IncrementLoopInfo &info) { + mlir::Location location = toLocation(); + if (info.isStructured()) { + // End fir.loop. + builder->restoreInsertionPoint(info.insertionPoint); + return; + } + + // Unstructured loop - increment loopVariable. + mlir::Value loopVariable = + builder->create(location, info.loopVariable); + loopVariable = + builder->create(location, loopVariable, info.stepValue); + builder->create(location, loopVariable, info.loopVariable); + + // Unstructured loop - decrement tripVariable. + mlir::Value tripVariable = + builder->create(location, info.tripVariable); + mlir::Value one = builder->create( + location, builder->getIntegerAttr(info.loopVariableType, 1)); + tripVariable = builder->create(location, tripVariable, one); + builder->create(location, tripVariable, info.tripVariable); + genFIRUnconditionalBranch(info.headerBlock); + } + + /// Generate structured or unstructured FIR for an IF construct. + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::IfConstruct &) { + if (eval.lowerAsStructured()) { + // Structured fir.where nest. + fir::WhereOp underWhere; + mlir::OpBuilder::InsertPoint insPt; + for (auto &e : *eval.evaluationList) { + if (auto *s = e.getIf()) { + // fir.where op + insPt = genWhereCondition(underWhere, s); + } else if (auto *s = e.getIf()) { + // otherwise block, then nested fir.where + switchInsertionPointToOtherwise(underWhere); + genWhereCondition(underWhere, s); + } else if (e.isA()) { + // otherwise block + switchInsertionPointToOtherwise(underWhere); + } else if (e.isA()) { + builder->restoreInsertionPoint(insPt); + } else { + genFIR(e, /*unstructuredContext*/ false); + } + } + return; + } + + // Unstructured branch sequence. + for (auto &e : *eval.evaluationList) { + const Fortran::parser::ScalarLogicalExpr *cond = nullptr; + if (auto *s = e.getIf()) { + maybeStartBlock(e.block); + cond = &std::get(s->t); + } else if (auto *s = e.getIf()) { + startBlock(e.block); + cond = &std::get(s->t); + } + if (cond) { + genFIRConditionalBranch( + *cond, + e.lexicalSuccessor == e.controlSuccessor + ? e.parentConstruct->constructExit // empty block --> exit + : e.lexicalSuccessor, // nonempty block + e.controlSuccessor); + } else { + genFIR(e); + } + } + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CaseConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectRankConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectTypeConstruct &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WhereConstruct &) { + TODO(); + } + + /// Lower FORALL construct (See 10.2.4) + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ForallConstruct &forall) { + auto &stmt = std::get< + Fortran::parser::Statement>( + forall.t); + setCurrentPosition(stmt.source); + auto &fas = stmt.statement; + auto &ctrl = + std::get< + Fortran::common::Indirection>( + fas.t) + .value(); + (void)ctrl; + for (auto &s : + std::get>(forall.t)) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::Statement< + Fortran::parser::ForallAssignmentStmt> &b) { + setCurrentPosition(b.source); + genFIR(eval, b.statement); + }, + [&](const Fortran::parser::Statement + &b) { + setCurrentPosition(b.source); + genFIR(eval, b.statement); + }, + [&](const Fortran::parser::WhereConstruct &b) { + genFIR(eval, b); + }, + [&](const Fortran::common::Indirection< + Fortran::parser::ForallConstruct> &b) { + genFIR(eval, b.value()); + }, + [&](const Fortran::parser::Statement + &b) { + setCurrentPosition(b.source); + genFIR(eval, b.statement); + }, + }, + s.u); + } + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ForallAssignmentStmt &s) { + std::visit([&](auto &b) { genFIR(eval, b); }, s.u); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CompilerDirective &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::OpenMPConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::OmpEndLoopDirective &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssociateStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndAssociateStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::BlockStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndBlockStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectCaseStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CaseStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndSelectStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ChangeTeamStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndChangeTeamStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CriticalStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndCriticalStmt &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::NonLabelDoStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndDoStmt &) {} // nop + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::IfThenStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ElseIfStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ElseStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndIfStmt &) {} // nop + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectRankStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectRankCaseStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectTypeStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::TypeGuardStmt &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WhereConstructStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::MaskedElsewhereStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ElsewhereStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndWhereStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ForallConstructStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndForallStmt &) { + TODO(); + } + + // + // Statements that do not have control-flow semantics + // + + // IO statements (see io.h) + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::BackspaceStmt &stmt) { + genBackspaceStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CloseStmt &stmt) { + genCloseStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndfileStmt &stmt) { + genEndfileStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::FlushStmt &stmt) { + genFlushStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::InquireStmt &stmt) { + genInquireStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::OpenStmt &stmt) { + genOpenStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::PrintStmt &stmt) { + genPrintStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ReadStmt &stmt) { + genReadStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::RewindStmt &stmt) { + genRewindStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WriteStmt &stmt) { + genWriteStatement(*this, stmt); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AllocateStmt &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssignmentStmt &stmt) { + assert(stmt.typedAssignment && stmt.typedAssignment->v && + "assignment analysis failed"); + const auto &assignment = *stmt.typedAssignment->v; + std::visit( // better formatting + Fortran::common::visitors{ + [&](const Fortran::evaluate::Assignment::Intrinsic &) { + const auto *sym = + Fortran::evaluate::UnwrapWholeSymbolDataRef(assignment.lhs); + if (sym && Fortran::semantics::IsAllocatable(*sym)) { + // Assignment of allocatable are more complex, the lhs + // may need to be deallocated/reallocated. + // See Fortran 2018 10.2.1.3 p3 + TODO(); + } else if (sym && Fortran::semantics::IsPointer(*sym)) { + // Target of the pointer must be assigned. + // See Fortran 2018 10.2.1.3 p2 + auto lhsType = assignment.lhs.GetType(); + assert(lhsType && "lhs cannot be typeless"); + if (isNumericScalarCategory(lhsType->category())) { + builder->create(toLocation(), + genExprValue(assignment.rhs), + genExprValue(assignment.lhs)); + } else if (isCharacterCategory(lhsType->category())) { + TODO(); + } else { + assert(lhsType->category() == Fortran::lower::DerivedCat); + TODO(); + } + } else if (assignment.lhs.Rank() > 0) { + // Array assignment + // See Fortran 2018 10.2.1.3 p5, p6, and p7 + TODO(); + } else { + // Scalar assignments + auto lhsType = assignment.lhs.GetType(); + assert(lhsType && "lhs cannot be typeless"); + if (isNumericScalarCategory(lhsType->category())) { + // Fortran 2018 10.2.1.3 p8 and p9 + // Conversions are already inserted by semantic + // analysis. + builder->create(toLocation(), + genExprValue(assignment.rhs), + genExprAddr(assignment.lhs)); + } else if (isCharacterCategory(lhsType->category())) { + // Fortran 2018 10.2.1.3 p10 and p11 + // Generating value for lhs to get fir.boxchar. + auto lhs{genExprValue(assignment.lhs)}; + auto rhs{genExprValue(assignment.rhs)}; + builder->createAssign(lhs, rhs); + } else { + assert(lhsType->category() == Fortran::lower::DerivedCat); + // Fortran 2018 10.2.1.3 p12 and p13 + TODO(); + } + } + }, + [&](const Fortran::evaluate::ProcedureRef &) { + // Defined assignment: call ProcRef + TODO(); + }, + [&](const Fortran::evaluate::Assignment::BoundsSpec &) { + // Pointer assignment with possibly empty bounds-spec + TODO(); + }, + [&](const Fortran::evaluate::Assignment::BoundsRemapping &) { + // Pointer assignment with bounds-remapping + TODO(); + }, + }, + assignment.u); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ContinueStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::DeallocateStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EventPostStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EventWaitStmt &) { + // call some runtime routine + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::FormTeamStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::LockStmt &) { + // call some runtime routine + TODO(); + } + + /// Nullify pointer object list + /// + /// For each pointer object, reset the pointer to a disassociated status. + /// We do this by setting each pointer to null. + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::NullifyStmt &stmt) { + for (auto &po : stmt.v) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::Name &sym) { + auto ty = genType(*sym.symbol); + auto load = builder->create( + toLocation(), localSymbols.lookupSymbol(*sym.symbol)); + auto idxTy = mlir::IndexType::get(&mlirContext); + auto zero = builder->create( + toLocation(), idxTy, builder->getIntegerAttr(idxTy, 0)); + auto cast = + builder->create(toLocation(), ty, zero); + builder->create(toLocation(), cast, load); + }, + [&](const Fortran::parser::StructureComponent &) { TODO(); }, + }, + po.u); + } + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::PointerAssignmentStmt &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SyncAllStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SyncImagesStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SyncMemoryStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SyncTeamStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::UnlockStmt &) { + // call some runtime routine + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssignStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::FormatStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EntryStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::PauseStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::DataStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::NamelistStmt &) { + TODO(); + } + + // call FAIL IMAGE in runtime + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::FailImageStmt &stmt) { + auto callee = genRuntimeFunction( + Fortran::lower::RuntimeEntryCode::FailImageStatement, *builder); + llvm::SmallVector operands; // FAIL IMAGE has no args + builder->create(toLocation(), callee, operands); + } + + // call STOP, ERROR STOP in runtime + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::StopStmt &stmt) { + auto callee = genRuntimeFunction( + Fortran::lower::RuntimeEntryCode::StopStatement, *builder); + llvm::SmallVector operands; + builder->create(toLocation(), callee, operands); + } + + // gen expression, if any; share code with END of procedure + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ReturnStmt &stmt) { + const auto *funit = eval.getOwningProcedure(); + assert(funit && "not inside main program or a procedure"); + if (funit->isMainProgram()) { + genFIRProgramExit(); + } else { + if (stmt.v) { + // Alternate return + TODO(); + } + // an ordinary RETURN should be lowered as a GOTO to the last block of the + // SUBROUTINE + auto *subr = eval.getOwningProcedure(); + assert(subr && "RETURN not in a PROCEDURE"); + if (!subr->finalBlock) { + auto insPt = builder->saveInsertionPoint(); + subr->finalBlock = builder->createBlock(&builder->getRegion()); + builder->restoreInsertionPoint(insPt); + } + builder->create(toLocation(), subr->finalBlock); + } + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CycleStmt &) { + genFIRUnconditionalBranch(eval.controlSuccessor); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ExitStmt &) { + genFIRUnconditionalBranch(eval.controlSuccessor); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::GotoStmt &) { + genFIRUnconditionalBranch(eval.controlSuccessor); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + bool unstructuredContext = true) { + if (eval.skip) + return; // rhs of {Forall,If,Where}Stmt has already been processed + + setCurrentPosition(eval.position); + if (unstructuredContext) { + // When transitioning from unstructured to structured code, + // the structured code might be a target that starts a new block. + maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured() + ? eval.evaluationList->front().block + : eval.block); + } + eval.visit([&](const auto &stmt) { genFIR(eval, stmt); }); + if (unstructuredContext && eval.isActionStmt() && eval.controlSuccessor && + eval.controlSuccessor->block && blockIsUnterminated()) { + // Exit from an unstructured IF or SELECT construct block. + genFIRUnconditionalBranch(eval.controlSuccessor); + } + } + + mlir::FuncOp createNewFunction(mlir::Location loc, llvm::StringRef name, + const Fortran::semantics::Symbol *symbol) { + mlir::FunctionType ty = + symbol ? genFunctionType(*symbol) + : mlir::FunctionType::get(llvm::None, llvm::None, &mlirContext); + return Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty); + } + + /// Temporary helper to detect shapes that do not require evaluating + /// bound expressions at runtime or to get the shape from a descriptor. + static bool isConstantShape(const Fortran::semantics::ArraySpec &shape) { + auto isConstant{[](const auto &bound) { + const auto &expr = bound.GetExplicit(); + return expr.has_value() && Fortran::evaluate::IsConstantExpr(*expr); + }}; + for (const auto &susbcript : shape) { + const auto &lb = susbcript.lbound(); + const auto &ub = susbcript.ubound(); + if (isConstant(lb) && (isConstant(ub) || ub.isAssumed())) + break; + return false; + } + return true; + } + + /// Evaluate specification expressions of local symbol and add + /// the resulting mlir::value to localSymbols. + /// Before evaluating a specification expression, the symbols + /// appearing in the expression are gathered, and if they are also + /// local symbols, their specification are evaluated first. In case + /// a circular dependency occurs, this will crash. + void instantiateLocalVariable( + const Fortran::semantics::Symbol &symbol, + Fortran::lower::SymMap &dummyArgs, + llvm::DenseSet attempted) { + if (localSymbols.lookupSymbol(symbol)) + return; // already instantiated + + if (IsProcedure(symbol)) + return; + + if (symbol.has() || + symbol.has()) + TODO(); // Need to keep the localSymbols of other units ? + + if (attempted.find(symbol) != attempted.end()) + TODO(); // Complex dependencies in specification expressions. + + attempted.insert(symbol); + mlir::Value localValue; + auto *type = symbol.GetType(); + assert(type && "expected type for local symbol"); + + if (type->category() == Fortran::semantics::DeclTypeSpec::Character) { + const auto &lengthParam = type->characterTypeSpec().length(); + if (auto expr = lengthParam.GetExplicit()) { + for (const auto &requiredSymbol : + Fortran::evaluate::CollectSymbols(*expr)) { + instantiateLocalVariable(requiredSymbol, dummyArgs, attempted); + } + auto lenValue = + genExprValue(Fortran::evaluate::AsGenericExpr(std::move(*expr))); + if (auto actual = dummyArgs.lookupSymbol(symbol)) { + auto unboxed = builder->createUnboxChar(actual); + localValue = builder->createEmboxChar(unboxed.first, lenValue); + } else { + // TODO: propagate symbol name to FIR. + localValue = builder->createCharacterTemp(genType(symbol), lenValue); + } + } else if (lengthParam.isDeferred()) { + TODO(); + } else { + // Assumed + localValue = dummyArgs.lookupSymbol(symbol); + assert(localValue && + "expected dummy arguments when length not explicit"); + } + localSymbols.addSymbol(symbol, localValue); + } else if (!type->AsIntrinsic()) { + TODO(); // Derived type / polymorphic + } else { + if (auto actualValue = dummyArgs.lookupSymbol(symbol)) + localSymbols.addSymbol(symbol, actualValue); + else + createTemporary(toLocation(), symbol); + } + if (const auto *details = + symbol.detailsIf()) { + // For now, only allow compile time constant shapes that do no require + // to evaluate bounds expression here. Assumed size are also supported. + if (!isConstantShape(details->shape())) + TODO(); + // handle bounds specification expressions + if (!details->coshape().empty()) + TODO(); // handle cobounds specification expressions + if (details->init()) + TODO(); // init + } else { + assert(symbol.has()); + TODO(); // Procedure pointers + } + attempted.erase(symbol); + } + + /// Prepare to translate a new function + void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { + assert(!builder && "expected nullptr"); + // get mangled name + std::string name = funit.isMainProgram() + ? uniquer.doProgramEntry().str() + : mangleName(funit.getSubprogramSymbol()); + + // FIXME: do NOT use unknown for the anonymous PROGRAM case. We probably + // should just stash the location in the funit regardless. + mlir::Location loc = toLocation(funit.getStartingSourceLoc()); + mlir::FuncOp func = + Fortran::lower::FirOpBuilder::getNamedFunction(module, name); + if (!func) + func = createNewFunction(loc, name, funit.symbol); + builder = new Fortran::lower::FirOpBuilder(func); + assert(builder && "FirOpBuilder did not instantiate"); + func.addEntryBlock(); + builder->setInsertionPointToStart(&func.front()); + + Fortran::lower::SymMap dummyAssociations; + // plumb function's arguments + if (funit.symbol && !funit.isMainProgram()) { + auto *entryBlock = &func.front(); + const auto &details = + funit.symbol->get(); + for (const auto &v : + llvm::zip(details.dummyArgs(), entryBlock->getArguments())) { + if (std::get<0>(v)) { + dummyAssociations.addSymbol(*std::get<0>(v), std::get<1>(v)); + } else { + TODO(); // handle alternate return + } + } + + // Go through the symbol scope and evaluate specification expressions + llvm::DenseSet attempted; + assert(funit.symbol->scope() && "subprogram symbol must have a scope"); + // TODO: This loop through scope symbols offers no stability guarantee + // regarding the order. This should not be a problem given how + // instantiateLocalVariable is implemented, but may harm reproducibility. + // A solution would be to sort the symbol based on their source location. + for (const auto &iter : *funit.symbol->scope()) { + instantiateLocalVariable(iter.second.get(), dummyAssociations, + attempted); + } + + // if (details.isFunction()) + // createTemporary(toLocation(), details.result()); + } + + // Create most function blocks in advance. + createEmptyBlocks(funit.evaluationList); + + // Reinstate entry block as the current insertion point. + builder->setInsertionPointToEnd(&func.front()); + } + + /// Create empty blocks for the current function. + void createEmptyBlocks( + std::list &evaluationList) { + for (auto &eval : evaluationList) { + if (eval.isNewBlock) + eval.block = builder->createBlock(&builder->getRegion()); + for (size_t i = 0, n = eval.localBlocks.size(); i < n; ++i) + eval.localBlocks[i] = builder->createBlock(&builder->getRegion()); + if (eval.isConstruct()) { + if (eval.lowerAsUnstructured()) { + createEmptyBlocks(*eval.evaluationList); + } else { + // A structured construct that is a target starts a new block. + Fortran::lower::pft::Evaluation &constructStmt = + eval.evaluationList->front(); + if (constructStmt.isNewBlock) + constructStmt.block = builder->createBlock(&builder->getRegion()); + } + } + } + } + + /// Return the predicate: "current block does not have a terminator branch". + bool blockIsUnterminated() { + auto *currentBlock = builder->getBlock(); + return currentBlock->empty() || currentBlock->back().isKnownNonTerminator(); + } + + /// Unconditionally switch code insertion to a new block. + void startBlock(mlir::Block *newBlock) { + assert(newBlock && "missing block"); + // If the current block does not have a terminator branch, + // append a fallthrough branch. + if (blockIsUnterminated()) + genFIRUnconditionalBranch(newBlock); + builder->setInsertionPointToStart(newBlock); + } + + /// Conditionally switch code insertion to a new block. + void maybeStartBlock(mlir::Block *newBlock) { + if (newBlock) + startBlock(newBlock); + } + + /// Emit return and cleanup after the function has been translated. + void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { + setCurrentPosition( + Fortran::lower::pft::FunctionLikeUnit::stmtSourceLoc(funit.endStmt)); + + if (funit.isMainProgram()) { + genFIRProgramExit(); + } else { + genFIRProcedureExit(funit, funit.getSubprogramSymbol()); + } + + delete builder; + builder = nullptr; + localSymbols.clear(); + } + + /// Lower a procedure-like construct + void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) { + startNewFunction(funit); + // lower this procedure + for (auto &eval : funit.evaluationList) + genFIR(eval); + + endNewFunction(funit); + // recursively lower internal procedures + for (auto &f : funit.nestedFunctions) + lowerFunc(f); + } + + void lowerMod(Fortran::lower::pft::ModuleLikeUnit &mod) { + // FIXME: do we need to visit the module statements? + for (auto &f : mod.nestedFunctions) + lowerFunc(f); + } + + void setCurrentPosition(const Fortran::parser::CharBlock &position) { + if (position != Fortran::parser::CharBlock{}) + currentPosition = position; + } + + // + // Utility methods + // + + /// Convert a parser CharBlock to a Location + mlir::Location toLocation(const Fortran::parser::CharBlock &cb) { + return genLocation(cb); + } + + mlir::Location toLocation() { return toLocation(currentPosition); } + + // TODO: should these be moved to convert-expr? + template + mlir::Value genCompare(mlir::Value lhs, mlir::Value rhs) { + auto lty = lhs.getType(); + assert(lty == rhs.getType()); + if (lty.isSignlessIntOrIndex()) + return builder->create(lhs.getLoc(), ICMPOPC, lhs, rhs); + if (fir::LogicalType::kindof(lty.getKind())) + return builder->create(lhs.getLoc(), ICMPOPC, lhs, rhs); + if (fir::CharacterType::kindof(lty.getKind())) { + // FIXME + // return builder->create(lhs->getLoc(), ); + } + mlir::emitError(toLocation(), "cannot generate operation on this type"); + return {}; + } + + mlir::Value genGE(mlir::Value lhs, mlir::Value rhs) { + return genCompare(lhs, rhs); + } + mlir::Value genLE(mlir::Value lhs, mlir::Value rhs) { + return genCompare(lhs, rhs); + } + mlir::Value genEQ(mlir::Value lhs, mlir::Value rhs) { + return genCompare(lhs, rhs); + } + mlir::Value genAND(mlir::Value lhs, mlir::Value rhs) { + return builder->create(lhs.getLoc(), lhs, rhs); + } + + mlir::MLIRContext &mlirContext; + const Fortran::parser::CookedSource *cooked; + mlir::ModuleOp &module; + const Fortran::common::IntrinsicTypeDefaultKinds &defaults; + Fortran::lower::IntrinsicLibrary intrinsics; + Fortran::lower::FirOpBuilder *builder = nullptr; + fir::NameUniquer &uniquer; + Fortran::lower::SymMap localSymbols; + Fortran::parser::CharBlock currentPosition; +}; + +} // namespace + +void Fortran::lower::LoweringBridge::lower(const Fortran::parser::Program &prg, + fir::NameUniquer &uniquer) { + auto pft = Fortran::lower::createPFT(prg); + if (dumpBeforeFir) + Fortran::lower::dumpPFT(llvm::errs(), *pft); + FirConverter converter{*this, uniquer}; + converter.run(*pft); +} + +void Fortran::lower::LoweringBridge::parseSourceFile(llvm::SourceMgr &srcMgr) { + auto owningRef = mlir::parseSourceFile(srcMgr, context.get()); + module.reset(new mlir::ModuleOp(owningRef.get().getOperation())); + owningRef.release(); +} + +Fortran::lower::LoweringBridge::LoweringBridge( + const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, + const Fortran::parser::CookedSource *cooked) + : defaultKinds{defaultKinds}, cooked{cooked} { + context = std::make_unique(); + module = std::make_unique( + mlir::ModuleOp::create(mlir::UnknownLoc::get(context.get()))); +} diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt index 07b87ef22ce92..a3514b11ad11a 100644 --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -1,10 +1,13 @@ get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) add_flang_library(FortranLower + Bridge.cpp + CallInterface.cpp CharacterExpr.cpp CharacterRuntime.cpp Coarray.cpp ComplexExpr.cpp + ConvertExpr.cpp ConvertType.cpp ConvertExpr.cpp DoLoopHelper.cpp @@ -15,6 +18,7 @@ add_flang_library(FortranLower OpenACC.cpp OpenMP.cpp PFTBuilder.cpp + Runtime.cpp DEPENDS FIROptimizer diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 1bac6884a5f7e..fb2d58bb9ec8b 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -6,9 +6,1457 @@ // //===----------------------------------------------------------------------===// -#include "flang/Common/idioms.h" +#include "flang/Lower/ConvertExpr.h" +#include "SymbolMap.h" +#include "flang/Common/default-kinds.h" +#include "flang/Common/unwrap.h" +#include "flang/Evaluate/fold.h" +#include "flang/Evaluate/real.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/CallInterface.h" +#include "flang/Lower/CharacterExpr.h" +#include "flang/Lower/CharacterRuntime.h" +#include "flang/Lower/Coarray.h" +#include "flang/Lower/ComplexExpr.h" +#include "flang/Lower/ConvertType.h" #include "flang/Lower/IntrinsicCall.h" -#include "flang/Lower/Support/BoxValue.h" +#include "flang/Lower/Runtime.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Semantics/expression.h" +#include "flang/Semantics/symbol.h" +#include "flang/Semantics/tools.h" +#include "flang/Semantics/type.h" +#include "mlir/Dialect/Affine/IR/AffineOps.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "llvm/ADT/APFloat.h" +#include "llvm/Support/ErrorHandling.h" +#include "llvm/Support/raw_ostream.h" + +#define TODO() llvm_unreachable("not yet implemented") + +namespace { + +/// Lowering of Fortran::evaluate::Expr expressions +class ExprLowering { +public: + explicit ExprLowering(mlir::Location loc, + Fortran::lower::AbstractConverter &converter, + Fortran::lower::SymMap &map, + const Fortran::lower::ExpressionContext &context + ) + : location{loc}, converter{converter}, + builder{converter.getFirOpBuilder()}, symMap{map}, context{context} {} + + /// Lower the expression `expr` into MLIR standard dialect + mlir::Value genAddr(const Fortran::lower::SomeExpr &expr) { + return fir::getBase(gen(expr)); + } + + fir::ExtendedValue genExtAddr(const Fortran::lower::SomeExpr &expr) { + return gen(expr); + } + + mlir::Value genValue(const Fortran::lower::SomeExpr &expr) { + return fir::getBase(genval(expr)); + } + + fir::ExtendedValue genExtValue(const Fortran::lower::SomeExpr &expr) { + return genval(expr); + } + + fir::ExtendedValue genStringLit(llvm::StringRef str, std::uint64_t len) { + return genScalarLit<1>(str.str(), static_cast(len)); + } + +private: + mlir::Location location; + Fortran::lower::AbstractConverter &converter; + Fortran::lower::FirOpBuilder &builder; + Fortran::lower::SymMap &symMap; + const Fortran::lower::ExpressionContext &context; + + mlir::Location getLoc() { return location; } + + template + mlir::Value genunbox(const A &expr) { + auto e = genval(expr); + if (auto *r = e.getUnboxed()) + return *r; + llvm::report_fatal_error("value is not unboxed"); + } + + /// Convert parser's INTEGER relational operators to MLIR. TODO: using + /// unordered, but we may want to cons ordered in certain situation. + static mlir::CmpIPredicate + translateRelational(Fortran::common::RelationalOperator rop) { + switch (rop) { + case Fortran::common::RelationalOperator::LT: + return mlir::CmpIPredicate::slt; + case Fortran::common::RelationalOperator::LE: + return mlir::CmpIPredicate::sle; + case Fortran::common::RelationalOperator::EQ: + return mlir::CmpIPredicate::eq; + case Fortran::common::RelationalOperator::NE: + return mlir::CmpIPredicate::ne; + case Fortran::common::RelationalOperator::GT: + return mlir::CmpIPredicate::sgt; + case Fortran::common::RelationalOperator::GE: + return mlir::CmpIPredicate::sge; + } + llvm_unreachable("unhandled INTEGER relational operator"); + } + + /// Convert parser's REAL relational operators to MLIR. + /// The choice of order (O prefix) vs unorder (U prefix) follows Fortran 2018 + /// requirements in the IEEE context (table 17.1 of F2018). This choice is + /// also applied in other contexts because it is easier and in line with + /// other Fortran compilers. + /// FIXME: The signaling/quiet aspect of the table 17.1 requirement is not + /// fully enforced. FIR and LLVM `fcmp` instructions do not give any guarantee + /// whether the comparison will signal or not in case of quiet NaN argument. + static mlir::CmpFPredicate + translateFloatRelational(Fortran::common::RelationalOperator rop) { + switch (rop) { + case Fortran::common::RelationalOperator::LT: + return mlir::CmpFPredicate::OLT; + case Fortran::common::RelationalOperator::LE: + return mlir::CmpFPredicate::OLE; + case Fortran::common::RelationalOperator::EQ: + return mlir::CmpFPredicate::OEQ; + case Fortran::common::RelationalOperator::NE: + return mlir::CmpFPredicate::UNE; + case Fortran::common::RelationalOperator::GT: + return mlir::CmpFPredicate::OGT; + case Fortran::common::RelationalOperator::GE: + return mlir::CmpFPredicate::OGE; + } + llvm_unreachable("unhandled REAL relational operator"); + } + + /// Generate an integral constant of `value` + template + mlir::Value genIntegerConstant(mlir::MLIRContext *context, + std::int64_t value) { + auto type = converter.genType(Fortran::common::TypeCategory::Integer, KIND); + auto attr = builder.getIntegerAttr(type, value); + return builder.create(getLoc(), type, attr); + } + + /// Generate a logical/boolean constant of `value` + mlir::Value genBoolConstant(mlir::MLIRContext *context, bool value) { + auto i1Type = builder.getI1Type(); + auto attr = builder.getIntegerAttr(i1Type, value ? 1 : 0); + return builder.create(getLoc(), i1Type, attr).getResult(); + } + + template + mlir::Value genRealConstant(mlir::MLIRContext *context, + const llvm::APFloat &value) { + auto fltTy = Fortran::lower::convertReal(context, KIND); + auto attr = builder.getFloatAttr(fltTy, value); + auto res = builder.create(getLoc(), fltTy, attr); + return res.getResult(); + } + + mlir::Type getSomeKindInteger() { return builder.getIndexType(); } + + template + mlir::Value createBinaryOp(const fir::ExtendedValue &left, + const fir::ExtendedValue &right) { + if (auto *lhs = left.getUnboxed()) + if (auto *rhs = right.getUnboxed()) { + assert(lhs && rhs && "argument did not lower"); + return builder.create(getLoc(), *lhs, *rhs); + } + // binary ops can appear in array contexts + TODO(); + } + template + mlir::Value createBinaryOp(const A &ex) { + return createBinaryOp(genval(ex.left()), genval(ex.right())); + } + + mlir::FuncOp getFunction(llvm::StringRef name, mlir::FunctionType funTy) { + if (auto func = builder.getNamedFunction(name)) + return func; + return builder.createFunction(getLoc(), name, funTy); + } + + template + mlir::FunctionType createFunctionType() { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + auto output = + converter.genType(Fortran::common::TypeCategory::Integer, KIND); + llvm::SmallVector inputs; + inputs.push_back(output); + inputs.push_back(output); + return mlir::FunctionType::get(inputs, output, builder.getContext()); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + auto output = Fortran::lower::convertReal(builder.getContext(), KIND); + llvm::SmallVector inputs; + inputs.push_back(output); + inputs.push_back(output); + return mlir::FunctionType::get(inputs, output, builder.getContext()); + } else { + llvm_unreachable("this category is not implemented"); + } + } + + template + mlir::Value createCompareOp(mlir::CmpIPredicate pred, + const fir::ExtendedValue &left, + const fir::ExtendedValue &right) { + if (auto *lhs = left.getUnboxed()) + if (auto *rhs = right.getUnboxed()) + return builder.create(getLoc(), pred, *lhs, *rhs); + TODO(); + } + template + mlir::Value createCompareOp(const A &ex, mlir::CmpIPredicate pred) { + return createCompareOp(pred, genval(ex.left()), genval(ex.right())); + } + + template + mlir::Value createFltCmpOp(mlir::CmpFPredicate pred, + const fir::ExtendedValue &left, + const fir::ExtendedValue &right) { + if (auto *lhs = left.getUnboxed()) + if (auto *rhs = right.getUnboxed()) + return builder.create(getLoc(), pred, *lhs, *rhs); + TODO(); + } + template + mlir::Value createFltCmpOp(const A &ex, mlir::CmpFPredicate pred) { + return createFltCmpOp(pred, genval(ex.left()), genval(ex.right())); + } + + /// Create a call to the runtime to compare two CHARACTER values. + /// Precondition: This assumes that the two values have `fir.boxchar` type. + mlir::Value createCharCompare(mlir::CmpIPredicate pred, + const fir::ExtendedValue &left, + const fir::ExtendedValue &right) { + if (auto *lhs = left.getUnboxed()) { + if (auto *rhs = right.getUnboxed()) { + return Fortran::lower::genBoxCharCompare(converter, getLoc(), pred, + *lhs, *rhs); + } else if (auto *rhs = right.getCharBox()) { + return Fortran::lower::genBoxCharCompare(converter, getLoc(), pred, + *lhs, rhs->getBuffer()); + } + } + if (auto *lhs = left.getCharBox()) { + if (auto *rhs = right.getCharBox()) { + // FIXME: this should be passing the CharBoxValues and not just a buffer + // addresses + return Fortran::lower::genBoxCharCompare( + converter, getLoc(), pred, lhs->getBuffer(), rhs->getBuffer()); + } else if (auto *rhs = right.getUnboxed()) { + return Fortran::lower::genBoxCharCompare(converter, getLoc(), pred, + lhs->getBuffer(), *rhs); + } + } + + // Error if execution reaches this point + mlir::emitError(getLoc(), "Unhandled character comparison"); + exit(1); + } + + template + mlir::Value createCharCompare(const A &ex, mlir::CmpIPredicate pred) { + return createCharCompare(pred, genval(ex.left()), genval(ex.right())); + } + + fir::ExtendedValue getExValue(const Fortran::lower::SymbolBox &symBox) { + using T = fir::ExtendedValue; + return std::visit( + Fortran::common::visitors{ + [](const Fortran::lower::SymbolBox::Intrinsic &box) -> T { + return box.getAddr(); + }, + [](const auto &box) -> T { return box; }, + [](const Fortran::lower::SymbolBox::None &) -> T { + llvm_unreachable("symbol not mapped"); + }}, + symBox.box); + } + + /// Returns a reference to a symbol or its box/boxChar descriptor if it has + /// one. + fir::ExtendedValue gen(Fortran::semantics::SymbolRef sym) { + if (auto val = symMap.lookupSymbol(sym)) + return getExValue(val); + llvm_unreachable("all symbols should be in the map"); + auto addr = builder.createTemporary(getLoc(), converter.genType(sym), + sym->name().ToString()); + symMap.addSymbol(sym, addr); + return addr; + } + + mlir::Value genLoad(mlir::Value addr) { + return builder.create(getLoc(), addr); + } + + // FIXME: replace this + mlir::Type peelType(mlir::Type ty, int count) { + if (count > 0) { + if (auto eleTy = fir::dyn_cast_ptrEleTy(ty)) + return peelType(eleTy, count - 1); + if (auto seqTy = ty.dyn_cast()) + return peelType(seqTy.getEleTy(), count - seqTy.getDimension()); + llvm_unreachable("unhandled type"); + } + return ty; + } + + fir::ExtendedValue genval(Fortran::semantics::SymbolRef sym) { + auto var = gen(sym); + if (auto *s = var.getUnboxed()) + if (fir::isReferenceLike(s->getType())) + return genLoad(*s); + if (inArrayContext()) { + // FIXME: make this more robust + auto base = fir::getBase(var); + auto ty = builder.getRefType(peelType(base.getType(), context.getLoopVars().size() + 1)); + auto coor = builder.create(getLoc(), ty, base, context.getLoopVars()); + return genLoad(coor); + } + return var; + } + + fir::ExtendedValue genval(const Fortran::evaluate::BOZLiteralConstant &) { + TODO(); + } + fir::ExtendedValue + genval(const Fortran::evaluate::ProcedureDesignator &proc) { + if (const auto *intrinsic = proc.GetSpecificIntrinsic()) { + auto signature = Fortran::lower::translateSignature(proc, converter); + auto symbolRefAttr = + Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr( + builder, getLoc(), intrinsic->name, signature); + mlir::Value funcPtr = + builder.create(getLoc(), signature, symbolRefAttr); + return funcPtr; + } + const auto *symbol = proc.GetSymbol(); + assert(symbol && "expected symbol in ProcedureDesignator"); + if (Fortran::semantics::IsDummy(*symbol)) { + auto val = symMap.lookupSymbol(*symbol); + assert(val && "Dummy procedure not in symbol map"); + return val; + } + auto name = converter.mangleName(*symbol); + auto func = builder.getNamedFunction(name); + // TODO: If this is an external not called/defined in this file + // (e.g, it is just being passed as a dummy procedure argument) + // we need to create a funcOp for it with the interface we have. + if (!func) + TODO(); + mlir::Value funcPtr = builder.create( + getLoc(), func.getType(), builder.getSymbolRefAttr(name)); + return funcPtr; + } + fir::ExtendedValue genval(const Fortran::evaluate::NullPointer &) { + return builder.createNullConstant(location); + } + fir::ExtendedValue genval(const Fortran::evaluate::StructureConstructor &) { + TODO(); + } + fir::ExtendedValue genval(const Fortran::evaluate::ImpliedDoIndex &) { + TODO(); + } + + fir::ExtendedValue genval(const Fortran::evaluate::DescriptorInquiry &desc) { + auto descRef = symMap.lookupSymbol(desc.base().GetLastSymbol()); + assert(descRef && "no mlir::Value associated to Symbol"); + auto descType = descRef.getAddr().getType(); + mlir::Value res{}; + switch (desc.field()) { + case Fortran::evaluate::DescriptorInquiry::Field::Len: + if (descType.isa()) { + auto lenType = Fortran::lower::CharacterExprHelper{builder, getLoc()} + .getLengthType(); + res = builder.create(getLoc(), lenType, descRef); + } else if (descType.isa()) { + TODO(); + } else { + llvm_unreachable("not a descriptor"); + } + break; + default: + TODO(); + } + return res; + } + + template + fir::ExtendedValue genval(const Fortran::evaluate::TypeParamInquiry &) { + TODO(); + } + + mlir::Value extractComplexPart(mlir::Value cplx, bool isImagPart) { + return Fortran::lower::ComplexExprHelper{builder, getLoc()} + .extractComplexPart(cplx, isImagPart); + } + + template + fir::ExtendedValue + genval(const Fortran::evaluate::ComplexComponent &part) { + auto lhs = genunbox(part.left()); + assert(lhs && "boxed type not handled"); + return extractComplexPart(lhs, part.isImaginaryPart); + } + + template + fir::ExtendedValue genval( + const Fortran::evaluate::Negate> &op) { + auto input = genunbox(op.left()); + assert(input && "boxed value not handled"); + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + // Currently no Standard/FIR op for integer negation. + auto zero = genIntegerConstant(builder.getContext(), 0); + return builder.create(getLoc(), zero, input); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + return builder.create(getLoc(), input); + } else { + static_assert(TC == Fortran::common::TypeCategory::Complex, + "Expected numeric type"); + return createBinaryOp(op); + } + } + + template + fir::ExtendedValue + genval(const Fortran::evaluate::Add> &op) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + return createBinaryOp(op); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + return createBinaryOp(op); + } else { + static_assert(TC == Fortran::common::TypeCategory::Complex, + "Expected numeric type"); + return createBinaryOp(op); + } + } + template + fir::ExtendedValue + genval(const Fortran::evaluate::Subtract> + &op) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + return createBinaryOp(op); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + return createBinaryOp(op); + } else { + static_assert(TC == Fortran::common::TypeCategory::Complex, + "Expected numeric type"); + return createBinaryOp(op); + } + } + + template + fir::ExtendedValue + genval(const Fortran::evaluate::Multiply> + &op) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + return createBinaryOp(op); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + return createBinaryOp(op); + } else { + static_assert(TC == Fortran::common::TypeCategory::Complex, + "Expected numeric type"); + return createBinaryOp(op); + } + } + + template + fir::ExtendedValue genval( + const Fortran::evaluate::Divide> &op) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + return createBinaryOp(op); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + return createBinaryOp(op); + } else { + static_assert(TC == Fortran::common::TypeCategory::Complex, + "Expected numeric type"); + return createBinaryOp(op); + } + } + + template + fir::ExtendedValue genval( + const Fortran::evaluate::Power> &op) { + auto ty = converter.genType(TC, KIND); + auto lhs = genunbox(op.left()); + auto rhs = genunbox(op.right()); + assert(lhs && rhs && "boxed value not handled"); + return Fortran::lower::genPow(builder, getLoc(), ty, lhs, rhs); + } + + template + fir::ExtendedValue genval( + const Fortran::evaluate::RealToIntPower> + &op) { + auto ty = converter.genType(TC, KIND); + auto lhs = genunbox(op.left()); + auto rhs = genunbox(op.right()); + assert(lhs && rhs && "boxed value not handled"); + return Fortran::lower::genPow(builder, getLoc(), ty, lhs, rhs); + } + + mlir::Value createComplex(fir::KindTy kind, mlir::Value real, + mlir::Value imag) { + return Fortran::lower::ComplexExprHelper{builder, getLoc()}.createComplex( + kind, real, imag); + } + + template + fir::ExtendedValue + genval(const Fortran::evaluate::ComplexConstructor &op) { + auto lhs = genunbox(op.left()); + auto rhs = genunbox(op.right()); + assert(lhs && rhs && "boxed value not handled"); + return createComplex(KIND, lhs, rhs); + } + + template + fir::ExtendedValue genval(const Fortran::evaluate::Concat &op) { + auto lhs = genval(op.left()); + auto rhs = genval(op.right()); + auto lhsBase = fir::getBase(lhs); + auto rhsBase = fir::getBase(rhs); + return Fortran::lower::CharacterExprHelper{builder, getLoc()} + .createConcatenate(lhsBase, rhsBase); + } + + /// MIN and MAX operations + template + fir::ExtendedValue + genval(const Fortran::evaluate::Extremum> + &op) { + auto lhs = genunbox(op.left()); + auto rhs = genunbox(op.right()); + assert(lhs && rhs && "boxed value not handled"); + llvm::SmallVector operands{lhs, rhs}; + if (op.ordering == Fortran::evaluate::Ordering::Greater) + return Fortran::lower::genMax(builder, getLoc(), operands); + return Fortran::lower::genMin(builder, getLoc(), operands); + } + + template + fir::ExtendedValue genval(const Fortran::evaluate::SetLength &) { + TODO(); + } + + mlir::Value createComplexCompare(mlir::Value cplx1, mlir::Value cplx2, + bool eq) { + return Fortran::lower::ComplexExprHelper{builder, getLoc()} + .createComplexCompare(cplx1, cplx2, eq); + } + + template + fir::ExtendedValue + genval(const Fortran::evaluate::Relational> + &op) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + return createCompareOp(op, translateRelational(op.opr)); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + return createFltCmpOp(op, translateFloatRelational(op.opr)); + } else if constexpr (TC == Fortran::common::TypeCategory::Complex) { + bool eq{op.opr == Fortran::common::RelationalOperator::EQ}; + if (!eq && op.opr != Fortran::common::RelationalOperator::NE) + llvm_unreachable("relation undefined for complex"); + auto lhs = genunbox(op.left()); + auto rhs = genunbox(op.right()); + assert(lhs && rhs && "boxed value not handled"); + return createComplexCompare(lhs, rhs, eq); + } else { + static_assert(TC == Fortran::common::TypeCategory::Character); + return createCharCompare(op, translateRelational(op.opr)); + } + } + + fir::ExtendedValue + genval(const Fortran::evaluate::Relational &op) { + return std::visit([&](const auto &x) { return genval(x); }, op.u); + } + + template + fir::ExtendedValue + genval(const Fortran::evaluate::Convert, + TC2> &convert) { + auto ty = converter.genType(TC1, KIND); + auto operand = genunbox(convert.left()); + assert(operand && "boxed value not handled"); + return builder.createConvert(getLoc(), ty, operand); + } + + template + fir::ExtendedValue genval(const Fortran::evaluate::Parentheses &op) { + auto input = genval(op.left()); + auto base = fir::getBase(input); + mlir::Value newBase = + builder.create(getLoc(), base.getType(), base); + return fir::substBase(input, newBase); + } + + template + fir::ExtendedValue genval(const Fortran::evaluate::Not &op) { + auto *context = builder.getContext(); + auto logical = genunbox(op.left()); + assert(logical && "boxed value not handled"); + auto one = genBoolConstant(context, true); + auto val = builder.createConvert(getLoc(), builder.getI1Type(), logical); + return builder.create(getLoc(), val, one); + } + + template + fir::ExtendedValue + genval(const Fortran::evaluate::LogicalOperation &op) { + auto i1Type = builder.getI1Type(); + auto slhs = genunbox(op.left()); + auto srhs = genunbox(op.right()); + assert(slhs && srhs && "boxed value not handled"); + auto lhs = builder.createConvert(getLoc(), i1Type, slhs); + auto rhs = builder.createConvert(getLoc(), i1Type, srhs); + switch (op.logicalOperator) { + case Fortran::evaluate::LogicalOperator::And: + return createBinaryOp(lhs, rhs); + case Fortran::evaluate::LogicalOperator::Or: + return createBinaryOp(lhs, rhs); + case Fortran::evaluate::LogicalOperator::Eqv: + return createCompareOp(mlir::CmpIPredicate::eq, lhs, rhs); + case Fortran::evaluate::LogicalOperator::Neqv: + return createCompareOp(mlir::CmpIPredicate::ne, lhs, rhs); + case Fortran::evaluate::LogicalOperator::Not: + // lib/evaluate expression for .NOT. is Fortran::evaluate::Not. + llvm_unreachable(".NOT. is not a binary operator"); + } + llvm_unreachable("unhandled logical operation"); + } + + /// Convert a scalar literal constant to IR. + template + fir::ExtendedValue genScalarLit( + const Fortran::evaluate::Scalar> + &value) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + return genIntegerConstant(builder.getContext(), value.ToInt64()); + } else if constexpr (TC == Fortran::common::TypeCategory::Logical) { + return genBoolConstant(builder.getContext(), value.IsTrue()); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + std::string str = value.DumpHexadecimal(); + if constexpr (KIND == 2) { + llvm::APFloat floatVal{llvm::APFloatBase::IEEEhalf(), str}; + return genRealConstant(builder.getContext(), floatVal); + } else if constexpr (KIND == 4) { + llvm::APFloat floatVal{llvm::APFloatBase::IEEEsingle(), str}; + return genRealConstant(builder.getContext(), floatVal); + } else if constexpr (KIND == 10) { + llvm::APFloat floatVal{llvm::APFloatBase::x87DoubleExtended(), str}; + return genRealConstant(builder.getContext(), floatVal); + } else if constexpr (KIND == 16) { + llvm::APFloat floatVal{llvm::APFloatBase::IEEEquad(), str}; + return genRealConstant(builder.getContext(), floatVal); + } else { + // convert everything else to double + llvm::APFloat floatVal{llvm::APFloatBase::IEEEdouble(), str}; + return genRealConstant(builder.getContext(), floatVal); + } + } else if constexpr (TC == Fortran::common::TypeCategory::Complex) { + using TR = + Fortran::evaluate::Type; + Fortran::evaluate::ComplexConstructor ctor( + Fortran::evaluate::Expr{ + Fortran::evaluate::Constant{value.REAL()}}, + Fortran::evaluate::Expr{ + Fortran::evaluate::Constant{value.AIMAG()}}); + auto cplx = genunbox(ctor); + assert(cplx && "boxed value not handled"); + return cplx; + } else /*constexpr*/ { + llvm_unreachable("unhandled constant"); + } + } + /// Convert a scalar literal CHARACTER to IR. (specialization) + template + fir::ExtendedValue + genScalarLit(const Fortran::evaluate::Scalar> &value, + int64_t len) { + auto type = fir::SequenceType::get( + {len}, fir::CharacterType::get(builder.getContext(), KIND)); + // FIXME: for wider char types, use an array of i16 or i32 + // for now, just fake it that it's a i8 to get it past the C++ compiler + std::string globalName = + converter.uniqueCGIdent("cl", (const char *)value.c_str()); + auto global = builder.getNamedGlobal(globalName); + if (!global) + global = builder.createGlobalConstant( + getLoc(), type, globalName, + [&](Fortran::lower::FirOpBuilder &builder) { + auto context = builder.getContext(); + // FIXME: more fakery + auto strAttr = + mlir::StringAttr::get((const char *)value.c_str(), context); + auto valTag = + mlir::Identifier::get(fir::StringLitOp::value(), context); + mlir::NamedAttribute dataAttr(valTag, strAttr); + auto sizeTag = + mlir::Identifier::get(fir::StringLitOp::size(), context); + mlir::NamedAttribute sizeAttr(sizeTag, + builder.getI64IntegerAttr(len)); + llvm::SmallVector attrs{dataAttr, + sizeAttr}; + auto str = builder.create( + getLoc(), llvm::ArrayRef{type}, llvm::None, attrs); + builder.create(getLoc(), str); + }); + auto addr = builder.create(getLoc(), global.resultType(), + global.getSymbol()); + auto lenp = builder.createIntegerConstant( + getLoc(), + Fortran::lower::CharacterExprHelper{builder, getLoc()}.getLengthType(), + len); + return fir::CharBoxValue{addr, lenp}; + } + /// Helper to call the correct scalar conversion based on category. + template + fir::ExtendedValue genScalarLit( + const Fortran::evaluate::Scalar> &value, + const Fortran::evaluate::Constant> + &con) { + if constexpr (TC == Fortran::common::TypeCategory::Character) { + return genScalarLit(value, con.LEN()); + } else /*constexpr*/ { + return genScalarLit(value); + } + } + + template + fir::ExtendedValue genArrayLit( + const Fortran::evaluate::Constant> + &con) { + // Convert Ev::ConstantSubs to SequenceType::Shape + fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end()); + auto arrayTy = fir::SequenceType::get(shape, converter.genType(TC, KIND)); + auto eleTy = arrayTy.getEleTy(); + auto idxTy = builder.getIndexType(); + mlir::Value array = builder.create(getLoc(), arrayTy); + Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); + do { + auto constant = + fir::getBase(genScalarLit(con.At(subscripts), con)); + llvm::SmallVector idx; + for (const auto &pair : llvm::zip(subscripts, con.lbounds())) { + const auto &dim = std::get<0>(pair); + const auto &lb = std::get<1>(pair); + idx.push_back(builder.createIntegerConstant(getLoc(), idxTy, dim - lb)); + } + auto insVal = builder.createConvert(getLoc(), eleTy, constant); + array = builder.create(getLoc(), arrayTy, array, + insVal, idx); + } while (con.IncrementSubscripts(subscripts)); + // FIXME: return an ArrayBoxValue + return array; + } + + template + fir::ExtendedValue + genval(const Fortran::evaluate::Constant> + &con) { + // TODO: + // - derived type constant + if (con.Rank() > 0) + return genArrayLit(con); + auto opt = con.GetScalarValue(); + assert(opt.has_value() && "constant has no value"); + return genScalarLit(opt.value(), con); + } + + template + fir::ExtendedValue genval( + const Fortran::evaluate::Constant> &con) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + auto opt = (*con).ToInt64(); + auto type = getSomeKindInteger(); + auto attr = builder.getIntegerAttr(type, opt); + auto res = builder.create(getLoc(), type, attr); + return res.getResult(); + } else { + llvm_unreachable("unhandled constant of unknown kind"); + } + } + + template + fir::ExtendedValue genval(const Fortran::evaluate::ArrayConstructor &) { + TODO(); + } + + fir::ExtendedValue gen(const Fortran::evaluate::ComplexPart &) { TODO(); } + fir::ExtendedValue genval(const Fortran::evaluate::ComplexPart &) { TODO(); } + + /// Reference to a substring. + fir::ExtendedValue gen(const Fortran::evaluate::Substring &s) { + // Get base string + auto baseString = std::visit( + Fortran::common::visitors{ + [&](const Fortran::evaluate::DataRef &x) { return gen(x); }, + [&](const Fortran::evaluate::StaticDataObject::Pointer &) + -> fir::ExtendedValue { TODO(); }, + }, + s.parent()); + llvm::SmallVector bounds; + auto lower = genunbox(s.lower()); + assert(lower && "boxed value not handled"); + bounds.push_back(lower); + if (auto upperBound = s.upper()) { + auto upper = genunbox(*upperBound); + assert(upper && "boxed value not handled"); + bounds.push_back(upper); + } + // FIXME: a string should be a CharBoxValue + auto addr = fir::getBase(baseString); + return Fortran::lower::CharacterExprHelper{builder, getLoc()} + .createSubstring(addr, bounds); + } + + /// The value of a substring. + fir::ExtendedValue genval(const Fortran::evaluate::Substring &ss) { + // FIXME: why is the value of a substring being lowered the same as the + // address of a substring? + return gen(ss); + } + + fir::RangeBoxValue genTriple(const Fortran::evaluate::Triplet &trip) { + mlir::Value lower; + if (auto lo = trip.lower()) + lower = genunbox(*lo); + mlir::Value upper; + if (auto up = trip.upper()) + upper = genunbox(*up); + return {lower, upper, genunbox(trip.stride())}; + } + + /// Special factoring to allow RangeBoxValue to be returned when generating + /// values. + std::variant + genComponent(const Fortran::evaluate::Subscript &subs) { + if (auto *s = std::get_if( + &subs.u)) + return {genval(s->value())}; + if (auto *s = std::get_if(&subs.u)) + return {genTriple(*s)}; + llvm_unreachable("unknown subscript case"); + } + + fir::ExtendedValue genval(const Fortran::evaluate::Subscript &subs) { + if (auto *s = std::get_if( + &subs.u)) + return {genval(s->value())}; + llvm_unreachable("unhandled subscript case"); + } + + fir::ExtendedValue gen(const Fortran::evaluate::DataRef &dref) { + return std::visit([&](const auto &x) { return gen(x); }, dref.u); + } + fir::ExtendedValue genval(const Fortran::evaluate::DataRef &dref) { + return std::visit([&](const auto &x) { return genval(x); }, dref.u); + } + + // Helper function to turn the left-recursive Component structure into a list. + // Returns the object used as the base coordinate for the component chain. + static Fortran::evaluate::DataRef const * + reverseComponents(const Fortran::evaluate::Component &cmpt, + std::list &list) { + list.push_front(&cmpt); + return std::visit(Fortran::common::visitors{ + [&](const Fortran::evaluate::Component &x) { + return reverseComponents(x, list); + }, + [&](auto &) { return &cmpt.base(); }, + }, + cmpt.base().u); + } + + // Return the coordinate of the component reference + fir::ExtendedValue gen(const Fortran::evaluate::Component &cmpt) { + std::list list; + auto *base = reverseComponents(cmpt, list); + llvm::SmallVector coorArgs; + auto obj = genunbox(*base); + assert(obj && "boxed value not handled"); + auto *sym = &cmpt.GetFirstSymbol(); + auto ty = converter.genType(*sym); + for (auto *field : list) { + sym = &field->GetLastSymbol(); + auto name = sym->name().ToString(); + // FIXME: as we're walking the chain of field names, we need to update the + // subtype as we drill down + coorArgs.push_back(builder.create(getLoc(), name, ty)); + } + assert(sym && "no component(s)?"); + ty = builder.getRefType(ty); + return builder.create(getLoc(), ty, obj, coorArgs); + } + + fir::ExtendedValue genval(const Fortran::evaluate::Component &cmpt) { + auto c = gen(cmpt); + if (auto *val = c.getUnboxed()) + return genLoad(*val); + TODO(); + } + + // Determine the result type after removing `dims` dimensions from the array + // type `arrTy` + mlir::Type genSubType(mlir::Type arrTy, unsigned dims) { + auto unwrapTy = arrTy.cast().getEleTy(); + auto seqTy = unwrapTy.cast(); + auto shape = seqTy.getShape(); + assert(shape.size() > 0 && "removing columns for sequence sans shape"); + assert(dims <= shape.size() && "removing more columns than exist"); + fir::SequenceType::Shape newBnds; + // follow Fortran semantics and remove columns (from right) + auto e{shape.size() - dims}; + for (decltype(e) i{0}; i < e; ++i) + newBnds.push_back(shape[i]); + if (!newBnds.empty()) + return fir::SequenceType::get(newBnds, seqTy.getEleTy()); + return seqTy.getEleTy(); + } + + // Generate the code for a Bound value. + fir::ExtendedValue genval(const Fortran::semantics::Bound &bound) { + if (bound.isExplicit()) { + auto sub = bound.GetExplicit(); + if (sub.has_value()) + return genval(*sub); + return genIntegerConstant<8>(builder.getContext(), 1); + } + TODO(); + } + + fir::ExtendedValue + genArrayRefComponent(const Fortran::evaluate::ArrayRef &aref) { + auto base = fir::getBase(gen(aref.base().GetComponent())); + llvm::SmallVector args; + for (auto &subsc : aref.subscript()) { + auto sv = genunbox(subsc); + assert(sv && "boxed value not handled"); + args.push_back(sv); + } + auto ty = genSubType(base.getType(), args.size()); + ty = builder.getRefType(ty); + return builder.create(getLoc(), ty, base, args); + } + + static bool isSlice(const Fortran::evaluate::ArrayRef &aref) { + for (auto &sub : aref.subscript()) { + if (std::holds_alternative(sub.u)) + return true; + } + return false; + } + + bool inArrayContext() { return context.inArrayContext(); } + + fir::ExtendedValue gen(const Fortran::lower::SymbolBox &si, + const Fortran::evaluate::ArrayRef &aref) { + auto loc = getLoc(); + auto addr = si.getAddr(); + auto arrTy = fir::dyn_cast_ptrEleTy(addr.getType()); + auto eleTy = arrTy.cast().getEleTy(); + auto refTy = builder.getRefType(eleTy); + auto base = builder.createConvert(loc, refTy, addr); + auto idxTy = builder.getIndexType(); + auto one = builder.createIntegerConstant(getLoc(), idxTy, 1); + auto zero = builder.createIntegerConstant(getLoc(), idxTy, 0); + auto getLB = [&](const auto &arr, unsigned dim) -> mlir::Value { + return arr.getLBounds().empty() ? one : arr.getLBounds()[dim]; + }; + auto genFullDim = [&](const auto &arr, mlir::Value delta) -> mlir::Value { + mlir::Value total = zero; + assert(arr.getExtents().size() == aref.subscript().size()); + unsigned idx = 0; + unsigned dim = 0; + for (const auto &pair : llvm::zip(arr.getExtents(), aref.subscript())) { + auto subVal = genComponent(std::get<1>(pair)); + if (auto *trip = std::get_if(&subVal)) { + // access A(i:j:k), decl A(m:n), iterspace (t1..) + auto tlb = builder.createConvert(loc, idxTy, std::get<0>(*trip)); + auto dlb = builder.createConvert(loc, idxTy, getLB(arr, dim)); + auto diff = builder.create(loc, tlb, dlb); + assert(idx < context.getLoopVars().size()); + auto sum = builder.create(loc, diff, context.getLoopVars()[idx++]); + auto del = builder.createConvert(loc, idxTy, std::get<2>(*trip)); + auto scaled = builder.create(loc, del, delta); + auto prod = builder.create(loc, scaled, sum); + total = builder.create(loc, prod, total); + if (auto ext = std::get<0>(pair)) + delta = builder.create(loc, delta, ext); + } else { + auto *v = std::get_if(&subVal); + assert(v); + if (auto *sval = v->getUnboxed()) { + auto val = builder.createConvert(loc, idxTy, *sval); + auto lb = builder.createConvert(loc, idxTy, getLB(arr, dim)); + auto diff = builder.create(loc, val, lb); + auto prod = builder.create(loc, delta, diff); + total = builder.create(loc, prod, total); + if (auto ext = std::get<0>(pair)) + delta = builder.create(loc, delta, ext); + } else { + TODO(); + } + } + ++dim; + } + return builder.create( + loc, refTy, base, llvm::ArrayRef{total}); + }; + auto genArraySlice = [&](const auto &arr) -> mlir::Value { + // FIXME: create a loop nest and copy the array slice into a temp + // We need some context here, since we could also box as an argument + return builder.create(loc, refTy); + }; + return std::visit( + Fortran::common::visitors{ + [&](const Fortran::lower::SymbolBox::FullDim &arr) { + if (!inArrayContext() && isSlice(aref)) + return genArraySlice(arr); + return genFullDim(arr, one); + }, + [&](const Fortran::lower::SymbolBox::CharFullDim &arr) { + return genFullDim(arr, arr.getLen()); + }, + [&](const Fortran::lower::SymbolBox::Derived &arr) { + TODO(); + return mlir::Value{}; + }, + [&](const auto &) { + TODO(); + return mlir::Value{}; + }}, + si.box); + } + + // Return the coordinate of the array reference + fir::ExtendedValue gen(const Fortran::evaluate::ArrayRef &aref) { + if (aref.base().IsSymbol()) { + auto &symbol = aref.base().GetFirstSymbol(); + auto si = symMap.lookupSymbol(symbol); + if (!si.hasConstantShape()) + return gen(si, aref); + auto box = gen(symbol); + auto base = fir::getBase(box); + assert(base && "boxed type not handled"); + unsigned i = 0; + llvm::SmallVector args; + auto loc = getLoc(); + for (auto &subsc : aref.subscript()) { + auto subBox = genComponent(subsc); + if (auto *v = std::get_if(&subBox)) { + if (auto *val = v->getUnboxed()) { + auto ty = val->getType(); + auto adj = getLBound(si, i++, ty); + assert(adj && "boxed value not handled"); + args.push_back(builder.create(loc, ty, *val, adj)); + } else { + TODO(); + } + } else { + auto *range = std::get_if(&subBox); + assert(range && "must be a range"); + // triple notation for slicing operation + auto ty = builder.getIndexType(); + auto step = builder.createConvert(loc, ty, std::get<2>(*range)); + auto scale = builder.create(loc, ty, context.getLoopVars()[i], step); + auto off = builder.createConvert(loc, ty, std::get<0>(*range)); + args.push_back(builder.create(loc, ty, off, scale)); + } + } + auto ty = genSubType(base.getType(), args.size()); + ty = builder.getRefType(ty); + return builder.create(loc, ty, base, args); + } + return genArrayRefComponent(aref); + } + + mlir::Value getLBound(const Fortran::lower::SymbolBox &box, unsigned dim, + mlir::Type ty) { + assert(box.hasRank()); + if (box.hasSimpleLBounds()) + return builder.createIntegerConstant(getLoc(), ty, 1); + return builder.createConvert(getLoc(), ty, box.getLBound(dim)); + } + + fir::ExtendedValue genval(const Fortran::evaluate::ArrayRef &aref) { + return genLoad(fir::getBase(gen(aref))); + } + + fir::ExtendedValue gen(const Fortran::evaluate::CoarrayRef &coref) { + return Fortran::lower::CoarrayExprHelper{converter, getLoc(), symMap} + .genAddr(coref); + } + + fir::ExtendedValue genval(const Fortran::evaluate::CoarrayRef &coref) { + return Fortran::lower::CoarrayExprHelper{converter, getLoc(), symMap} + .genValue(coref); + } + + template + fir::ExtendedValue gen(const Fortran::evaluate::Designator &des) { + return std::visit([&](const auto &x) { return gen(x); }, des.u); + } + template + fir::ExtendedValue genval(const Fortran::evaluate::Designator &des) { + return std::visit([&](const auto &x) { return genval(x); }, des.u); + } + + // call a function + template + fir::ExtendedValue gen(const Fortran::evaluate::FunctionRef &funRef) { + TODO(); + } + template + fir::ExtendedValue genval(const Fortran::evaluate::FunctionRef &funRef) { + TODO(); // Derived type functions (user + intrinsics) + } + + fir::ExtendedValue + genIntrinsicRef(const Fortran::evaluate::ProcedureRef &procRef, + const Fortran::evaluate::SpecificIntrinsic &intrinsic, + mlir::ArrayRef resultType) { + if (resultType.size() != 1) + TODO(); // Intrinsic subroutine + + llvm::SmallVector operands; + // Lower arguments + // For now, logical arguments for intrinsic are lowered to `fir.logical` + // so that TRANSFER can work. For some arguments, it could lead to useless + // conversions (e.g scalar MASK of MERGE will be converted to `i1`), but + // the generated code is at least correct. To improve this, the intrinsic + // lowering facility should control argument lowering. + for (const auto &arg : procRef.arguments()) { + if (auto *expr = Fortran::evaluate::UnwrapExpr< + Fortran::evaluate::Expr>(arg)) { + operands.emplace_back(genval(*expr)); + } else { + operands.emplace_back(mlir::Value{}); // absent optional + } + } + // Let the intrinsic library lower the intrinsic procedure call + llvm::StringRef name{intrinsic.name}; + return Fortran::lower::genIntrinsicCall(builder, getLoc(), name, + resultType[0], operands); + } + + template + bool isCharacterType(const A &exp) { + if (auto type = exp.GetType()) + return type->category() == Fortran::common::TypeCategory::Character; + return false; + } + + /// helper to detect statement functions + static bool + isStatementFunctionCall(const Fortran::evaluate::ProcedureRef &procRef) { + if (const auto *symbol = procRef.proc().GetSymbol()) + if (const auto *details = + symbol->detailsIf()) + return details->stmtFunction().has_value(); + return false; + } + /// Generate Statement function calls + fir::ExtendedValue + genStmtFunctionRef(const Fortran::evaluate::ProcedureRef &procRef, + mlir::ArrayRef resultType) { + const auto *symbol = procRef.proc().GetSymbol(); + assert(symbol && "expected symbol in ProcedureRef of statement functions"); + const auto &details = symbol->get(); + + // Statement functions have their own scope, we just need to associate + // the dummy symbols to argument expressions. They are no + // optional/alternate return arguments. Statement functions cannot be + // recursive (directly or indirectly) so it is safe to add dummy symbols to + // the local map here. + for (const auto &pair : + llvm::zip(details.dummyArgs(), procRef.arguments())) { + assert(std::get<0>(pair) && "alternate return in statement function"); + const auto &dummySymbol = *std::get<0>(pair); + assert(std::get<1>(pair) && "optional argument in statement function"); + const auto *expr = std::get<1>(pair)->UnwrapExpr(); + // TODO: assumed type in statement function, that surprisingly seems + // allowed, probably because nobody thought of restricting this usage. + // gfortran/ifort compiles this. + assert(expr && "assumed type used as statement function argument"); + auto argVal = genval(*expr); + if (auto *charBox = argVal.getCharBox()) { + symMap.addCharSymbol(dummySymbol, charBox->getBuffer(), + charBox->getLen()); + } else { + // As per Fortran 2018 C1580, statement function arguments can only be + // scalars, so just pass the base address. + symMap.addSymbol(dummySymbol, fir::getBase(argVal)); + } + } + auto result = genval(details.stmtFunction().value()); + // Remove dummy local arguments from the map. + for (const auto *dummySymbol : details.dummyArgs()) + symMap.erase(*dummySymbol); + return result; + } + + fir::ExtendedValue + genProcedureRef(const Fortran::evaluate::ProcedureRef &procRef, + mlir::ArrayRef resultType) { + if (const auto *intrinsic = procRef.proc().GetSpecificIntrinsic()) + return genIntrinsicRef(procRef, *intrinsic, resultType[0]); + + if (isStatementFunctionCall(procRef)) + return genStmtFunctionRef(procRef, resultType); + + // Implicit interface implementation only + // TODO: Explicit interface, we need to use Characterize here, + // evaluate::IntrinsicProcTable is required to use it. + Fortran::lower::CallerInterface caller(procRef, converter); + using PassBy = Fortran::lower::CallerInterface::PassEntityBy; + + for (const auto &arg : caller.getPassedArguments()) { + const auto *actual = arg.entity; + if (!actual) + TODO(); // optional arguments + const auto *expr = actual->UnwrapExpr(); + if (!expr) + TODO(); // assumed type arguments + + mlir::Value argRef; + mlir::Value argVal; + if (const auto *argSymbol = + Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr)) { + argVal = symMap.lookupSymbol(*argSymbol); + } else { + auto exv = genval(*expr); + // FIXME: should use the box values, etc. + argVal = fir::getBase(exv); + } + auto type = argVal.getType(); + if (fir::isa_passbyref_type(type) || type.isa()) { + argRef = argVal; + argVal = {}; + } + assert((argVal || argRef) && "needs value or address"); + + // Handle cases where the argument must be passed by value + if (arg.passBy == PassBy::Value) { + if (!argVal) + argVal = genLoad(argRef); + caller.placeInput(arg, argVal); + continue; + } + + // From this point, arguments needs to be in memory. + if (!argRef) { + // expression is a value, so store it in a temporary so we can + // pass-by-reference + argRef = builder.createTemporary(getLoc(), argVal.getType()); + builder.create(getLoc(), argVal, argRef); + } + if (arg.passBy == PassBy::BaseAddress) { + caller.placeInput(arg, argRef); + } else if (arg.passBy == PassBy::BoxChar) { + auto boxChar = argRef; + if (!boxChar.getType().isa()) { + Fortran::lower::CharacterExprHelper helper{builder, getLoc()}; + auto ch = helper.materializeCharacter(boxChar); + boxChar = helper.createEmboxChar(ch.first, ch.second); + } + caller.placeInput(arg, boxChar); + } else if (arg.passBy == PassBy::Box) { + TODO(); // generate emboxing if need. + } else if (arg.passBy == PassBy::AddressAndLength) { + Fortran::lower::CharacterExprHelper helper{builder, getLoc()}; + auto ch = helper.materializeCharacter(argRef); + caller.placeAddressAndLengthInput(arg, ch.first, ch.second); + } else { + llvm_unreachable("pass by value not handled here"); + } + } + + // Handle case where caller must pass result + mlir::Value resRef; + if (auto resultArg = caller.getPassedResult()) { + if (resultArg->passBy == PassBy::AddressAndLength) { + // allocate and pass character result + auto len = caller.getResultLength(); + Fortran::lower::CharacterExprHelper helper{builder, getLoc()}; + resRef = helper.createCharacterTemp(resultType[0], len); + auto ch = helper.createUnboxChar(resRef); + caller.placeAddressAndLengthInput(*resultArg, ch.first, ch.second); + } else { + TODO(); // Pass descriptor + } + } + + mlir::Value funcPointer; + mlir::SymbolRefAttr funcSymbolAttr; + if (const auto *sym = caller.getIfIndirectCallSymbol()) { + funcPointer = symMap.lookupSymbol(*sym); + assert(funcPointer && + "dummy procedure or procedure pointer not in symbol map"); + } else { + funcSymbolAttr = builder.getSymbolRefAttr(caller.getMangledName()); + } + + auto funcType = + funcPointer ? caller.genFunctionType() : caller.getFuncOp().getType(); + llvm::SmallVector operands; + // First operand of indirect call is the function pointer. Cast it to + // required function type for the call to handle procedures that have a + // compatible interface in Fortran, but that have different signatures in + // FIR. + if (funcPointer) + operands.push_back( + builder.createConvert(getLoc(), funcType, funcPointer)); + // In older Fortran, procedure argument types are inferenced. Deal with + // the potential mismatches by adding casts to the arguments when the + // inferenced types do not match exactly. + for (const auto &op : llvm::zip(caller.getInputs(), funcType.getInputs())) { + auto cast = builder.convertWithSemantics(getLoc(), std::get<1>(op), + std::get<0>(op)); + operands.push_back(cast); + } + + auto call = builder.create(getLoc(), caller.getResultType(), + funcSymbolAttr, operands); + // Handle case where result was passed as argument + if (caller.getPassedResult()) + return resRef; + if (resultType.size() == 0) + return mlir::Value{}; // subroutine call + // For now, Fortran returned values are implemented with a single MLIR + // function return value. + assert(call.getNumResults() == 1 && + "Expected exactly one result in FUNCTION call"); + return call.getResult(0); + } + + template + fir::ExtendedValue + genval(const Fortran::evaluate::FunctionRef> + &funRef) { + llvm::SmallVector resTy; + resTy.push_back(converter.genType(TC, KIND)); + return genProcedureRef(funRef, resTy); + } + + fir::ExtendedValue genval(const Fortran::evaluate::ProcedureRef &procRef) { + llvm::SmallVector resTy; + if (procRef.hasAlternateReturns()) + resTy.push_back(builder.getIndexType()); + return genProcedureRef(procRef, resTy); + } + + template + fir::ExtendedValue gen(const Fortran::evaluate::Expr &exp) { + return std::visit([&](const auto &e) { return genref(e); }, exp.u); + } + template + fir::ExtendedValue genval(const Fortran::evaluate::Expr &exp) { + return std::visit([&](const auto &e) { return genval(e); }, exp.u); + } + + template + fir::ExtendedValue + genval(const Fortran::evaluate::Expr> &exp) { + return std::visit([&](const auto &e) { return genval(e); }, exp.u); + } + + using RefSet = + std::tuple; + template + static constexpr bool inRefSet = Fortran::common::HasMember; + + template + fir::ExtendedValue genref(const Fortran::evaluate::Designator &x) { + return gen(x); + } + template + fir::ExtendedValue genref(const Fortran::evaluate::FunctionRef &x) { + return gen(x); + } + template + fir::ExtendedValue genref(const Fortran::evaluate::Expr &x) { + return gen(x); + } + template + fir::ExtendedValue genref(const A &a) { + if constexpr (inRefSet>) { + return gen(a); + } else { + llvm_unreachable("expression error"); + } + } + + std::string + applyNameMangling(const Fortran::evaluate::ProcedureDesignator &proc) { + if (const auto *symbol = proc.GetSymbol()) + return converter.mangleName(*symbol); + // Do not mangle intrinsic for now + assert(proc.GetSpecificIntrinsic() && + "expected intrinsic procedure in designator"); + return proc.GetName(); + } +}; + +} // namespace + +mlir::Value Fortran::lower::createSomeExpression( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::evaluate::Expr &expr, + Fortran::lower::SymMap &symMap) { + Fortran::lower::ExpressionContext bogon; + return ExprLowering{loc, converter, symMap, bogon}.genValue(expr); +} + +fir::ExtendedValue Fortran::lower::createSomeExtendedExpression( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::evaluate::Expr &expr, + Fortran::lower::SymMap &symMap, + const Fortran::lower::ExpressionContext &context) { + return ExprLowering{loc, converter, symMap, context}.genExtValue(expr); +} + +mlir::Value Fortran::lower::createSomeAddress( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::evaluate::Expr &expr, + Fortran::lower::SymMap &symMap) { + Fortran::lower::ExpressionContext bogon; + return ExprLowering{loc, converter, symMap, bogon}.genAddr(expr); +} + +fir::ExtendedValue Fortran::lower::createSomeExtendedAddress( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::evaluate::Expr &expr, + Fortran::lower::SymMap &symMap, + const Fortran::lower::ExpressionContext &context) { + return ExprLowering{loc, converter, symMap, context}.genExtAddr(expr); +} + +fir::ExtendedValue Fortran::lower::createStringLiteral( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + llvm::StringRef str, uint64_t len) { + Fortran::lower::SymMap bogon1; + Fortran::lower::ExpressionContext bogon2; + return ExprLowering{loc, converter, bogon1, bogon2}.genStringLit(str, len); +} + +//===----------------------------------------------------------------------===// +// Support functions (implemented here for now) +//===----------------------------------------------------------------------===// mlir::Value fir::getBase(const fir::ExtendedValue &ex) { return std::visit(Fortran::common::visitors{ @@ -18,6 +1466,16 @@ mlir::Value fir::getBase(const fir::ExtendedValue &ex) { ex.box); } +fir::ExtendedValue fir::substBase(const fir::ExtendedValue &ex, + mlir::Value base) { + return std::visit( + Fortran::common::visitors{ + [&](const fir::UnboxedValue &x) { return fir::ExtendedValue(base); }, + [&](const auto &x) { return fir::ExtendedValue(x.clone(base)); }, + }, + ex.box); +} + llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os, const fir::CharBoxValue &box) { os << "boxchar { addr: " << box.getAddr() << ", len: " << box.getLen() @@ -93,3 +1551,19 @@ llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os, std::visit([&](const auto &value) { os << value; }, ex.box); return os; } + +void Fortran::lower::SymMap::dump() const { + auto &os = llvm::errs(); + for (auto iter : symbolMap) { + os << "symbol [" << *iter.first << "] ->\n\t"; + std::visit(Fortran::common::visitors{ + [&](const Fortran::lower::SymbolBox::None &box) { + os << "** symbol not properly mapped **\n"; + }, + [&](const Fortran::lower::SymbolBox::Intrinsic &val) { + os << val.getAddr() << '\n'; + }, + [&](const auto &box) { os << box << '\n'; }}, + iter.second.box); + } +} diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp new file mode 100644 index 0000000000000..fa7eed501f30c --- /dev/null +++ b/flang/lib/Lower/Intrinsics.cpp @@ -0,0 +1,739 @@ +//===-- Intrinsics.cpp ----------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Builder routines for constructing the FIR dialect of MLIR. As FIR is a +// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding +// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this +// module. +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/Intrinsics.h" +#include "flang/Lower/ConvertType.h" +#include "flang/Lower/FIRBuilder.h" +#include "flang/Lower/Runtime.h" +#include "llvm/Support/ErrorHandling.h" +#include +#include // FIXME: must be removed +#include + +namespace Fortran::lower { + +/// MathRuntimeLibrary maps Fortran generic intrinsic names to runtime function +/// signatures. There is no guarantee that that runtime functions are available +/// for all intrinsic functions and possible types. +/// To be easy and fast to use, this class holds a map and uses +/// mlir::FunctionType to represent the runtime function type. This imply that +/// MathRuntimeLibrary cannot be constexpr built and requires an +/// mlir::MLIRContext to be built. Its constructor uses a constexpr table +/// description of the runtime. The runtime functions are not declared into the +/// mlir::module until there is a query that needs them. This is to avoid +/// polluting the FIR/LLVM IR dumps with unused functions. +class MathRuntimeLibrary { +public: + /// The map key are Fortran generic intrinsic names. + using Key = llvm::StringRef; + struct Hash { // Need custom hash for this kind of key + size_t operator()(const Key &k) const { return llvm::hash_value(k); } + }; + /// Runtime function description that is sufficient to build an + /// mlir::FuncOp and to compare function types. + struct RuntimeFunction { + RuntimeFunction(llvm::StringRef n, mlir::FunctionType t) + : symbol{n}, type{t} {} + llvm::StringRef symbol; + mlir::FunctionType type; + }; + using Map = std::unordered_multimap; + + MathRuntimeLibrary(IntrinsicLibrary::Version, mlir::MLIRContext &); + + /// Probe the intrinsic library for a certain intrinsic and get/build the + /// related mlir::FuncOp if a runtime description is found. + /// Also add a unit attribute "fir.runtime" to the function so that later + /// it is possible to quickly know what function are intrinsics vs users. + llvm::Optional getFunction(Fortran::lower::FirOpBuilder &, + llvm::StringRef, + mlir::FunctionType) const; + +private: + mlir::FuncOp getFuncOp(Fortran::lower::FirOpBuilder &builder, + const RuntimeFunction &runtime) const; + Map library; +}; + +/// Enums used to templatize and share lowering of MIN and MAX. +enum class Extremum { Min, Max }; + +// There are different ways to deal with NaNs in MIN and MAX. +// Known existing behaviors are listed below and can be selected for +// f18 MIN/MAX implementation. +enum class ExtremumBehavior { + // Note: the Signaling/quiet aspect of NaNs in the behaviors below are + // not described because there is no way to control/observe such aspect in + // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this + // aspect that are therefore currently not enforced. In the descriptions + // below, NaNs can be signaling or quite. Returned NaNs may be signaling + // if one of the input NaN was signaling but it cannot be guaranteed either. + // Existing compilers using an IEEE behavior (gfortran) also do not fulfill + // signaling/quiet requirements. + IeeeMinMaximumNumber, + // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6): + // If one of the argument is and number and the other is NaN, return the + // number. If both arguements are NaN, return NaN. + // Compilers: gfortran. + IeeeMinMaximum, + // IEEE minimum/maximum behavior (754-2019, section 9.6): + // If one of the argument is NaN, return NaN. + MinMaxss, + // x86 minss/maxss behavior: + // If the second argument is a number and the other is NaN, return the number. + // In all other cases where at least one operand is NaN, return NaN. + // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor. + PgfortranLlvm, + // "Opposite of" x86 minss/maxss behavior: + // If the first argument is a number and the other is NaN, return the + // number. + // In all other cases where at least one operand is NaN, return NaN. + // Compilers: xlf (only for MIN), and pgfortran (with llvm). + IeeeMinMaxNum + // IEEE minNum/maxNum behavior (754-2008, section 5.3.1): + // TODO: Not implemented. + // It is the only behavior where the signaling/quiet aspect of a NaN argument + // impacts if the result should be NaN or the argument that is a number. + // LLVM/MLIR do not provide ways to observe this aspect, so it is not + // possible to implement it without some target dependent runtime. +}; + +/// The implementation of IntrinsicLibrary is based on a map that associates +/// Fortran intrinsics generic names to the related FIR generator functions. +/// All generator functions are member functions of the Implementation class +/// and they all take the same context argument that contains the name and +/// arguments of the Fortran intrinsics call to lower among other things. +/// A same FIR generator function may be able to generate the FIR for several +/// intrinsics. For instance genRuntimeCall tries to find a runtime +/// functions that matches the Fortran intrinsic call and generate the +/// operations to call this functions if it was found. +/// IntrinsicLibrary holds a constant MathRuntimeLibrary that it uses to +/// find and place call to math runtime functions. This library is built +/// when the Implementation is built. Because of this, Implementation is +/// not cheap to build and it should be kept as long as possible. + +// TODO it is unclear how optional argument are handled +// TODO error handling -> return a code or directly emit messages ? +class IntrinsicLibrary::Implementation { +public: + Implementation(Version v, mlir::MLIRContext &c) : runtime{v, c} {} + inline mlir::Value genval(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder, + llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef args); + +private: + // Info needed by Generators is passed in Context struct to keep Generator + // signatures modification easy. + struct Context { + mlir::Location loc; + Fortran::lower::FirOpBuilder *builder = nullptr; + llvm::StringRef name; + llvm::ArrayRef arguments; + mlir::FunctionType funcType; + mlir::ModuleOp getModuleOp() { return builder->getModule(); } + mlir::MLIRContext *getMLIRContext() { return getModuleOp().getContext(); } + mlir::Type getResultType() { + assert(funcType.getNumResults() == 1); + return funcType.getResult(0); + } + }; + + /// Define the different FIR generators that can be mapped to intrinsic to + /// generate the related code. + using Generator = mlir::Value (*)(Context &, MathRuntimeLibrary &); + + /// Search a runtime function that is associated to the generic intrinsic name + /// and whose signature matches the intrinsic arguments and result types. + /// If no such runtime function is found but a runtime function associated + /// with the Fortran generic exists and has the same number of arguments, + /// conversions will be inserted before and/or after the call. This is to + /// mainly to allow 16 bits float support even-though little or no math + /// runtime is currently available for it. + static mlir::Value genRuntimeCall(Context &, MathRuntimeLibrary &); + + /// All generators can be combined with genWrapperCall that will build a + /// function named "fir."+ + "." + and + /// generate the intrinsic implementation inside instead of at the intrinsic + /// call sites. This can be used to keep the FIR more readable. + template + static mlir::Value genWrapperCall(Context &c, MathRuntimeLibrary &r) { + return outlineInWrapper(g, c, r); + } + + /// The defaultGenerator is always attempted if no mapping was found for the + /// generic name provided. + static mlir::Value defaultGenerator(Context &c, MathRuntimeLibrary &r) { + return genWrapperCall<&I::genRuntimeCall>(c, r); + } + + static mlir::Value genConjg(Context &, MathRuntimeLibrary &); + template + static mlir::Value genExtremum(Context &, MathRuntimeLibrary &); + static mlir::Value genMerge(Context &, MathRuntimeLibrary &); + + struct IntrinsicHanlder { + const char *name; + Generator generator{&I::defaultGenerator}; + }; + using I = Implementation; + /// Table that drives the fir generation depending on the intrinsic. + /// one to one mapping with Fortran arguments. If no mapping is + /// defined here for a generic intrinsic, the defaultGenerator will + /// be attempted. + static constexpr IntrinsicHanlder handlers[]{ + {"conjg", &I::genConjg}, + {"max", &I::genExtremum}, + {"min", &I::genExtremum}, + {"merge", &I::genMerge}, + }; + + // helpers + static mlir::Value outlineInWrapper(Generator, Context &c, + MathRuntimeLibrary &r); + + MathRuntimeLibrary runtime; +}; + +// helpers +static std::string getIntrinsicWrapperName(const llvm::StringRef &intrinsic, + mlir::FunctionType funTy); +static mlir::FunctionType getFunctionType(mlir::Type resultType, + llvm::ArrayRef arguments, + Fortran::lower::FirOpBuilder &); + +/// Define a simple static runtime description that will be transformed into +/// RuntimeFunction when building the IntrinsicLibrary. +class MathsRuntimeStaticDescription : public RuntimeStaticDescription { +public: + constexpr MathsRuntimeStaticDescription(const char *n, const char *s, + MaybeTypeCode r, TypeCodeVector a) + : RuntimeStaticDescription{s, r, a}, name{n} {} + llvm::StringRef getName() const { return name; } + +private: + // Generic math function name + const char *name = nullptr; +}; + +/// Description of the runtime functions available on the target. +using RType = typename RuntimeStaticDescription::TypeCode; +using Args = typename RuntimeStaticDescription::TypeCodeVector; +static constexpr MathsRuntimeStaticDescription llvmRuntime[] = { + {"abs", "llvm.fabs.f32", RType::f32, Args::create()}, + {"abs", "llvm.fabs.f64", RType::f64, Args::create()}, + {"acos", "acosf", RType::f32, Args::create()}, + {"acos", "acos", RType::f64, Args::create()}, + {"atan", "atan2f", RType::f32, Args::create()}, + {"atan", "atan2", RType::f64, Args::create()}, + {"sqrt", "llvm.sqrt.f32", RType::f32, Args::create()}, + {"sqrt", "llvm.sqrt.f64", RType::f64, Args::create()}, + {"cos", "llvm.cos.f32", RType::f32, Args::create()}, + {"cos", "llvm.cos.f64", RType::f64, Args::create()}, + {"sin", "llvm.sin.f32", RType::f32, Args::create()}, + {"sin", "llvm.sin.f64", RType::f64, Args::create()}, +}; + +static constexpr MathsRuntimeStaticDescription pgmathPreciseRuntime[] = { + {"acos", "__pc_acos_1", RType::c32, Args::create()}, + {"acos", "__pz_acos_1", RType::c64, Args::create()}, + {"pow", "__pc_pow_1", RType::c32, Args::create()}, + {"pow", "__pc_powi_1", RType::c32, Args::create()}, + {"pow", "__pc_powk_1", RType::c32, Args::create()}, + {"pow", "__pd_pow_1", RType::f64, Args::create()}, + {"pow", "__pd_powi_1", RType::f64, Args::create()}, + {"pow", "__pd_powk_1", RType::f64, Args::create()}, + {"pow", "__ps_pow_1", RType::f32, Args::create()}, + {"pow", "__ps_powi_1", RType::f32, Args::create()}, + {"pow", "__ps_powk_1", RType::f32, Args::create()}, + {"pow", "__pz_pow_1", RType::c64, Args::create()}, + {"pow", "__pz_powi_1", RType::c64, Args::create()}, + {"pow", "__pz_powk_1", RType::c64, Args::create()}, + {"pow", "__mth_i_ipowi", RType::i32, + Args::create()}, + {"pow", "__mth_i_kpowi", RType::i64, + Args::create()}, + {"pow", "__mth_i_kpowk", RType::i64, + Args::create()}, +}; + +// TODO : Tables above should be generated in a clever ways and probably shared +// with lib/evaluate intrinsic folding. + +// Implementations + +// IntrinsicLibrary implementation + +IntrinsicLibrary::IntrinsicLibrary(IntrinsicLibrary::Version v, + mlir::MLIRContext &context) + : impl{new Implementation(v, context)} {} +IntrinsicLibrary::~IntrinsicLibrary() = default; + +mlir::Value IntrinsicLibrary::genval(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder, + llvm::StringRef name, + mlir::Type resultType, + llvm::ArrayRef args) const { + assert(impl); + return impl->genval(loc, builder, name, resultType, args); +} + +// MathRuntimeLibrary implementation + +// Create the runtime description for the targeted library version. +// So far ignore the version an only load the dummy llvm lib and pgmath precise +MathRuntimeLibrary::MathRuntimeLibrary(IntrinsicLibrary::Version, + mlir::MLIRContext &mlirContext) { + for (const MathsRuntimeStaticDescription &func : llvmRuntime) { + RuntimeFunction impl{func.getSymbol(), + func.getMLIRFunctionType(&mlirContext)}; + library.insert({Key{func.getName()}, impl}); + } + for (const MathsRuntimeStaticDescription &func : pgmathPreciseRuntime) { + RuntimeFunction impl{func.getSymbol(), + func.getMLIRFunctionType(&mlirContext)}; + library.insert({Key{func.getName()}, impl}); + } +} + +mlir::FuncOp +MathRuntimeLibrary::getFuncOp(Fortran::lower::FirOpBuilder &builder, + const RuntimeFunction &runtime) const { + auto function = builder.addNamedFunction(runtime.symbol, runtime.type); + function.setAttr("fir.runtime", builder.getUnitAttr()); + return function; +} + +// This helper class computes a "distance" between two function types. +// The distance measures how many narrowing conversions of actual arguments +// and result of "from" must be made in order to use "to" instead of "from". +// For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is +// greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means +// if no implementation of ACOS(REAL(10)) is available, it is better to use +// ACOS(REAL(16)) with casts rather than ACOS(REAL(8)). +// Note that this is not a symmetric distance and the order of "from" and "to" +// arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it +// may be safe to replace foo by bar, but not the opposite. +class FunctionDistance { +public: + FunctionDistance() : infinite{true} {} + FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) { + auto nInputs = from.getNumInputs(); + auto nResults = from.getNumResults(); + if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) { + infinite = true; + } else { + for (decltype(nInputs) i{0}; i < nInputs; ++i) + addArgumentDistance(from.getInput(i), to.getInput(i)); + for (decltype(nResults) i{0}; i < nResults; ++i) + addResultDistance(to.getResult(i), from.getResult(i)); + } + } + bool isSmallerThan(const FunctionDistance &d) const { + return d.infinite || + (!infinite && std::lexicographical_compare( + conversions.begin(), conversions.end(), + d.conversions.begin(), d.conversions.end())); + } + bool isLoosingPrecision() const { + return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0; + } + bool isInfinite() const { return infinite; } + +private: + enum class Conversion { Forbidden, None, Narrow, Extend }; + + void addArgumentDistance(mlir::Type from, mlir::Type to) { + switch (conversionBetweenTypes(from, to)) { + case Conversion::Forbidden: + infinite = true; + break; + case Conversion::None: + break; + case Conversion::Narrow: + conversions[narrowingArg]++; + break; + case Conversion::Extend: + conversions[nonNarrowingArg]++; + break; + } + } + void addResultDistance(mlir::Type from, mlir::Type to) { + switch (conversionBetweenTypes(from, to)) { + case Conversion::Forbidden: + infinite = true; + break; + case Conversion::None: + break; + case Conversion::Narrow: + conversions[nonExtendingResult]++; + break; + case Conversion::Extend: + conversions[extendingResult]++; + break; + } + } + // Floating point can be mlir::FloatType or fir::real + static unsigned getFloatingPointWidth(mlir::Type t) { + if (auto f{t.dyn_cast()}) + return f.getWidth(); + // FIXME: Get width another way for fir.real/complex + // - use fir/KindMapping.h and llvm::Type + // - or use evaluate/type.h + if (auto r{t.dyn_cast()}) + return r.getFKind() * 4; + if (auto cplx{t.dyn_cast()}) + return cplx.getFKind() * 4; + assert(false && "not a floating-point type"); + return 0; + } + static bool isFloatingPointType(mlir::Type t) { + return t.isa() || t.isa(); + } + static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) { + if (from == to) { + return Conversion::None; + } + if (auto fromIntTy{from.dyn_cast()}) { + if (auto toIntTy{to.dyn_cast()}) { + return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow + : Conversion::Extend; + } + } + if (isFloatingPointType(from) && isFloatingPointType(to)) { + return getFloatingPointWidth(from) > getFloatingPointWidth(to) + ? Conversion::Narrow + : Conversion::Extend; + } + if (auto fromCplxTy{from.dyn_cast()}) { + if (auto toCplxTy{to.dyn_cast()}) { + return getFloatingPointWidth(fromCplxTy) > + getFloatingPointWidth(toCplxTy) + ? Conversion::Narrow + : Conversion::Extend; + } + } + // Notes: + // - No conversion between character types, specialization of runtime + // functions should be made instead. + // - It is not clear there is a use case for automatic conversions + // around Logical and it may damage hidden information in the physical + // storage so do not do it. + return Conversion::Forbidden; + } + + // Below are indexes to access data in conversions. + // The order in data does matter for lexicographical_compare + enum { + narrowingArg = 0, // usually bad + extendingResult, // usually bad + nonExtendingResult, // usually ok + nonNarrowingArg, // usually ok + dataSize + }; + std::array conversions{/* zero init*/}; + bool infinite{false}; // When forbidden conversion or wrong argument number +}; + +// Select runtime function that has the smallest distance to the intrinsic +// function type and that will not imply narrowing arguments or extending the +// result. +llvm::Optional +MathRuntimeLibrary::getFunction(Fortran::lower::FirOpBuilder &builder, + llvm::StringRef name, + mlir::FunctionType funcType) const { + auto range = library.equal_range(name); + const RuntimeFunction *bestNearMatch = nullptr; + FunctionDistance bestMatchDistance{}; + for (auto iter{range.first}; iter != range.second; ++iter) { + const RuntimeFunction &impl = iter->second; + if (funcType == impl.type) { + return getFuncOp(builder, impl); // exact match + } else { + FunctionDistance distance(funcType, impl.type); + if (distance.isSmallerThan(bestMatchDistance)) { + bestNearMatch = &impl; + bestMatchDistance = std::move(distance); + } + } + } + if (bestNearMatch != nullptr) { + assert(!bestMatchDistance.isLoosingPrecision() && + "runtime selection looses precision"); + return getFuncOp(builder, *bestNearMatch); + } + return {}; +} + +// IntrinsicLibrary::Implementation implementation + +mlir::Value IntrinsicLibrary::Implementation::genval( + mlir::Location loc, Fortran::lower::FirOpBuilder &builder, + llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef args) { + Context context{loc, &builder, name, args, + getFunctionType(resultType, args, builder)}; + for (auto &handler : handlers) { + if (name == handler.name) { + assert(handler.generator != nullptr); + return handler.generator(context, runtime); + } + } + // Try the default generator if no special handler was defined for the + // intrinsic being called. + return defaultGenerator(context, runtime); +} + +static mlir::FunctionType +getFunctionType(mlir::Type resultType, llvm::ArrayRef arguments, + Fortran::lower::FirOpBuilder &builder) { + llvm::SmallVector argumentTypes; + for (auto &arg : arguments) { + assert(arg != nullptr); // TODO think about optionals + argumentTypes.push_back(arg.getType()); + } + return mlir::FunctionType::get(argumentTypes, resultType, + builder.getModule().getContext()); +} + +// TODO find nicer type to string infra or move this in a mangling utility +// mlir as Type::dump(ostream) methods but it may adds ! +static std::string typeToString(mlir::Type t) { + if (auto i{t.dyn_cast()}) { + return "i" + std::to_string(i.getWidth()); + } + if (auto cplx{t.dyn_cast()}) { + return "z" + std::to_string(cplx.getFKind()); + } + if (auto real{t.dyn_cast()}) { + return "r" + std::to_string(real.getFKind()); + } + if (auto f{t.dyn_cast()}) { + return "f" + std::to_string(f.getWidth()); + } + if (auto logical{t.dyn_cast()}) { + return "l" + std::to_string(logical.getFKind()); + } + if (auto character{t.dyn_cast()}) { + return "c" + std::to_string(character.getFKind()); + } + assert(false && "no mangling for type"); + return ""s; +} + +static std::string getIntrinsicWrapperName(const llvm::StringRef &intrinsic, + mlir::FunctionType funTy) { + std::string name{"fir." + intrinsic.str() + "."}; + assert(funTy.getNumResults() == 1 && "only function mangling supported"); + name += typeToString(funTy.getResult(0)); + auto e = funTy.getNumInputs(); + for (decltype(e) i = 0; i < e; ++i) { + name += "." + typeToString(funTy.getInput(i)); + } + return name; +} + +mlir::Value IntrinsicLibrary::Implementation::outlineInWrapper( + Generator generator, Context &context, MathRuntimeLibrary &runtime) { + auto *builder = context.builder; + auto module = builder->getModule(); + auto *mlirContext = module.getContext(); + std::string wrapperName = + getIntrinsicWrapperName(context.name, context.funcType); + auto function = builder->getNamedFunction(wrapperName); + if (!function) { + // First time this wrapper is needed, build it. + function = builder->createFunction(wrapperName, context.funcType); + function.setAttr("fir.intrinsic", builder->getUnitAttr()); + function.addEntryBlock(); + + // Create local context to emit code into the newly created function + // This new function is not linked to a source file location, only + // its calls will be. + Context localContext = context; + auto localBuilder = + std::make_unique(function); + localBuilder->setInsertionPointToStart(&function.front()); + localContext.builder = &(*localBuilder); + llvm::SmallVector localArguments; + for (mlir::BlockArgument bArg : function.front().getArguments()) + localArguments.push_back(bArg); + localContext.arguments = localArguments; + localContext.loc = mlir::UnknownLoc::get(mlirContext); + + mlir::Value result = generator(localContext, runtime); + localBuilder->create(localContext.loc, result); + } else { + // Wrapper was already built, ensure it has the sought type + assert(function.getType() == context.funcType); + } + auto call = + builder->create(context.loc, function, context.arguments); + return call.getResult(0); +} + +mlir::Value +IntrinsicLibrary::Implementation::genRuntimeCall(Context &context, + MathRuntimeLibrary &runtime) { + // Look up runtime + mlir::FunctionType soughtFuncType = context.funcType; + if (auto funcOp = + runtime.getFunction(*context.builder, context.name, soughtFuncType)) { + mlir::FunctionType actualFuncType = funcOp->getType(); + if (actualFuncType.getNumResults() != soughtFuncType.getNumResults() || + actualFuncType.getNumInputs() != soughtFuncType.getNumInputs() || + actualFuncType.getNumInputs() != context.arguments.size() || + actualFuncType.getNumResults() != 1) { + assert(false); // TODO better error handling + return nullptr; + } + llvm::SmallVector convertedArguments; + int i = 0; + for (mlir::Value arg : context.arguments) { + auto actualType = actualFuncType.getInput(i); + if (soughtFuncType.getInput(i) != actualType) { + auto castedArg = context.builder->create( + context.loc, actualType, arg); + convertedArguments.push_back(castedArg.getResult()); + } else { + convertedArguments.push_back(arg); + } + ++i; + } + auto call = context.builder->create(context.loc, *funcOp, + convertedArguments); + mlir::Type soughtType = soughtFuncType.getResult(0); + mlir::Value res = call.getResult(0); + if (actualFuncType.getResult(0) != soughtType) { + auto castedRes = + context.builder->create(context.loc, soughtType, res); + return castedRes.getResult(); + } else { + return res; + } + } else { + // could not find runtime function + assert(false && "no runtime found for this intrinsics"); + // TODO: better error handling ? + // - Try to have compile time check of runtime compltness ? + } + return {}; // gets rid of warnings +} + +// CONJG +mlir::Value IntrinsicLibrary::Implementation::genConjg(Context &genCtxt, + MathRuntimeLibrary &) { + assert(genCtxt.arguments.size() == 1); + mlir::Type resType = genCtxt.getResultType(); + if (resType != genCtxt.arguments[0].getType()) + llvm_unreachable("argument type mismatch"); + Fortran::lower::FirOpBuilder &builder = *genCtxt.builder; + builder.setLocation(genCtxt.loc); + + mlir::Value cplx = genCtxt.arguments[0]; + auto imag = builder.extractComplexPart(cplx, /*isImagPart=*/true); + auto negImag = builder.create(genCtxt.loc, imag); + return builder.insertComplexPart(cplx, negImag, /*isImagPart=*/true); +} + +// MERGE +mlir::Value IntrinsicLibrary::Implementation::genMerge(Context &genCtxt, + MathRuntimeLibrary &) { + assert(genCtxt.arguments.size() == 3); + [[maybe_unused]] auto resType = genCtxt.getResultType(); + Fortran::lower::FirOpBuilder &builder = *genCtxt.builder; + + auto &trueVal = genCtxt.arguments[0]; + auto &falseVal = genCtxt.arguments[1]; + auto &mask = genCtxt.arguments[2]; + auto i1Type = mlir::IntegerType::get(1, builder.getContext()); + auto msk = builder.create(genCtxt.loc, i1Type, mask); + return builder.create(genCtxt.loc, msk, trueVal, falseVal); +} + +// Compare two FIR values and return boolean result as i1. +template +static mlir::Value createExtremumCompare(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder, + mlir::Value left, mlir::Value right) { + static constexpr auto integerPredicate = extremum == Extremum::Max + ? mlir::CmpIPredicate::sgt + : mlir::CmpIPredicate::slt; + static constexpr auto orderedCmp = extremum == Extremum::Max + ? mlir::CmpFPredicate::OGT + : mlir::CmpFPredicate::OLT; + auto type = left.getType(); + mlir::Value result; + if (type.isa() || type.isa()) { + // Note: the signaling/quit aspect of the result required by IEEE + // cannot currently be obtained with LLVM without ad-hoc runtime. + if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) { + // Return the number if one of the inputs is NaN and the other is + // a number. + auto leftIsResult = + builder.create(loc, orderedCmp, left, right); + auto rightIsNan = builder.create( + loc, mlir::CmpFPredicate::UNE, right, right); + result = builder.create(loc, leftIsResult, rightIsNan); + } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) { + // Always return NaNs if one the input is NaNs + auto leftIsResult = + builder.create(loc, orderedCmp, left, right); + auto leftIsNan = builder.create( + loc, mlir::CmpFPredicate::UNE, left, left); + result = builder.create(loc, leftIsResult, leftIsNan); + } else if constexpr (behavior == ExtremumBehavior::MinMaxss) { + // If the left is a NaN, return the right whatever it is. + result = builder.create(loc, orderedCmp, left, right); + } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) { + // If one of the operand is a NaN, return left whatever it is. + static constexpr auto unorderedCmp = extremum == Extremum::Max + ? mlir::CmpFPredicate::UGT + : mlir::CmpFPredicate::ULT; + result = builder.create(loc, unorderedCmp, left, right); + } else { + // TODO: ieeMinNum/ieeeMaxNum + static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum, + "ieeeMinNum/ieeMaxNum behavior not implemented"); + } + } else if (type.isa()) { + result = builder.create(loc, integerPredicate, left, right); + } else if (type.isa()) { + // TODO: ! character min and max is tricky because the result + // length is the length of the longest argument! + // So we may need a temp. + } + assert(result); + return result; +} + +// MIN and MAX +template +mlir::Value +IntrinsicLibrary::Implementation::genExtremum(Context &genCtxt, + MathRuntimeLibrary &) { + auto &builder = *genCtxt.builder; + auto loc = genCtxt.loc; + assert(genCtxt.arguments.size() >= 2); + mlir::Value result = genCtxt.arguments[0]; + for (auto arg : genCtxt.arguments.drop_front()) { + auto mask = + createExtremumCompare(loc, builder, result, arg); + result = builder.create(loc, mask, result, arg); + } + return result; +} + +} // namespace Fortran::lower diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp new file mode 100644 index 0000000000000..c407106ca1cb8 --- /dev/null +++ b/flang/lib/Lower/Runtime.cpp @@ -0,0 +1,108 @@ +//===-- Runtime.cpp -------------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/Runtime.h" +#include "flang/Lower/FIRBuilder.h" +#include "mlir/IR/StandardTypes.h" +#include "mlir/IR/Types.h" +#include "llvm/ADT/SmallVector.h" +#include "llvm/Support/ErrorHandling.h" + +namespace Fortran::lower { + +mlir::Type RuntimeStaticDescription::getMLIRType(TypeCode t, + mlir::MLIRContext *context) { + switch (t) { + case TypeCode::i32: + return mlir::IntegerType::get(32, context); + case TypeCode::i64: + return mlir::IntegerType::get(64, context); + case TypeCode::f32: + return mlir::FloatType::getF32(context); + case TypeCode::f64: + return mlir::FloatType::getF64(context); + // TODO need to access mapping between fe/target + case TypeCode::c32: + return fir::CplxType::get(context, 4); + case TypeCode::c64: + return fir::CplxType::get(context, 8); + case TypeCode::boolean: + return mlir::IntegerType::get(8, context); + case TypeCode::charPtr: + return fir::ReferenceType::get(fir::CharacterType::get(context, 1)); + // ! IOCookie is experimental only so far + case TypeCode::IOCookie: + return fir::ReferenceType::get(mlir::IntegerType::get(64, context)); + } + llvm_unreachable("bug"); + return {}; +} + +mlir::FunctionType RuntimeStaticDescription::getMLIRFunctionType( + mlir::MLIRContext *context) const { + llvm::SmallVector argMLIRTypes; + for (const TypeCode &t : argumentTypeCodes) { + argMLIRTypes.push_back(getMLIRType(t, context)); + } + if (resultTypeCode.has_value()) { + mlir::Type resMLIRType{getMLIRType(*resultTypeCode, context)}; + return mlir::FunctionType::get(argMLIRTypes, resMLIRType, context); + } + return mlir::FunctionType::get(argMLIRTypes, {}, context); +} + +mlir::FuncOp RuntimeStaticDescription::getFuncOp( + Fortran::lower::FirOpBuilder &builder) const { + auto module = builder.getModule(); + auto funTy = getMLIRFunctionType(module.getContext()); + auto function = builder.addNamedFunction(symbol, funTy); + function.setAttr("fir.runtime", builder.getUnitAttr()); + if (funTy != function.getType()) + llvm_unreachable("runtime function type mismatch"); + return function; +} + +class RuntimeEntryDescription : public RuntimeStaticDescription { +public: + using Key = RuntimeEntryCode; + constexpr RuntimeEntryDescription(Key k, const char *s, MaybeTypeCode r, + TypeCodeVector a) + : RuntimeStaticDescription{s, r, a}, key{k} {} + Key key; +}; + +static constexpr RuntimeEntryDescription runtimeTable[]{ + {RuntimeEntryCode::StopStatement, "StopStatement", + RuntimeStaticDescription::voidTy, + RuntimeStaticDescription::TypeCodeVector::create< + RuntimeStaticDescription::TypeCode::i32, + RuntimeStaticDescription::TypeCode::boolean, + RuntimeStaticDescription::TypeCode::boolean>()}, + {RuntimeEntryCode::StopStatementText, "StopStatementText", + RuntimeStaticDescription::voidTy, + RuntimeStaticDescription::TypeCodeVector::create< + RuntimeStaticDescription::TypeCode::charPtr, + RuntimeStaticDescription::TypeCode::i32, + RuntimeStaticDescription::TypeCode::boolean, + RuntimeStaticDescription::TypeCode::boolean>()}, + {RuntimeEntryCode::FailImageStatement, "StopStatementText", + RuntimeStaticDescription::voidTy, + RuntimeStaticDescription::TypeCodeVector::create<>()}, +}; + +static constexpr StaticMultimapView runtimeMap{ + runtimeTable}; + +mlir::FuncOp genRuntimeFunction(RuntimeEntryCode code, + Fortran::lower::FirOpBuilder &builder) { + auto description = runtimeMap.find(code); + assert(description != runtimeMap.end()); + return description->getFuncOp(builder); +} + +} // namespace Fortran::lower diff --git a/flang/lib/Optimizer/CMakeLists.txt b/flang/lib/Optimizer/CMakeLists.txt index b83d6a079db63..408dceb7d8dff 100644 --- a/flang/lib/Optimizer/CMakeLists.txt +++ b/flang/lib/Optimizer/CMakeLists.txt @@ -10,10 +10,17 @@ add_flang_library(FIROptimizer Support/InternalNames.cpp Support/KindMapping.cpp - CodeGen/CGOps.cpp + Analysis/IteratedDominanceFrontier.cpp + + CodeGen/CodeGen.cpp CodeGen/PreCGRewrite.cpp + Transforms/ControlFlowConverter.cpp + Transforms/CSE.cpp Transforms/Inliner.cpp + Transforms/MemToReg.cpp + Transforms/AffinePromotion.cpp + Transforms/RewriteLoop.cpp DEPENDS FIROpsIncGen diff --git a/flang/lib/Optimizer/CodeGen.cpp b/flang/lib/Optimizer/CodeGen.cpp new file mode 100644 index 0000000000000..445117090fd5f --- /dev/null +++ b/flang/lib/Optimizer/CodeGen.cpp @@ -0,0 +1,2404 @@ +//===-- CodeGen.cpp -- bridge to lower to LLVM ----------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/CodeGen/CodeGen.h" +#include "flang/Optimizer/Dialect/FIRAttr.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Optimizer/Support/KindMapping.h" +#include "mlir/Conversion/StandardToLLVM/ConvertStandardToLLVM.h" +#include "mlir/Conversion/StandardToLLVM/ConvertStandardToLLVMPass.h" +#include "mlir/Dialect/Affine/IR/AffineOps.h" +#include "mlir/Dialect/LLVMIR/LLVMDialect.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/IR/StandardTypes.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Target/LLVMIR.h" +#include "mlir/Transforms/DialectConversion.h" +#include "llvm/ADT/ArrayRef.h" +#include "llvm/Config/abi-breaking.h" +#include "llvm/IR/IRBuilder.h" +#include "llvm/IR/Module.h" +#include "llvm/IR/Type.h" +#include "llvm/Support/CommandLine.h" +#include "llvm/Support/FileSystem.h" +#include "llvm/Support/raw_ostream.h" + +/// The Tilikum bridge performs the conversion of operations from both the FIR +/// and standard dialects to the LLVM-IR dialect. +/// +/// Some FIR operations may be lowered to other dialects, such as standard, but +/// some FIR operations will pass through to the Tilikum bridge. This may be +/// necessary to preserve the semantics of the Fortran program. + +#undef TODO +#define TODO() llvm_unreachable("not yet implemented") + +using namespace llvm; + +using OperandTy = ArrayRef; + +static cl::opt + disableFirToLLVMIR("disable-fir2llvmir", + cl::desc("disable FIR to LLVM-IR dialect pass"), + cl::init(false), cl::Hidden); + +static cl::opt disableLLVM("disable-llvm", cl::desc("disable LLVM pass"), + cl::init(false), cl::Hidden); + +namespace fir { +/// return true if all `Value`s in `operands` are `ConstantOp`s +bool allConstants(OperandTy operands) { + for (auto opnd : operands) { + if (auto defop = opnd.getDefiningOp()) + if (isa(defop) || isa(defop)) + continue; + return false; + } + return true; +} +} // namespace fir + +using SmallVecResult = SmallVector; +using AttributeTy = ArrayRef; + +static constexpr unsigned defaultAlign = 8; + +namespace { + +/// FIR type converter +/// This converts FIR types to LLVM types (for now) +class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { +public: + FIRToLLVMTypeConverter(mlir::MLIRContext *context, fir::NameUniquer &uniquer) + : LLVMTypeConverter(context), kindMapping(context), uniquer(uniquer) { + addConversion([&](fir::BoxType box) { return convertBoxType(box); }); + addConversion( + [&](fir::BoxCharType boxchar) { return convertBoxCharType(boxchar); }); + addConversion( + [&](fir::BoxProcType boxproc) { return convertBoxProcType(boxproc); }); + addConversion( + [&](fir::CharacterType charTy) { return convertCharType(charTy); }); + addConversion([&](fir::CplxType cplx) { + return convertComplexType(cplx.getFKind()); + }); + addConversion( + [&](fir::RecordType derived) { return convertRecordType(derived); }); + addConversion([&](fir::DimsType dims) { + return mlir::LLVM::LLVMType::getArrayTy(dimsType(), dims.getRank()); + }); + addConversion([&](fir::FieldType field) { + return mlir::LLVM::LLVMType::getInt32Ty(llvmDialect); + }); + addConversion([&](fir::HeapType heap) { return convertPointerLike(heap); }); + addConversion([&](fir::IntType intr) { return convertIntegerType(intr); }); + addConversion([&](fir::LenType field) { + return mlir::LLVM::LLVMType::getInt32Ty(llvmDialect); + }); + addConversion( + [&](fir::LogicalType logical) { return convertLogicalType(logical); }); + addConversion( + [&](fir::PointerType pointer) { return convertPointerLike(pointer); }); + addConversion( + [&](fir::RealType real) { return convertRealType(real.getFKind()); }); + addConversion( + [&](fir::ReferenceType ref) { return convertPointerLike(ref); }); + addConversion([&](fir::SequenceType sequence) { + return convertSequenceType(sequence); + }); + addConversion([&](fir::TypeDescType tdesc) { + return convertTypeDescType(tdesc.getContext()); + }); + addConversion( + [&](mlir::TupleType tuple) { return convertTupleType(tuple); }); + addConversion( + [&](mlir::ComplexType cmplx) { return convertComplexType(cmplx); }); + addConversion([&](mlir::NoneType none) { + return mlir::LLVM::LLVMType::getStructTy(llvmDialect, {}); + }); + } + + // This returns the type of a single column. Rows are added by the caller. + // fir.dims --> llvm<"[r x [3 x i64]]"> + mlir::LLVM::LLVMType dimsType() { + auto i64Ty{mlir::LLVM::LLVMType::getInt64Ty(llvmDialect)}; + return mlir::LLVM::LLVMType::getArrayTy(i64Ty, 3); + } + + // i32 is used here because LLVM wants i32 constants when indexing into struct + // types. Indexing into other aggregate types is more flexible. + mlir::LLVM::LLVMType offsetType() { + return mlir::LLVM::LLVMType::getInt32Ty(llvmDialect); + } + + // i64 can be used to index into aggregates like arrays + mlir::LLVM::LLVMType indexType() { + return mlir::LLVM::LLVMType::getInt64Ty(llvmDialect); + } + + // This corresponds to the descriptor as defined ISO_Fortran_binding.h and the + // addendum defined in descriptor.h. + // FIXME: This code should be generated and follow SPOT + mlir::LLVM::LLVMType convertBoxType(fir::BoxType box) { + // (buffer*, ele-size, rank, type-descriptor, attribute, [dims]) + SmallVector parts; + mlir::Type ele = box.getEleTy(); + // auto *ctx = box.getContext(); + auto eleTy = unwrap(convertType(ele)); + // buffer* + if (ele.isa() && eleTy.isPointerTy()) + parts.push_back(eleTy); + else + parts.push_back(eleTy.getPointerTo()); + // ele-size + parts.push_back(mlir::LLVM::LLVMType::getInt64Ty(llvmDialect)); + // version + parts.push_back(mlir::LLVM::LLVMType::getInt32Ty(llvmDialect)); + // rank + parts.push_back(mlir::LLVM::LLVMType::getInt8Ty(llvmDialect)); + // type (code) + parts.push_back(mlir::LLVM::LLVMType::getInt8Ty(llvmDialect)); + // attribute + parts.push_back(mlir::LLVM::LLVMType::getInt8Ty(llvmDialect)); + // addendum + parts.push_back(mlir::LLVM::LLVMType::getInt8Ty(llvmDialect)); + // opt-dims: [0..15 x [int,int,int]] (see fir.dims) + // opt-type-ptr: i8* (see fir.tdesc) + // opt-flags: i64 + // opt-len-params: [? x i64] + return mlir::LLVM::LLVMType::getStructTy(llvmDialect, parts).getPointerTo(); + } + + // fir.boxchar --> llvm<"{ ix*, i64 }"> where ix is kind mapping + mlir::LLVM::LLVMType convertBoxCharType(fir::BoxCharType boxchar) { + auto ptrTy = convertCharType(boxchar.getEleTy()).getPointerTo(); + auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(llvmDialect); + SmallVector tuple{ptrTy, i64Ty}; + return mlir::LLVM::LLVMType::getStructTy(llvmDialect, tuple); + } + + // fir.boxproc --> llvm<"{ any*, i8* }"> + mlir::LLVM::LLVMType convertBoxProcType(fir::BoxProcType boxproc) { + auto funcTy = convertType(boxproc.getEleTy()); + auto ptrTy = unwrap(funcTy).getPointerTo(); + auto i8Ty = mlir::LLVM::LLVMType::getInt8Ty(llvmDialect); + SmallVector tuple{ptrTy, i8Ty}; + return mlir::LLVM::LLVMType::getStructTy(llvmDialect, tuple); + } + + unsigned characterBitsize(fir::CharacterType charTy) { + return kindMapping.getCharacterBitsize(charTy.getFKind()); + } + + // fir.char --> llvm<"ix*"> where ix is scaled by kind mapping + mlir::LLVM::LLVMType convertCharType(fir::CharacterType charTy) { + return mlir::LLVM::LLVMType::getIntNTy(llvmDialect, + characterBitsize(charTy)); + } + + mlir::LLVM::LLVMType convertComplexPartType(fir::KindTy kind) { + auto realID = kindMapping.getComplexTypeID(kind); + return fromRealTypeID(realID, kind); + } + + // fir.complex --> llvm<"{ anyfloat, anyfloat }"> + mlir::LLVM::LLVMType convertComplexType(fir::KindTy kind) { + auto realTy = convertComplexPartType(kind); + SmallVector tuple{realTy, realTy}; + return mlir::LLVM::LLVMType::getStructTy(llvmDialect, tuple); + } + + mlir::LLVM::LLVMType getDefaultInt() { + // FIXME: this should be tied to the front-end default + return mlir::LLVM::LLVMType::getInt64Ty(llvmDialect); + } + + // fir.int --> llvm.ix where ix is a kind mapping + mlir::LLVM::LLVMType convertIntegerType(fir::IntType intTy) { + return mlir::LLVM::LLVMType::getIntNTy( + llvmDialect, kindMapping.getIntegerBitsize(intTy.getFKind())); + } + + // fir.logical --> llvm.ix where ix is a kind mapping + mlir::LLVM::LLVMType convertLogicalType(fir::LogicalType boolTy) { + return mlir::LLVM::LLVMType::getIntNTy( + llvmDialect, kindMapping.getLogicalBitsize(boolTy.getFKind())); + } + + template + mlir::LLVM::LLVMType convertPointerLike(A &ty) { + mlir::Type eleTy = ty.getEleTy(); + if (auto seqTy = eleTy.dyn_cast()) { + if (!seqTy.hasConstantShape() && seqTy.hasConstantInterior()) + return unwrap(convertType(seqTy)); + } + return unwrap(convertType(eleTy)).getPointerTo(); + } + + // convert a front-end kind value to either a std or LLVM IR dialect type + // fir.real --> llvm.anyfloat where anyfloat is a kind mapping + mlir::LLVM::LLVMType convertRealType(fir::KindTy kind) { + return fromRealTypeID(kindMapping.getRealTypeID(kind), kind); + } + + // fir.type --> llvm<"%name = { ty... }"> + mlir::LLVM::LLVMType convertRecordType(fir::RecordType derived) { + auto name{derived.getName()}; + // The cache is needed to keep a unique mapping from name -> StructType + auto iter{identStructCache.find(name)}; + if (iter != identStructCache.end()) + return iter->second; + auto st{mlir::LLVM::LLVMType::createStructTy(llvmDialect, name)}; + identStructCache[name] = st; + SmallVector members; + for (auto mem : derived.getTypeList()) + members.push_back(convertType(mem.second).cast()); + mlir::LLVM::LLVMType::setStructTyBody(st, members); + return st; + } + + // fir.array --> llvm<"[...[c x any]]"> + mlir::LLVM::LLVMType convertSequenceType(fir::SequenceType seq) { + if (!seq.hasConstantInterior()) + llvm_unreachable("cannot lower type to LLVM IR"); + auto baseTy = unwrap(convertType(seq.getEleTy())); + auto shape = seq.getShape(); + auto constRows = seq.getConstantRows(); + if (constRows) { + decltype(constRows) i = constRows; + for (auto e : shape) { + baseTy = mlir::LLVM::LLVMType::getArrayTy(baseTy, e); + if (--i == 0) + break; + } + if (seq.hasConstantShape()) + return baseTy; + } + return baseTy.getPointerTo(); + } + + // tuple --> llvm<"{ ts... }"> + mlir::LLVM::LLVMType convertTupleType(mlir::TupleType tuple) { + SmallVector inMembers; + tuple.getFlattenedTypes(inMembers); + SmallVector members; + for (auto mem : inMembers) + members.push_back(convertType(mem).cast()); + return mlir::LLVM::LLVMType::getStructTy(llvmDialect, members); + } + + // complex --> llvm<"{t,t}"> + mlir::LLVM::LLVMType convertComplexType(mlir::ComplexType complex) { + auto eleTy = unwrap(convertType(complex.getElementType())); + SmallVector tuple{eleTy, eleTy}; + return mlir::LLVM::LLVMType::getStructTy(llvmDialect, tuple); + } + + // fir.tdesc --> llvm<"i8*"> + // FIXME: for now use a void*, however pointer identity is not sufficient for + // the f18 object v. class distinction + mlir::LLVM::LLVMType convertTypeDescType(mlir::MLIRContext *ctx) { + return mlir::LLVM::LLVMType::getInt8PtrTy(llvmDialect); + } + + /// Convert llvm::Type::TypeID to mlir::LLVM::LLVMType + mlir::LLVM::LLVMType fromRealTypeID(llvm::Type::TypeID typeID, + fir::KindTy kind) { + switch (typeID) { + case llvm::Type::TypeID::HalfTyID: + return mlir::LLVM::LLVMType::getHalfTy(llvmDialect); + case llvm::Type::TypeID::FloatTyID: + return mlir::LLVM::LLVMType::getFloatTy(llvmDialect); + case llvm::Type::TypeID::DoubleTyID: + return mlir::LLVM::LLVMType::getDoubleTy(llvmDialect); + case llvm::Type::TypeID::X86_FP80TyID: + return mlir::LLVM::LLVMType::getX86_FP80Ty(llvmDialect); + case llvm::Type::TypeID::FP128TyID: + return mlir::LLVM::LLVMType::getFP128Ty(llvmDialect); + default: + emitError(UnknownLoc::get(llvmDialect->getContext())) + << "unsupported type: !fir.real<" << kind << ">"; + return {}; + } + } + + /// HACK: cloned from LLVMTypeConverter since this is private there + mlir::LLVM::LLVMType unwrap(mlir::Type type) { + if (!type) + return nullptr; + auto *mlirContext = type.getContext(); + auto wrappedLLVMType = type.dyn_cast(); + if (!wrappedLLVMType) + emitError(UnknownLoc::get(mlirContext), + "conversion resulted in a non-LLVM type"); + return wrappedLLVMType; + } + + /// Returns false iff the sequence type has a shape and the shape is constant. + static bool unknownShape(fir::SequenceType::Shape shape) { + // does the shape even exist? + auto size = shape.size(); + if (size == 0) + return true; + // if it exists, are any dimensions deferred? + for (decltype(size) i = 0, sz = size; i < sz; ++i) + if (shape[i] == fir::SequenceType::getUnknownExtent()) + return true; + return false; + } + + /// Does this record type have dynamically inlined subobjects? Note: this + /// should not look through references as they are not inlined. + static bool dynamicallySized(fir::RecordType seqTy) { + for (auto field : seqTy.getTypeList()) { + if (auto arr = field.second.dyn_cast()) { + if (unknownShape(arr.getShape())) + return true; + } else if (auto rec = field.second.dyn_cast()) { + if (dynamicallySized(rec)) + return true; + } + } + return false; + } + + static bool dynamicallySized(mlir::Type ty) { + if (auto arr = ty.dyn_cast()) + ty = arr.getEleTy(); + if (auto rec = ty.dyn_cast()) + return dynamicallySized(rec); + return false; + } + + fir::NameUniquer &getUniquer() { return uniquer; } + +private: + fir::KindMapping kindMapping; + fir::NameUniquer &uniquer; + static StringMap identStructCache; +}; + +// instantiate static data member +StringMap FIRToLLVMTypeConverter::identStructCache; +} // namespace + +/// remove `omitNames` (by name) from the attribute dictionary +static SmallVector +pruneNamedAttrDict(AttributeTy attrs, ArrayRef omitNames) { + SmallVector result; + for (auto x : attrs) { + bool omit = false; + for (auto o : omitNames) + if (x.first.strref() == o) { + omit = true; + break; + } + if (!omit) + result.push_back(x); + } + return result; +} + +inline mlir::LLVM::LLVMType getVoidPtrType(mlir::LLVM::LLVMDialect *dialect) { + return mlir::LLVM::LLVMType::getInt8PtrTy(dialect); +} + +namespace { +/// FIR conversion pattern template +template +class FIROpConversion : public mlir::OpConversionPattern { +public: + explicit FIROpConversion(mlir::MLIRContext *ctx, + FIRToLLVMTypeConverter &lowering) + : mlir::OpConversionPattern(ctx, 1), lowering(lowering) {} + +protected: + LLVMContext &getLLVMContext() const { return lowering.getLLVMContext(); } + mlir::LLVM::LLVMDialect *getDialect() const { return lowering.getDialect(); } + mlir::Type convertType(mlir::Type ty) const { + return lowering.convertType(ty); + } + mlir::LLVM::LLVMType unwrap(mlir::Type ty) const { + return lowering.unwrap(ty); + } + mlir::LLVM::LLVMType voidPtrTy() const { + return getVoidPtrType(getDialect()); + } + + mlir::LLVM::ConstantOp + genConstantOffset(mlir::Location loc, + mlir::ConversionPatternRewriter &rewriter, + int offset) const { + auto ity = lowering.offsetType(); + auto cattr = rewriter.getI32IntegerAttr(offset); + return rewriter.create(loc, ity, cattr); + } + + /// Method to construct code sequence to get the rank from a box. + mlir::Value getRankFromBox(mlir::Location loc, mlir::Value box, + mlir::Type resultTy, + mlir::ConversionPatternRewriter &rewriter) const { + auto c0 = genConstantOffset(loc, rewriter, 0); + auto c3 = genConstantOffset(loc, rewriter, 3); + llvm::SmallVector args = {box, c0, c3}; + auto pty = unwrap(resultTy).getPointerTo(); + auto p = rewriter.create(loc, pty, args); + return rewriter.create(loc, resultTy, p); + } + + /// Method to construct code sequence to get the triple for dimension `dim` + /// from a box. + llvm::SmallVector + getDimsFromBox(mlir::Location loc, llvm::ArrayRef retTys, + mlir::Value box, mlir::Value dim, + mlir::ConversionPatternRewriter &rewriter) const { + auto c0 = genConstantOffset(loc, rewriter, 0); + auto c7 = genConstantOffset(loc, rewriter, 7); + auto l0 = loadFromOffset(loc, box, c0, c7, dim, 0, retTys[0], rewriter); + auto l1 = loadFromOffset(loc, box, c0, c7, dim, 1, retTys[1], rewriter); + auto l2 = loadFromOffset(loc, box, c0, c7, dim, 2, retTys[2], rewriter); + return {l0.getResult(), l1.getResult(), l2.getResult()}; + } + + mlir::LLVM::LoadOp + loadFromOffset(mlir::Location loc, mlir::Value a, mlir::LLVM::ConstantOp c0, + mlir::LLVM::ConstantOp c7, mlir::Value dim, int off, + mlir::Type ty, + mlir::ConversionPatternRewriter &rewriter) const { + auto pty = unwrap(ty).getPointerTo(); + auto c = genConstantOffset(loc, rewriter, off); + auto p = genGEP(loc, pty, rewriter, a, c0, c7, dim, c); + return rewriter.create(loc, ty, p); + } + + template + mlir::LLVM::GEPOp genGEP(mlir::Location loc, mlir::LLVM::LLVMType ty, + mlir::ConversionPatternRewriter &rewriter, + mlir::Value base, ARGS... args) const { + SmallVector cv{args...}; + return rewriter.create(loc, ty, base, cv); + } + + FIRToLLVMTypeConverter &lowering; +}; + +/// FIR conversion pattern template +template +class FIROpAndTypeConversion : public FIROpConversion { +public: + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(FromOp op, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const final { + mlir::Type ty = this->convertType(op.getType()); + return doRewrite(op, ty, operands, rewriter); + } + + virtual mlir::LogicalResult + doRewrite(FromOp addr, mlir::Type ty, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const { + llvm_unreachable("derived class must override"); + } +}; +} // namespace + +static Block *createBlock(mlir::ConversionPatternRewriter &rewriter, + mlir::Block *insertBefore) { + assert(insertBefore && "expected valid insertion block"); + return rewriter.createBlock(insertBefore->getParent(), + mlir::Region::iterator(insertBefore)); +} + +/// Create an LLVM dialect global +static void createGlobal(mlir::Location loc, mlir::ModuleOp mod, StringRef name, + mlir::LLVM::LLVMType type, + mlir::ConversionPatternRewriter &rewriter) { + if (mod.lookupSymbol(name)) + return; + mlir::OpBuilder modBuilder(mod.getBodyRegion()); + modBuilder.create(loc, type, /*isConstant=*/true, + mlir::LLVM::Linkage::Weak, name, + mlir::Attribute{}); +} + +namespace { +struct AddrOfOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::AddrOfOp addr, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto ty = unwrap(convertType(addr.getType())); + auto attrs = pruneNamedAttrDict(addr.getAttrs(), {"symbol"}); + rewriter.replaceOpWithNewOp( + addr, ty, addr.symbol().getRootReference(), attrs); + return success(); + } +}; +} // namespace + +static mlir::LLVM::ConstantOp +genConstantIndex(mlir::Location loc, mlir::LLVM::LLVMType ity, + mlir::ConversionPatternRewriter &rewriter, int offset) { + auto cattr = rewriter.getI64IntegerAttr(offset); + return rewriter.create(loc, ity, cattr); +} + +namespace { +/// convert to LLVM IR dialect `alloca` +struct AllocaOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::AllocaOp alloc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto loc = alloc.getLoc(); + auto ity = lowering.indexType(); + auto c1 = genConstantIndex(loc, ity, rewriter, 1); + auto size = c1.getResult(); + for (auto opnd : operands) + size = rewriter.create(loc, ity, size, opnd); + auto ty = convertType(alloc.getType()); + rewriter.replaceOpWithNewOp(alloc, ty, size, + alloc.getAttrs()); + return success(); + } +}; +} // namespace + +static mlir::LLVM::LLVMFuncOp +getMalloc(fir::AllocMemOp op, mlir::ConversionPatternRewriter &rewriter, + mlir::LLVM::LLVMDialect *dialect) { + auto module = op.getParentOfType(); + if (auto mallocFunc = module.lookupSymbol("malloc")) + return mallocFunc; + mlir::OpBuilder moduleBuilder( + op.getParentOfType().getBodyRegion()); + auto indexType = mlir::LLVM::LLVMType::getInt64Ty(dialect); + return moduleBuilder.create( + rewriter.getUnknownLoc(), "malloc", + mlir::LLVM::LLVMType::getFunctionTy(getVoidPtrType(dialect), indexType, + /*isVarArg=*/false)); +} + +namespace { +/// convert to `call` to the runtime to `malloc` memory +struct AllocMemOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::AllocMemOp heap, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto ty = convertType(heap.getType()); + auto dialect = getDialect(); + auto mallocFunc = getMalloc(heap, rewriter, dialect); + auto loc = heap.getLoc(); + auto ity = lowering.indexType(); + auto c1 = genConstantIndex(loc, ity, rewriter, 1); + auto size = c1.getResult(); + for (auto opnd : operands) + size = rewriter.create(loc, ity, size, opnd); + heap.setAttr("callee", rewriter.getSymbolRefAttr(mallocFunc)); + SmallVector args{size}; + rewriter.replaceOpWithNewOp(heap, ty, args, + heap.getAttrs()); + return success(); + } +}; +} // namespace + +/// obtain the free() function +static mlir::LLVM::LLVMFuncOp getFree(fir::FreeMemOp op, + mlir::ConversionPatternRewriter &rewriter, + mlir::LLVM::LLVMDialect *dialect) { + auto module = op.getParentOfType(); + if (auto freeFunc = module.lookupSymbol("free")) + return freeFunc; + mlir::OpBuilder moduleBuilder(module.getBodyRegion()); + auto voidType = mlir::LLVM::LLVMType::getVoidTy(dialect); + return moduleBuilder.create( + rewriter.getUnknownLoc(), "free", + mlir::LLVM::LLVMType::getFunctionTy(voidType, getVoidPtrType(dialect), + /*isVarArg=*/false)); +} + +namespace { +/// lower a freemem instruction into a call to free() +struct FreeMemOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::FreeMemOp freemem, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto dialect = getDialect(); + auto freeFunc = getFree(freemem, rewriter, dialect); + auto bitcast = rewriter.create( + freemem.getLoc(), voidPtrTy(), operands[0]); + freemem.setAttr("callee", rewriter.getSymbolRefAttr(freeFunc)); + rewriter.replaceOpWithNewOp( + freemem, mlir::LLVM::LLVMType::getVoidTy(dialect), + SmallVector{bitcast}, freemem.getAttrs()); + return success(); + } +}; + +/// convert to returning the first element of the box (any flavor) +struct BoxAddrOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxAddrOp boxaddr, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto loc = boxaddr.getLoc(); + auto ty = convertType(boxaddr.getType()); + if (auto argty = boxaddr.val().getType().dyn_cast()) { + auto c0 = genConstantOffset(loc, rewriter, 0); + auto pty = unwrap(ty).getPointerTo(); + auto p = genGEP(loc, unwrap(pty), rewriter, a, c0, c0); + // load the pointer from the buffer + rewriter.replaceOpWithNewOp(boxaddr, ty, p); + } else { + auto c0attr = rewriter.getI32IntegerAttr(0); + auto c0 = mlir::ArrayAttr::get(c0attr, boxaddr.getContext()); + rewriter.replaceOpWithNewOp(boxaddr, ty, a, + c0); + } + return success(); + } +}; + +/// convert to an extractvalue for the 2nd part of the boxchar +struct BoxCharLenOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxCharLenOp boxchar, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto ty = convertType(boxchar.getType()); + auto ctx = boxchar.getContext(); + auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + rewriter.replaceOpWithNewOp(boxchar, ty, a, c1); + return success(); + } +}; + +/// convert to a triple set of GEPs and loads +struct BoxDimsOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxDimsOp boxdims, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + llvm::SmallVector resultTypes = { + convertType(boxdims.getResult(0).getType()), + convertType(boxdims.getResult(1).getType()), + convertType(boxdims.getResult(2).getType()), + }; + auto results = getDimsFromBox(boxdims.getLoc(), resultTypes, operands[0], + operands[1], rewriter); + rewriter.replaceOp(boxdims, results); + return success(); + } +}; + +struct BoxEleSizeOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxEleSizeOp boxelesz, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto loc = boxelesz.getLoc(); + auto c0 = genConstantOffset(loc, rewriter, 0); + auto c1 = genConstantOffset(loc, rewriter, 1); + auto ty = convertType(boxelesz.getType()); + auto p = genGEP(loc, unwrap(ty), rewriter, a, c0, c1); + rewriter.replaceOpWithNewOp(boxelesz, ty, p); + return success(); + } +}; + +struct BoxIsAllocOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxIsAllocOp boxisalloc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto loc = boxisalloc.getLoc(); + auto ity = lowering.offsetType(); + auto c0 = genConstantOffset(loc, rewriter, 0); + auto c5 = genConstantOffset(loc, rewriter, 5); + auto ty = convertType(boxisalloc.getType()); + auto p = genGEP(loc, unwrap(ty), rewriter, a, c0, c5); + auto ld = rewriter.create(loc, ty, p); + auto ab = genConstantOffset(loc, rewriter, 2); + auto bit = rewriter.create(loc, ity, ld, ab); + rewriter.replaceOpWithNewOp( + boxisalloc, mlir::LLVM::ICmpPredicate::ne, bit, c0); + return success(); + } +}; + +struct BoxIsArrayOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxIsArrayOp boxisarray, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto loc = boxisarray.getLoc(); + auto c0 = genConstantOffset(loc, rewriter, 0); + auto c3 = genConstantOffset(loc, rewriter, 3); + auto ty = convertType(boxisarray.getType()); + auto p = genGEP(loc, unwrap(ty), rewriter, a, c0, c3); + auto ld = rewriter.create(loc, ty, p); + rewriter.replaceOpWithNewOp( + boxisarray, mlir::LLVM::ICmpPredicate::ne, ld, c0); + return success(); + } +}; + +struct BoxIsPtrOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxIsPtrOp boxisptr, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto loc = boxisptr.getLoc(); + auto ty = convertType(boxisptr.getType()); + auto ity = lowering.offsetType(); + auto c0 = genConstantOffset(loc, rewriter, 0); + auto c5 = genConstantOffset(loc, rewriter, 5); + SmallVector args{a, c0, c5}; + auto p = rewriter.create(loc, ty, args); + auto ld = rewriter.create(loc, ty, p); + auto ab = genConstantOffset(loc, rewriter, 1); + auto bit = rewriter.create(loc, ity, ld, ab); + rewriter.replaceOpWithNewOp( + boxisptr, mlir::LLVM::ICmpPredicate::ne, bit, c0); + return success(); + } +}; + +struct BoxProcHostOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxProcHostOp boxprochost, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto ty = convertType(boxprochost.getType()); + auto ctx = boxprochost.getContext(); + auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + rewriter.replaceOpWithNewOp(boxprochost, ty, a, + c1); + return success(); + } +}; + +struct BoxRankOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxRankOp boxrank, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto loc = boxrank.getLoc(); + auto ty = convertType(boxrank.getType()); + auto result = getRankFromBox(loc, a, ty, rewriter); + rewriter.replaceOp(boxrank, result); + return success(); + } +}; + +struct BoxTypeDescOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxTypeDescOp boxtypedesc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto loc = boxtypedesc.getLoc(); + auto ty = convertType(boxtypedesc.getType()); + auto c0 = genConstantOffset(loc, rewriter, 0); + auto c4 = genConstantOffset(loc, rewriter, 4); + SmallVector args{a, c0, c4}; + auto pty = unwrap(ty).getPointerTo(); + auto p = rewriter.create(loc, pty, args); + auto ld = rewriter.create(loc, ty, p); + auto i8ptr = mlir::LLVM::LLVMType::getInt8PtrTy(getDialect()); + rewriter.replaceOpWithNewOp(boxtypedesc, i8ptr, ld); + return success(); + } +}; + +struct StringLitOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::StringLitOp constop, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto ty = convertType(constop.getType()); + auto attr = constop.getValue(); + if (attr.isa()) { + rewriter.replaceOpWithNewOp(constop, ty, attr); + } else { + // convert the array attr to a dense elements attr + // LLVMIR dialect knows how to lower the latter to LLVM IR + auto arr = attr.cast(); + auto size = constop.getSize().cast().getInt(); + auto eleTy = constop.getType().cast().getEleTy(); + auto bits = lowering.characterBitsize(eleTy.cast()); + auto charTy = rewriter.getIntegerType(bits); + auto det = mlir::VectorType::get({size}, charTy); + // convert each character to a precise bitsize + llvm::SmallVector vec; + for (auto a : arr.getValue()) + vec.push_back(mlir::IntegerAttr::get( + charTy, a.cast().getValue().sextOrTrunc(bits))); + auto dea = mlir::DenseElementsAttr::get(det, vec); + rewriter.replaceOpWithNewOp(constop, ty, dea); + } + return success(); + } +}; + +/// direct call LLVM function +struct CallOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::CallOp call, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + SmallVector resultTys; + for (auto r : call.getResults()) + resultTys.push_back(convertType(r.getType())); + rewriter.replaceOpWithNewOp(call, resultTys, operands, + call.getAttrs()); + return success(); + } +}; + +/// Compare complex values +/// +/// Per 10.1, the only comparisons available are .EQ. (oeq) and .NE. (une). +/// +/// For completeness, all other comparison are done on the real component only. +struct CmpcOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::CmpcOp cmp, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto ctxt = cmp.getContext(); + auto kind = cmp.lhs().getType().cast().getFKind(); + auto ty = convertType(fir::RealType::get(ctxt, kind)); + auto loc = cmp.getLoc(); + auto pos0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctxt); + SmallVector rp{ + rewriter.create(loc, ty, operands[0], pos0), + rewriter.create(loc, ty, operands[1], + pos0)}; + auto rcp = rewriter.create(loc, ty, rp, cmp.getAttrs()); + auto pos1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctxt); + SmallVector ip{ + rewriter.create(loc, ty, operands[0], pos1), + rewriter.create(loc, ty, operands[1], + pos1)}; + auto icp = rewriter.create(loc, ty, ip, cmp.getAttrs()); + SmallVector cp{rcp, icp}; + switch (cmp.getPredicate()) { + case mlir::CmpFPredicate::OEQ: // .EQ. + rewriter.replaceOpWithNewOp(cmp, ty, cp); + break; + case mlir::CmpFPredicate::UNE: // .NE. + rewriter.replaceOpWithNewOp(cmp, ty, cp); + break; + default: + rewriter.replaceOp(cmp, rcp.getResult()); + break; + } + return success(); + } +}; + +struct CmpfOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::CmpfOp cmp, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto type = convertType(cmp.getType()); + rewriter.replaceOpWithNewOp(cmp, type, operands, + cmp.getAttrs()); + return success(); + } +}; + +struct ConstcOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::ConstcOp conc, OperandTy, + mlir::ConversionPatternRewriter &rewriter) const override { + auto loc = conc.getLoc(); + auto ctx = conc.getContext(); + auto ty = convertType(conc.getType()); + auto ct = conc.getType().cast(); + auto ety = lowering.convertComplexPartType(ct.getFKind()); + auto ri = mlir::FloatAttr::get(ety, getValue(conc.getReal())); + auto rp = rewriter.create(loc, ety, ri); + auto ii = mlir::FloatAttr::get(ety, getValue(conc.getImaginary())); + auto ip = rewriter.create(loc, ety, ii); + auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); + auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + auto r = rewriter.create(loc, ty); + auto rr = rewriter.create(loc, ty, r, rp, c0); + rewriter.replaceOpWithNewOp(conc, ty, rr, ip, + c1); + return success(); + } + + inline llvm::APFloat getValue(mlir::Attribute attr) const { + return attr.cast().getValue(); + } +}; + +struct ConstfOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::ConstfOp conf, OperandTy, + mlir::ConversionPatternRewriter &rewriter) const override { + auto ty = convertType(conf.getType()); + auto val = conf.constantAttr(); + rewriter.replaceOpWithNewOp(conf, ty, val); + return success(); + } +}; + +/// convert value of from-type to value of to-type +struct ConvertOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::ConvertOp convert, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto fromTy_ = convertType(convert.value().getType()); + auto fromTy = unwrap(fromTy_); + auto toTy_ = convertType(convert.res().getType()); + auto toTy = unwrap(toTy_); + auto *fromLLVMTy = fromTy.getUnderlyingType(); + auto *toLLVMTy = toTy.getUnderlyingType(); + auto &op0 = operands[0]; + if (fromLLVMTy == toLLVMTy) { + rewriter.replaceOp(convert, op0); + return success(); + } + auto loc = convert.getLoc(); + mlir::Value v; + if (fromLLVMTy->isFloatingPointTy()) { + if (toLLVMTy->isFloatingPointTy()) { + std::size_t fromBits{fromLLVMTy->getPrimitiveSizeInBits()}; + std::size_t toBits{toLLVMTy->getPrimitiveSizeInBits()}; + // FIXME: what if different reps (F16, BF16) are the same size? + assert(fromBits != toBits); + if (fromBits > toBits) + v = rewriter.create(loc, toTy, op0); + else + v = rewriter.create(loc, toTy, op0); + } else if (toLLVMTy->isIntegerTy()) { + v = rewriter.create(loc, toTy, op0); + } + } else if (fromLLVMTy->isIntegerTy()) { + if (toLLVMTy->isIntegerTy()) { + std::size_t fromBits{fromLLVMTy->getIntegerBitWidth()}; + std::size_t toBits{toLLVMTy->getIntegerBitWidth()}; + assert(fromBits != toBits); + if (fromBits > toBits) + v = rewriter.create(loc, toTy, op0); + else + v = rewriter.create(loc, toTy, op0); + } else if (toLLVMTy->isFloatingPointTy()) { + v = rewriter.create(loc, toTy, op0); + } else if (toLLVMTy->isPointerTy()) { + v = rewriter.create(loc, toTy, op0); + } + } else if (fromLLVMTy->isPointerTy()) { + if (toLLVMTy->isIntegerTy()) { + v = rewriter.create(loc, toTy, op0); + } else if (toLLVMTy->isPointerTy()) { + v = rewriter.create(loc, toTy, op0); + } + } + if (v) + rewriter.replaceOp(convert, v); + else + emitError(loc) << "cannot convert " << fromTy_ << " to " << toTy_; + return success(); + } +}; + +/// virtual call to a method in a dispatch table +struct DispatchOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::DispatchOp dispatch, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto ty = convertType(dispatch.getFunctionType()); + // get the table, lookup the method, fetch the func-ptr + rewriter.replaceOpWithNewOp(dispatch, ty, operands, + None); + TODO(); + return success(); + } +}; + +/// dispatch table for a Fortran derived type +struct DispatchTableOpConversion + : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::DispatchTableOp dispTab, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + TODO(); + return success(); + } +}; + +/// entry in a dispatch table; binds a method-name to a function +struct DTEntryOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::DTEntryOp dtEnt, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + TODO(); + return success(); + } +}; + +/// create a CHARACTER box +struct EmboxCharOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::EmboxCharOp emboxchar, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto b = operands[1]; + auto loc = emboxchar.getLoc(); + auto ctx = emboxchar.getContext(); + auto ty = convertType(emboxchar.getType()); + auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); + auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + auto un = rewriter.create(loc, ty); + auto r = rewriter.create(loc, ty, un, a, c0); + rewriter.replaceOpWithNewOp(emboxchar, ty, r, b, + c1); + return success(); + } +}; + +/// create a generic box on a memory reference +struct EmboxOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::EmboxOp embox, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto loc = embox.getLoc(); + auto dialect = getDialect(); + auto ty = unwrap(convertType(embox.getType())); + auto alloca = genAllocaWithType(loc, ty, 24, defaultAlign, rewriter); + auto c0 = genConstantOffset(loc, rewriter, 0); + auto rty = unwrap(operands[0].getType()).getPointerTo(); + auto f0p = genGEP(loc, rty, rewriter, alloca, c0, c0); + auto f0p_ = rewriter.create(loc, rty, f0p); + rewriter.create(loc, operands[0], f0p_); + auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(dialect); + auto i64PtrTy = i64Ty.getPointerTo(); + auto f1p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 1); + auto c0_ = rewriter.create(loc, i64Ty, c0); + rewriter.create(loc, c0_, f1p); + auto i32PtrTy = mlir::LLVM::LLVMType::getInt32Ty(dialect).getPointerTo(); + auto f2p = genGEPToField(loc, i32PtrTy, rewriter, alloca, c0, 2); + rewriter.create(loc, c0, f2p); + auto i8Ty = mlir::LLVM::LLVMType::getInt8Ty(dialect); + auto i8PtrTy = mlir::LLVM::LLVMType::getInt8PtrTy(dialect); + auto c0__ = rewriter.create(loc, i8Ty, c0); + auto f3p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 3); + rewriter.create(loc, c0__, f3p); + auto f4p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 4); + rewriter.create(loc, c0__, f4p); + auto f5p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 5); + rewriter.create(loc, c0__, f5p); + auto f6p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 6); + rewriter.create(loc, c0__, f6p); + // FIXME: copy the dims info, etc. + + rewriter.replaceOp(embox, alloca.getResult()); + return success(); + } + + /// Generate an alloca of size `size` and cast it to type `toTy` + mlir::LLVM::BitcastOp + genAllocaWithType(mlir::Location loc, mlir::LLVM::LLVMType toTy, + unsigned size, unsigned alignment, + mlir::ConversionPatternRewriter &rewriter) const { + auto i8Ty = mlir::LLVM::LLVMType::getInt8PtrTy(getDialect()); + auto thisPt = rewriter.saveInsertionPoint(); + auto *thisBlock = rewriter.getInsertionBlock(); + auto func = mlir::cast(thisBlock->getParentOp()); + rewriter.setInsertionPointToStart(&func.front()); + auto size_ = genConstantOffset(loc, rewriter, size); + auto al = + rewriter.create(loc, i8Ty, size_, alignment); + rewriter.restoreInsertionPoint(thisPt); + return rewriter.create(loc, toTy, al); + } + + mlir::LLVM::BitcastOp genGEPToField(mlir::Location loc, + mlir::LLVM::LLVMType ty, + mlir::ConversionPatternRewriter &rewriter, + mlir::Value base, mlir::Value zero, + int field) const { + auto coff = genConstantOffset(loc, rewriter, field); + auto gep = genGEP(loc, ty, rewriter, base, zero, coff); + return rewriter.create(loc, ty, gep); + } +}; + +/// create a procedure pointer box +struct EmboxProcOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::EmboxProcOp emboxproc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto a = operands[0]; + auto b = operands[1]; + auto loc = emboxproc.getLoc(); + auto ctx = emboxproc.getContext(); + auto ty = convertType(emboxproc.getType()); + auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); + auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + auto un = rewriter.create(loc, ty); + auto r = rewriter.create(loc, ty, un, a, c0); + rewriter.replaceOpWithNewOp(emboxproc, ty, r, b, + c1); + return success(); + } +}; + +struct ValueOpCommon { + static mlir::Attribute getValue(mlir::Value value) { + auto defOp = value.getDefiningOp(); + if (auto v = dyn_cast(defOp)) + return v.value(); + if (auto v = dyn_cast(defOp)) + return v.value(); + llvm_unreachable("must be a constant op"); + return {}; + } +}; + +/// Extract a subobject value from an ssa-value of aggregate type +struct ExtractValueOpConversion + : public FIROpAndTypeConversion, + public ValueOpCommon { + using FIROpAndTypeConversion::FIROpAndTypeConversion; + + mlir::LogicalResult + doRewrite(fir::ExtractValueOp extractVal, mlir::Type ty, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + assert(fir::allConstants(operands.drop_front(1))); + // since all indices are constants use LLVM's extractvalue instruction + SmallVector attrs; + for (std::size_t i = 1, end{operands.size()}; i < end; ++i) + attrs.push_back(getValue(operands[i])); + auto position = mlir::ArrayAttr::get(attrs, extractVal.getContext()); + rewriter.replaceOpWithNewOp( + extractVal, ty, operands[0], position); + return success(); + } +}; + +/// InsertValue is the generalized instruction for the composition of new +/// aggregate type values. +struct InsertValueOpConversion + : public FIROpAndTypeConversion, + public ValueOpCommon { + using FIROpAndTypeConversion::FIROpAndTypeConversion; + + mlir::LogicalResult + doRewrite(fir::InsertValueOp insertVal, mlir::Type ty, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + assert(fir::allConstants(operands.drop_front(2))); + // since all indices must be constants use LLVM's insertvalue instruction + SmallVector attrs; + for (std::size_t i = 2, end{operands.size()}; i < end; ++i) + attrs.push_back(getValue(operands[i])); + auto position = mlir::ArrayAttr::get(attrs, insertVal.getContext()); + rewriter.replaceOpWithNewOp( + insertVal, ty, operands[0], operands[1], position); + return success(); + } +}; + +/// convert to reference to a reference to a subobject +struct CoordinateOpConversion + : public FIROpAndTypeConversion { + using FIROpAndTypeConversion::FIROpAndTypeConversion; + + mlir::LogicalResult + doRewrite(fir::CoordinateOp coor, mlir::Type ty, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto loc = coor.getLoc(); + auto c0 = genConstantIndex(loc, lowering.indexType(), rewriter, 0); + mlir::Value base = operands[0]; + auto firTy = coor.getBaseType(); + mlir::Type cpnTy = getReferenceEleTy(firTy); + bool columnIsDeferred = false; + bool hasSubdimension = hasSubDimensions(cpnTy); + + // if argument 0 is boxed, get the base pointer from the box + if (auto boxTy = firTy.dyn_cast()) { + + // Special case: + // %lenp = len_param_index foo, type + // %addr = coordinate_of %box, %lenp + if (coor.getNumOperands() == 2) { + auto coorPtr = *coor.coor().begin(); + auto s = coorPtr.getDefiningOp(); + if (s && isa(s)) { + mlir::Value lenParam = operands[1]; // byte offset + auto bc = + rewriter.create(loc, voidPtrTy(), base); + auto gep = genGEP(loc, unwrap(ty), rewriter, bc, lenParam); + rewriter.replaceOpWithNewOp(coor, unwrap(ty), + gep); + return success(); + } + } + + auto c0_ = genConstantOffset(loc, rewriter, 0); + auto pty = unwrap(convertType(boxTy.getEleTy())).getPointerTo(); + // Extract the boxed reference + auto p = genGEP(loc, pty, rewriter, base, c0, c0_); + // base = box->data : ptr + base = rewriter.create(loc, pty, p); + + // If the base has dynamic shape, it has to be boxed as the dimension + // information is saved in the box. + if (FIRToLLVMTypeConverter::dynamicallySized(cpnTy)) { + TODO(); + return success(); + } + } else { + if (FIRToLLVMTypeConverter::dynamicallySized(cpnTy)) + return mlir::emitError(loc, "bare reference to unknown shape"); + } + if (!hasSubdimension) + columnIsDeferred = true; + + if (!validCoordinate(cpnTy, operands.drop_front(1))) + return mlir::emitError(loc, "coordinate has incorrect dimension"); + + // if arrays has known shape + const bool hasKnownShape = + arraysHaveKnownShape(cpnTy, operands.drop_front(1)); + + // If only the column is `?`, then we can simply place the column value in + // the 0-th GEP position. + if (auto arrTy = cpnTy.dyn_cast()) { + if (!hasKnownShape) { + const auto sz = arrTy.getDimension(); + if (arraysHaveKnownShape(arrTy.getEleTy(), + operands.drop_front(1 + sz))) { + auto shape = arrTy.getShape(); + bool allConst = true; + for (std::remove_const_t i = 0; i < sz - 1; ++i) + if (shape[i] < 0) { + allConst = false; + break; + } + if (allConst) + columnIsDeferred = true; + } + } + } + + if (hasKnownShape || columnIsDeferred) { + SmallVector offs; + if (hasKnownShape && hasSubdimension) + offs.push_back(c0); + const auto sz = operands.size(); + llvm::Optional dims; + SmallVector arrIdx; + for (std::remove_const_t i = 1; i < sz; ++i) { + auto nxtOpnd = operands[i]; + + if (!cpnTy) + return mlir::emitError(loc, "invalid coordinate/check failed"); + + // check if the i-th coordinate relates to an array + if (dims.hasValue()) { + arrIdx.push_back(nxtOpnd); + int dimsLeft = *dims; + if (dimsLeft > 1) { + dims = dimsLeft - 1; + continue; + } + cpnTy = cpnTy.cast().getEleTy(); + // append array range in reverse (FIR arrays are column-major) + offs.append(arrIdx.rbegin(), arrIdx.rend()); + arrIdx.clear(); + dims.reset(); + continue; + } else if (auto arrTy = cpnTy.dyn_cast()) { + int d = arrTy.getDimension() - 1; + if (d > 0) { + dims = d; + arrIdx.push_back(nxtOpnd); + continue; + } + cpnTy = cpnTy.cast().getEleTy(); + offs.push_back(nxtOpnd); + continue; + } + + // check if the i-th coordinate relates to a field + if (auto strTy = cpnTy.dyn_cast()) { + cpnTy = strTy.getType(getIntValue(nxtOpnd)); + } else if (auto strTy = cpnTy.dyn_cast()) { + cpnTy = strTy.getType(getIntValue(nxtOpnd)); + } else { + cpnTy = nullptr; + } + offs.push_back(nxtOpnd); + } + if (dims.hasValue()) + return mlir::emitError(loc, "not enough arguments for array shape"); + mlir::Value retval = genGEP(loc, unwrap(ty), rewriter, base, offs); + rewriter.replaceOp(coor, retval); + return success(); + } + + // Taking a coordinate of an array with deferred shape. In this case, the + // array must be boxed. We need to retrieve the array triples from the box. + // + // Given: + // + // %box ... : box> + // %addr = coordinate_of %box, %0, %1, %2 + // + // We want to lower this into an llvm GEP as: + // + // %i1 = (%0 - %box.dims(0).lo) * %box.dims(0).str + // %i2 = (%1 - %box.dims(1).lo) * %box.dims(1).str * %box.dims(0).ext + // %scale_by = %box.dims(1).ext * %box.dims(0).ext + // %i3 = (%2 - %box.dims(2).lo) * %box.dims(2).str * %scale_by + // %offset = %i3 + %i2 + %i1 + // %addr = getelementptr i32, i32* %box.ref, i64 %offset + // + // Section 18.5.3 para 3 specifies when and how to interpret the `lo` + // value(s) of the triple. The implication is that they must always be + // zero for `coordinate_of`. This is because we do not use `coordinate_of` + // to compute the offset into a `box` or `box`. The coordinate + // is pointer arithmetic. Pointers along a path must be explicitly + // dereferenced with a `load`. + + if (!firTy.isa()) + return mlir::emitError(loc, "base must have box type"); + if (!cpnTy.isa()) + return mlir::emitError(loc, "base element must be reference to array"); + auto baseTy = cpnTy.cast(); + const auto baseDim = baseTy.getDimension(); + if (!arraysHaveKnownShape(baseTy.getEleTy(), + operands.drop_front(1 + baseDim))) + return mlir::emitError(loc, "base element has deferred shapes"); + + // Generate offset computation. + TODO(); + + return failure(); + } + + bool hasSubDimensions(mlir::Type type) const { + return type.isa() || type.isa() || + type.isa(); + } + + /// Walk the abstract memory layout and determine if the path traverses any + /// array types with unknown shape. Return true iff all the array types have a + /// constant shape along the path. + bool arraysHaveKnownShape(mlir::Type type, OperandTy coors) const { + const auto sz = coors.size(); + std::remove_const_t i = 0; + for (; i < sz; ++i) { + auto nxtOpnd = coors[i]; + if (auto arrTy = type.dyn_cast()) { + if (FIRToLLVMTypeConverter::unknownShape(arrTy.getShape())) + return false; + i += arrTy.getDimension() - 1; + type = arrTy.getEleTy(); + } else if (auto strTy = type.dyn_cast()) { + type = strTy.getType(getIntValue(nxtOpnd)); + } else if (auto strTy = type.dyn_cast()) { + type = strTy.getType(getIntValue(nxtOpnd)); + } else { + return true; + } + } + return true; + } + + bool validCoordinate(mlir::Type type, OperandTy coors) const { + const auto sz = coors.size(); + std::remove_const_t i = 0; + bool subEle = false; + bool ptrEle = false; + for (; i < sz; ++i) { + auto nxtOpnd = coors[i]; + if (auto arrTy = type.dyn_cast()) { + subEle = true; + i += arrTy.getDimension() - 1; + type = arrTy.getEleTy(); + } else if (auto strTy = type.dyn_cast()) { + subEle = true; + type = strTy.getType(getIntValue(nxtOpnd)); + } else if (auto strTy = type.dyn_cast()) { + subEle = true; + type = strTy.getType(getIntValue(nxtOpnd)); + } else { + ptrEle = true; + } + } + if (ptrEle) + return (!subEle) && (sz == 1); + return subEle && (i == sz); + } + + /// Returns the element type of the reference `refTy`. + static mlir::Type getReferenceEleTy(mlir::Type refTy) { + if (auto boxTy = refTy.dyn_cast()) + return boxTy.getEleTy(); + if (auto ptrTy = refTy.dyn_cast()) + return ptrTy.getEleTy(); + if (auto ptrTy = refTy.dyn_cast()) + return ptrTy.getEleTy(); + if (auto ptrTy = refTy.dyn_cast()) + return ptrTy.getEleTy(); + llvm_unreachable("not a reference type"); + } + + /// return true if all `Value`s in `operands` are not `FieldIndexOp`s + static bool noFieldIndexOps(mlir::Operation::operand_range operands) { + for (auto opnd : operands) { + if (auto defop = opnd.getDefiningOp()) + if (dyn_cast(defop)) + return false; + } + return true; + } + + SmallVector arguments(OperandTy vec, unsigned s, + unsigned e) const { + return {vec.begin() + s, vec.begin() + e}; + } + + int64_t getIntValue(mlir::Value val) const { + if (val) + if (auto defop = val.getDefiningOp()) + if (auto constOp = dyn_cast(defop)) + return constOp.getValue(); + llvm_unreachable("must be a constant"); + } +}; + +/// convert a field index to a runtime function that computes the byte offset +/// of the dynamic field +struct FieldIndexOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + // NB: most field references should be resolved by this point + mlir::LogicalResult + matchAndRewrite(fir::FieldIndexOp field, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + // call the compiler generated function to determine the byte offset of + // the field at runtime + auto symAttr = + mlir::SymbolRefAttr::get(methodName(field), field.getContext()); + SmallVector attrs{ + rewriter.getNamedAttr("callee", symAttr)}; + auto ty = lowering.offsetType(); + rewriter.replaceOpWithNewOp(field, ty, operands, attrs); + return success(); + } + + // constructing the name of the method + inline static std::string methodName(fir::FieldIndexOp field) { + auto fldName = field.field_id(); + auto type = field.on_type().cast(); + // note: using std::string to dodge a bug in g++ 7.4.0 + std::string tyName = type.getName().str(); + llvm::Twine methodName = "_QQOFFSETOF_" + tyName + "_" + fldName; + return methodName.str(); + } +}; + +struct LenParamIndexOpConversion + : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + // FIXME: this should be specialized by the runtime target + mlir::LogicalResult + matchAndRewrite(fir::LenParamIndexOp lenp, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto ity = lowering.indexType(); + auto onty = lenp.getOnType(); + // size of portable descriptor + const unsigned boxsize = 24; // FIXME + unsigned offset = boxsize; + // add the size of the rows of triples + if (auto arr = onty.dyn_cast()) { + offset += 3 * arr.getDimension(); + } + // advance over some addendum fields + const unsigned addendumOffset{sizeof(void *) + sizeof(uint64_t)}; + offset += addendumOffset; + // add the offset into the LENs + offset += 0; // FIXME + auto attr = rewriter.getI64IntegerAttr(offset); + rewriter.replaceOpWithNewOp(lenp, ity, attr); + return success(); + } +}; + +/// lower the fir.end operation to a null (erasing it) +struct FirEndOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::FirEndOp op, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + rewriter.replaceOp(op, {}); + return success(); + } +}; + +/// lower a gendims operation into a sequence of writes to a temp +/// TODO: should this be returning a value or a ref? A !fir.dims object has +/// very restricted application +struct GenDimsOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + // gendims(args:index, ...) ==> %v = ... : [size x <3 x index>] + mlir::LogicalResult + matchAndRewrite(fir::GenDimsOp gendims, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto loc = gendims.getLoc(); + auto ty = convertType(gendims.getType()); + auto ptrTy = unwrap(ty).getPointerTo(); + auto alloca = genAlloca(loc, ptrTy, defaultAlign, rewriter); + unsigned offIndex = 0; + auto c0 = genConstantOffset(loc, rewriter, 0); + auto ipty = lowering.indexType().getPointerTo(); + for (auto opd : operands) { + auto offset = genConstantOffset(loc, rewriter, offIndex++); + auto gep = genGEP(loc, ipty, rewriter, alloca, c0, c0, offset); + rewriter.create(loc, opd, gep); + } + rewriter.replaceOpWithNewOp(gendims, ptrTy, alloca); + return success(); + } + + // Generate an alloca of size `size` and cast it to type `toTy` + mlir::LLVM::AllocaOp + genAlloca(mlir::Location loc, mlir::LLVM::LLVMType toTy, unsigned alignment, + mlir::ConversionPatternRewriter &rewriter) const { + auto thisPt = rewriter.saveInsertionPoint(); + auto *thisBlock = rewriter.getInsertionBlock(); + auto func = mlir::cast(thisBlock->getParentOp()); + rewriter.setInsertionPointToStart(&func.front()); + auto size = genConstantOffset(loc, rewriter, 1); + auto rv = rewriter.create(loc, toTy, size, alignment); + rewriter.restoreInsertionPoint(thisPt); + return rv; + } +}; + +/// lower a type descriptor to a global constant +struct GenTypeDescOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::GenTypeDescOp gentypedesc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto loc = gentypedesc.getLoc(); + auto inTy = gentypedesc.getInType(); + auto name = consName(rewriter, inTy); + auto gty = unwrap(convertType(inTy)); + auto pty = gty.getPointerTo(); + auto module = gentypedesc.getParentOfType(); + createGlobal(loc, module, name, gty, rewriter); + rewriter.replaceOpWithNewOp(gentypedesc, pty, + name); + return success(); + } + + std::string consName(mlir::ConversionPatternRewriter &rewriter, + mlir::Type type) const { + if (auto d = type.dyn_cast()) { + auto name = d.getName(); + auto pair = fir::NameUniquer::deconstruct(name); + return lowering.getUniquer().doTypeDescriptor( + pair.second.modules, pair.second.host, pair.second.name, + pair.second.kinds); + } + llvm_unreachable("no name found"); + } +}; + +struct GlobalLenOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::GlobalLenOp globalLen, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + TODO(); + return success(); + } +}; + +struct HasValueOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::HasValueOp op, OperandTy operands, + ConversionPatternRewriter &rewriter) const override { + rewriter.replaceOpWithNewOp(op, operands); + return success(); + } +}; + +struct GlobalOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::GlobalOp global, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto tyAttr = unwrap(convertType(global.getType())); + auto loc = global.getLoc(); + mlir::Attribute initAttr{}; + if (global.initVal()) + initAttr = global.initVal().getValue(); + auto linkage = convertLinkage(global.linkName()); + auto isConst = global.constant().hasValue(); + auto g = rewriter.create( + loc, tyAttr, isConst, linkage, global.sym_name(), initAttr); + auto &gr = g.getInitializerRegion(); + rewriter.inlineRegionBefore(global.region(), gr, gr.end()); + rewriter.eraseOp(global); + return success(); + } + + mlir::LLVM::Linkage + convertLinkage(llvm::Optional optLinkage) const { + if (optLinkage.hasValue()) { + auto name = optLinkage.getValue(); + if (name == "internal") + return mlir::LLVM::Linkage::Internal; + if (name == "common") + return mlir::LLVM::Linkage::Common; + if (name == "weak") + return mlir::LLVM::Linkage::Weak; + } + return mlir::LLVM::Linkage::External; + } +}; + +// convert to LLVM IR dialect `load` +struct LoadOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::LoadOp load, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto ty = convertType(load.getType()); + auto at = load.getAttrs(); + rewriter.replaceOpWithNewOp(load, ty, operands, at); + return success(); + } +}; + +// FIXME: how do we want to enforce this in LLVM-IR? +struct NoReassocOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::NoReassocOp noreassoc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + noreassoc.replaceAllUsesWith(operands[0]); + rewriter.replaceOp(noreassoc, {}); + return success(); + } +}; + +void genCondBrOp(mlir::Location loc, mlir::Value cmp, mlir::Block *dest, + llvm::Optional destOps, + mlir::ConversionPatternRewriter &rewriter, + mlir::Block *newBlock) { + if (destOps.hasValue()) + rewriter.create(loc, cmp, dest, destOps.getValue(), + newBlock, mlir::ValueRange()); + else + rewriter.create(loc, cmp, dest, newBlock); +} + +template +void genBrOp(A caseOp, mlir::Block *dest, llvm::Optional destOps, + mlir::ConversionPatternRewriter &rewriter) { + if (destOps.hasValue()) + rewriter.replaceOpWithNewOp(caseOp, destOps.getValue(), + dest); + else + rewriter.replaceOpWithNewOp(caseOp, llvm::None, dest); +} + +void genCaseLadderStep(mlir::Location loc, mlir::Value cmp, mlir::Block *dest, + llvm::Optional destOps, + mlir::ConversionPatternRewriter &rewriter) { + auto *thisBlock = rewriter.getInsertionBlock(); + auto *newBlock = createBlock(rewriter, dest); + rewriter.setInsertionPointToEnd(thisBlock); + genCondBrOp(loc, cmp, dest, destOps, rewriter, newBlock); + rewriter.setInsertionPointToEnd(newBlock); +} + +/// Conversion of `fir.select_case` +/// +/// TODO: lowering of CHARACTER type cases +struct SelectCaseOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::SelectCaseOp caseOp, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + const auto conds = caseOp.getNumConditions(); + auto attrName = fir::SelectCaseOp::getCasesAttr(); + auto cases = caseOp.getAttrOfType(attrName).getValue(); + // Type can be CHARACTER, INTEGER, or LOGICAL (C1145) + [[maybe_unused]] auto ty = caseOp.getSelector().getType(); + auto selector = caseOp.getSelector(operands); + auto loc = caseOp.getLoc(); + assert(conds > 0 && "fir.selectcase must have cases"); + for (std::remove_const_t t = 0; t != conds; ++t) { + mlir::Block *dest = caseOp.getSuccessor(t); + auto destOps = caseOp.getSuccessorOperands(operands, t); + auto cmpOps = *caseOp.getCompareOperands(operands, t); + auto caseArg = *cmpOps.begin(); + auto &attr = cases[t]; + if (attr.isa()) { + auto cmp = rewriter.create( + loc, mlir::LLVM::ICmpPredicate::eq, selector, caseArg); + genCaseLadderStep(loc, cmp, dest, destOps, rewriter); + continue; + } + if (attr.isa()) { + auto cmp = rewriter.create( + loc, mlir::LLVM::ICmpPredicate::sle, caseArg, selector); + genCaseLadderStep(loc, cmp, dest, destOps, rewriter); + continue; + } + if (attr.isa()) { + auto cmp = rewriter.create( + loc, mlir::LLVM::ICmpPredicate::sle, selector, caseArg); + genCaseLadderStep(loc, cmp, dest, destOps, rewriter); + continue; + } + if (attr.isa()) { + auto cmp = rewriter.create( + loc, mlir::LLVM::ICmpPredicate::sle, caseArg, selector); + auto *thisBlock = rewriter.getInsertionBlock(); + auto *newBlock1 = createBlock(rewriter, dest); + auto *newBlock2 = createBlock(rewriter, dest); + rewriter.setInsertionPointToEnd(thisBlock); + rewriter.create(loc, cmp, newBlock1, newBlock2); + rewriter.setInsertionPointToEnd(newBlock1); + auto caseArg_ = *(cmpOps.begin() + 1); + auto cmp_ = rewriter.create( + loc, mlir::LLVM::ICmpPredicate::sle, selector, caseArg_); + genCondBrOp(loc, cmp_, dest, destOps, rewriter, newBlock2); + rewriter.setInsertionPointToEnd(newBlock2); + continue; + } + assert(attr.isa()); + assert((t + 1 == conds) && "unit must be last"); + genBrOp(caseOp, dest, destOps, rewriter); + } + return success(); + } +}; + +template +void selectMatchAndRewrite(FIRToLLVMTypeConverter &lowering, OP select, + OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) { + // We could target the LLVM switch instruction, but it isn't part of the + // LLVM IR dialect. Create an if-then-else ladder instead. + auto conds = select.getNumConditions(); + auto attrName = OP::getCasesAttr(); + auto caseAttr = select.template getAttrOfType(attrName); + auto cases = caseAttr.getValue(); + auto ty = select.getSelector().getType(); + auto ity = lowering.convertType(ty); + auto selector = select.getSelector(operands); + auto loc = select.getLoc(); + assert(conds > 0 && "select must have cases"); + for (decltype(conds) t = 0; t != conds; ++t) { + mlir::Block *dest = select.getSuccessor(t); + auto destOps = select.getSuccessorOperands(operands, t); + auto &attr = cases[t]; + if (auto intAttr = attr.template dyn_cast()) { + auto ci = rewriter.create( + loc, ity, rewriter.getIntegerAttr(ty, intAttr.getInt())); + auto cmp = rewriter.create( + loc, mlir::LLVM::ICmpPredicate::eq, selector, ci); + genCaseLadderStep(loc, cmp, dest, destOps, rewriter); + continue; + } + assert(attr.template dyn_cast_or_null()); + assert((t + 1 == conds) && "unit must be last"); + genBrOp(select, dest, destOps, rewriter); + } +} + +/// conversion of fir::SelectOp to an if-then-else ladder +struct SelectOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::SelectOp op, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + selectMatchAndRewrite(lowering, op, operands, rewriter); + return success(); + } +}; + +/// conversion of fir::SelectRankOp to an if-then-else ladder +struct SelectRankOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::SelectRankOp op, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + selectMatchAndRewrite(lowering, op, operands, rewriter); + return success(); + } +}; + +struct SelectTypeOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::SelectTypeOp select, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + llvm_unreachable("fir.select_type should have already been converted"); + return failure(); + } +}; + +// convert to LLVM IR dialect `store` +struct StoreOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::StoreOp store, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + rewriter.replaceOpWithNewOp(store, operands[0], + operands[1]); + return success(); + } +}; + +// cons an extractvalue on a tuple value, returning value at element `x` +mlir::LLVM::ExtractValueOp genExtractValueWithIndex( + mlir::Location loc, mlir::Value tuple, mlir::LLVM::LLVMType ty, + mlir::ConversionPatternRewriter &rewriter, mlir::MLIRContext *ctx, int x) { + auto cx = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(x), ctx); + auto xty = ty.getStructElementType(x); + return rewriter.create(loc, xty, tuple, cx); +} + +// unbox a CHARACTER box value, yielding its components +struct UnboxCharOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::UnboxCharOp unboxchar, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto *ctx = unboxchar.getContext(); + auto loc = unboxchar.getLoc(); + auto tuple = operands[0]; + auto ty = unwrap(tuple.getType()); + mlir::Value ptr = + genExtractValueWithIndex(loc, tuple, ty, rewriter, ctx, 0); + mlir::Value len = + genExtractValueWithIndex(loc, tuple, ty, rewriter, ctx, 1); + std::vector repls = {ptr, len}; + unboxchar.replaceAllUsesWith(repls); + rewriter.eraseOp(unboxchar); + return success(); + } +}; + +// unbox a generic box reference, yielding its components +struct UnboxOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::UnboxOp unbox, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto loc = unbox.getLoc(); + auto tuple = operands[0]; + auto ty = unwrap(tuple.getType()); + auto oty = lowering.offsetType(); + auto c0 = rewriter.create( + loc, oty, rewriter.getI32IntegerAttr(0)); + mlir::Value ptr = genLoadWithIndex(loc, tuple, ty, rewriter, oty, c0, 0); + mlir::Value len = genLoadWithIndex(loc, tuple, ty, rewriter, oty, c0, 1); + mlir::Value ver = genLoadWithIndex(loc, tuple, ty, rewriter, oty, c0, 2); + mlir::Value rank = genLoadWithIndex(loc, tuple, ty, rewriter, oty, c0, 3); + mlir::Value type = genLoadWithIndex(loc, tuple, ty, rewriter, oty, c0, 4); + mlir::Value attr = genLoadWithIndex(loc, tuple, ty, rewriter, oty, c0, 5); + mlir::Value xtra = genLoadWithIndex(loc, tuple, ty, rewriter, oty, c0, 6); + // FIXME: add dims, etc. + std::vector repls{ptr, len, ver, rank, type, attr, xtra}; + unbox.replaceAllUsesWith(repls); + rewriter.eraseOp(unbox); + return success(); + } + + // generate a GEP into a structure and load the element at position `x` + mlir::LLVM::LoadOp genLoadWithIndex(mlir::Location loc, mlir::Value tuple, + mlir::LLVM::LLVMType ty, + mlir::ConversionPatternRewriter &rewriter, + mlir::LLVM::LLVMType oty, + mlir::LLVM::ConstantOp c0, int x) const { + auto ax = rewriter.getI32IntegerAttr(x); + auto cx = rewriter.create(loc, oty, ax); + auto xty = ty.getStructElementType(x); + auto gep = genGEP(loc, xty.getPointerTo(), rewriter, tuple, c0, cx); + return rewriter.create(loc, xty, gep); + } +}; + +// unbox a procedure box value, yielding its components +struct UnboxProcOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::UnboxProcOp unboxproc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto *ctx = unboxproc.getContext(); + auto loc = unboxproc.getLoc(); + auto tuple = operands[0]; + auto ty = unwrap(tuple.getType()); + mlir::Value ptr = + genExtractValueWithIndex(loc, tuple, ty, rewriter, ctx, 0); + mlir::Value host = + genExtractValueWithIndex(loc, tuple, ty, rewriter, ctx, 1); + std::vector repls{ptr, host}; + unboxproc.replaceAllUsesWith(repls); + rewriter.eraseOp(unboxproc); + return success(); + } +}; + +// convert to LLVM IR dialect `undef` +struct UndefOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::UndefOp undef, OperandTy, + mlir::ConversionPatternRewriter &rewriter) const override { + rewriter.replaceOpWithNewOp( + undef, convertType(undef.getType())); + return success(); + } +}; + +// convert to LLVM IR dialect `unreachable` +struct UnreachableOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::UnreachableOp unreach, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + rewriter.replaceOpWithNewOp(unreach); + return success(); + } +}; + +// +// Primitive operations on Real (floating-point) types +// + +/// Convert a floating-point primitive +template +void lowerRealBinaryOp(BINOP binop, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter, + FIRToLLVMTypeConverter &lowering) { + auto ty = lowering.convertType(binop.getType()); + rewriter.replaceOpWithNewOp(binop, ty, operands); +} + +struct AddfOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::AddfOp op, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + lowerRealBinaryOp(op, operands, rewriter, lowering); + return success(); + } +}; +struct SubfOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::SubfOp op, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + lowerRealBinaryOp(op, operands, rewriter, lowering); + return success(); + } +}; +struct MulfOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::MulfOp op, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + lowerRealBinaryOp(op, operands, rewriter, lowering); + return success(); + } +}; +struct DivfOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::DivfOp op, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + lowerRealBinaryOp(op, operands, rewriter, lowering); + return success(); + } +}; +struct ModfOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::ModfOp op, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + lowerRealBinaryOp(op, operands, rewriter, lowering); + return success(); + } +}; + +struct NegfOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::NegfOp neg, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto ty = convertType(neg.getType()); + rewriter.replaceOpWithNewOp(neg, ty, operands); + return success(); + } +}; + +// +// Primitive operations on Complex types +// + +/// Generate inline code for complex addition/subtraction +template +mlir::LLVM::InsertValueOp complexSum(OPTY sumop, OperandTy opnds, + mlir::ConversionPatternRewriter &rewriter, + FIRToLLVMTypeConverter &lowering) { + auto a = opnds[0]; + auto b = opnds[1]; + auto loc = sumop.getLoc(); + auto ctx = sumop.getContext(); + auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); + auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + auto ty = lowering.convertType(sumop.getType()); + auto x = rewriter.create(loc, ty, a, c0); + auto x_ = rewriter.create(loc, ty, b, c0); + auto rx = rewriter.create(loc, ty, x, x_); + auto y = rewriter.create(loc, ty, a, c1); + auto y_ = rewriter.create(loc, ty, b, c1); + auto ry = rewriter.create(loc, ty, y, y_); + auto r = rewriter.create(loc, ty); + auto r_ = rewriter.create(loc, ty, r, rx, c0); + return rewriter.create(loc, ty, r_, ry, c1); +} + +struct AddcOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::AddcOp addc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + // given: (x + iy) * (x' + iy') + // result: (x + x') + i(y + y') + auto r = complexSum(addc, operands, rewriter, lowering); + addc.replaceAllUsesWith(r.getResult()); + rewriter.replaceOp(addc, r.getResult()); + return success(); + } +}; + +struct SubcOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::SubcOp subc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + // given: (x + iy) * (x' + iy') + // result: (x - x') + i(y - y') + auto r = complexSum(subc, operands, rewriter, lowering); + subc.replaceAllUsesWith(r.getResult()); + rewriter.replaceOp(subc, r.getResult()); + return success(); + } +}; + +/// Inlined complex multiply +struct MulcOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::MulcOp mulc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + // TODO: should this just call __muldc3 ? + // given: (x + iy) * (x' + iy') + // result: (xx'-yy')+i(xy'+yx') + auto a = operands[0]; + auto b = operands[1]; + auto loc = mulc.getLoc(); + auto ctx = mulc.getContext(); + auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); + auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + auto ty = convertType(mulc.getType()); + auto x = rewriter.create(loc, ty, a, c0); + auto x_ = rewriter.create(loc, ty, b, c0); + auto xx_ = rewriter.create(loc, ty, x, x_); + auto y = rewriter.create(loc, ty, a, c1); + auto yx_ = rewriter.create(loc, ty, y, x_); + auto y_ = rewriter.create(loc, ty, b, c1); + auto xy_ = rewriter.create(loc, ty, x, y_); + auto ri = rewriter.create(loc, ty, xy_, yx_); + auto yy_ = rewriter.create(loc, ty, y, y_); + auto rr = rewriter.create(loc, ty, xx_, yy_); + auto ra = rewriter.create(loc, ty); + auto r_ = rewriter.create(loc, ty, ra, rr, c0); + auto r = rewriter.create(loc, ty, r_, ri, c1); + mulc.replaceAllUsesWith(r.getResult()); + rewriter.replaceOp(mulc, r.getResult()); + return success(); + } +}; + +/// Inlined complex division +struct DivcOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::DivcOp divc, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + // TODO: should this just call __divdc3 ? + // given: (x + iy) / (x' + iy') + // result: ((xx'+yy')/d) + i((yx'-xy')/d) where d = x'x' + y'y' + auto a = operands[0]; + auto b = operands[1]; + auto loc = divc.getLoc(); + auto ctx = divc.getContext(); + auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); + auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + auto ty = convertType(divc.getType()); + auto x = rewriter.create(loc, ty, a, c0); + auto x_ = rewriter.create(loc, ty, b, c0); + auto xx_ = rewriter.create(loc, ty, x, x_); + auto x_x_ = rewriter.create(loc, ty, x_, x_); + auto y = rewriter.create(loc, ty, a, c1); + auto yx_ = rewriter.create(loc, ty, y, x_); + auto y_ = rewriter.create(loc, ty, b, c1); + auto xy_ = rewriter.create(loc, ty, x, y_); + auto yy_ = rewriter.create(loc, ty, y, y_); + auto y_y_ = rewriter.create(loc, ty, y_, y_); + auto d = rewriter.create(loc, ty, x_x_, y_y_); + auto rrn = rewriter.create(loc, ty, xx_, yy_); + auto rin = rewriter.create(loc, ty, yx_, xy_); + auto rr = rewriter.create(loc, ty, rrn, d); + auto ri = rewriter.create(loc, ty, rin, d); + auto ra = rewriter.create(loc, ty); + auto r_ = rewriter.create(loc, ty, ra, rr, c0); + auto r = rewriter.create(loc, ty, r_, ri, c1); + divc.replaceAllUsesWith(r.getResult()); + rewriter.replaceOp(divc, r.getResult()); + return success(); + } +}; + +/// Inlined complex negation +struct NegcOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::NegcOp neg, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + // given: -(x + iy) + // result: -x - iy + auto ctxt = neg.getContext(); + auto ty = convertType(neg.getType()); + auto loc = neg.getLoc(); + auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctxt); + auto &o0 = operands[0]; + auto rp = rewriter.create(loc, ty, o0, c0); + auto nrp = rewriter.create(loc, ty, rp); + auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctxt); + auto ip = rewriter.create(loc, ty, o0, c1); + auto nip = rewriter.create(loc, ty, ip); + auto r = rewriter.create(loc, ty, o0, nrp, c0); + rewriter.replaceOpWithNewOp(neg, ty, r, nip, c1); + return success(); + } +}; + +// Lower a SELECT operation into a cascade of conditional branches. The last +// case must be the `true` condition. +/// Convert FIR dialect to LLVM dialect +/// +/// This pass lowers all FIR dialect operations to LLVM IR dialect. An +/// MLIR pass is used to lower residual Std dialect to LLVM IR dialect. +struct FIRToLLVMLoweringPass : public mlir::ModulePass { + FIRToLLVMLoweringPass(fir::NameUniquer &uniquer) : uniquer{uniquer} {} + + void runOnModule() override { + if (disableFirToLLVMIR) + return; + + auto *context{&getContext()}; + FIRToLLVMTypeConverter typeConverter{context, uniquer}; + mlir::OwningRewritePatternList patterns; + patterns.insert< + AddcOpConversion, AddfOpConversion, AddrOfOpConversion, + AllocaOpConversion, AllocMemOpConversion, BoxAddrOpConversion, + BoxCharLenOpConversion, BoxDimsOpConversion, BoxEleSizeOpConversion, + BoxIsAllocOpConversion, BoxIsArrayOpConversion, BoxIsPtrOpConversion, + BoxProcHostOpConversion, BoxRankOpConversion, BoxTypeDescOpConversion, + CallOpConversion, CmpcOpConversion, CmpfOpConversion, + ConstcOpConversion, ConstfOpConversion, ConvertOpConversion, + CoordinateOpConversion, DispatchOpConversion, DispatchTableOpConversion, + DivcOpConversion, DivfOpConversion, DTEntryOpConversion, + EmboxCharOpConversion, EmboxOpConversion, EmboxProcOpConversion, + FieldIndexOpConversion, FirEndOpConversion, ExtractValueOpConversion, + FreeMemOpConversion, GenDimsOpConversion, GenTypeDescOpConversion, + GlobalLenOpConversion, GlobalOpConversion, HasValueOpConversion, + InsertValueOpConversion, LenParamIndexOpConversion, LoadOpConversion, + ModfOpConversion, MulcOpConversion, MulfOpConversion, NegcOpConversion, + NegfOpConversion, NoReassocOpConversion, SelectCaseOpConversion, + SelectOpConversion, SelectRankOpConversion, SelectTypeOpConversion, + StoreOpConversion, StringLitOpConversion, SubcOpConversion, + SubfOpConversion, UnboxCharOpConversion, UnboxOpConversion, + UnboxProcOpConversion, UndefOpConversion, UnreachableOpConversion>( + context, typeConverter); + mlir::populateStdToLLVMConversionPatterns(typeConverter, patterns); + mlir::ConversionTarget target{*context}; + target.addLegalDialect(); + + // required NOP stubs for applying a full conversion + target.addDynamicallyLegalOp( + [&](mlir::ModuleOp) { return true; }); + target.addDynamicallyLegalOp( + [&](mlir::ModuleTerminatorOp) { return true; }); + + genDispatchTableMap(); + + // apply the patterns + if (mlir::failed(mlir::applyFullConversion( + getModule(), target, std::move(patterns), &typeConverter))) { + mlir::emitError(mlir::UnknownLoc::get(context), + "error in converting to LLVM-IR dialect\n"); + signalPassFailure(); + } + } + +private: + void genDispatchTableMap() { + for (auto dt : getModule().getOps()) { + // FIXME + (void)dt; + } + } + + fir::NameUniquer &uniquer; +}; + +/// Lower from LLVM IR dialect to proper LLVM-IR and dump the module +struct LLVMIRLoweringPass : public mlir::ModulePass { + LLVMIRLoweringPass(raw_ostream &output) : output{output} {} + + void runOnModule() override { + if (disableLLVM) + return; + + if (auto llvmModule = mlir::translateModuleToLLVMIR(getModule())) { + llvmModule->print(output, nullptr); + return; + } + + auto *ctxt = getModule().getContext(); + mlir::emitError(mlir::UnknownLoc::get(ctxt), "could not emit LLVM-IR\n"); + signalPassFailure(); + } + +private: + llvm::raw_ostream &output; +}; + +} // namespace + +std::unique_ptr +fir::createFIRToLLVMPass(fir::NameUniquer &nameUniquer) { + return std::make_unique(nameUniquer); +} + +std::unique_ptr +fir::createLLVMDialectToLLVMPass(llvm::raw_ostream &output) { + return std::make_unique(output); +} + +// Register the FIR to LLVM-IR pass +static mlir::PassRegistration + passLowFIR("fir-to-llvmir", + "Conversion of the FIR dialect to the LLVM-IR dialect", [] { + fir::NameUniquer dummy; + return std::make_unique(dummy); + }); diff --git a/flang/lib/Optimizer/IteratedDominanceFrontier.cpp b/flang/lib/Optimizer/IteratedDominanceFrontier.cpp new file mode 100644 index 0000000000000..9fee2b7314b2d --- /dev/null +++ b/flang/lib/Optimizer/IteratedDominanceFrontier.cpp @@ -0,0 +1,107 @@ +//===- IteratedDominanceFrontier.cpp - Compute IDF ------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Compute iterated dominance frontiers using a linear time algorithm. +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Analysis/IteratedDominanceFrontier.h" +#include "mlir/Analysis/Dominance.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/SmallPtrSet.h" +#include "llvm/ADT/SmallVector.h" +#include "llvm/IR/Dominators.h" +#include +#include + +namespace fir { + +template +void IDFCalculator::calculate( + llvm::SmallVectorImpl &PHIBlocks) { + // Use a priority queue keyed on dominator tree level so that inserted nodes + // are handled from the bottom of the dominator tree upwards. We also augment + // the level with a DFS number to ensure that the blocks are ordered in a + // deterministic way. + using UnsignedPair = std::pair; + using DomTreeNode = llvm::DomTreeNodeBase; + using DomTreeNodePair = std::pair; + using IDFPriorityQueue = + std::priority_queue, + llvm::less_second>; + IDFPriorityQueue PQ; + + if (DefBlocks->empty()) + return; + + DT.updateDFSNumbers(); + + for (NodeTy *BB : *DefBlocks) { + if (DomTreeNode *Node = DT.getNode(BB)) + PQ.push({Node, std::make_pair(Node->getLevel(), Node->getDFSNumIn())}); + } + + llvm::SmallVector Worklist; + llvm::SmallPtrSet VisitedPQ; + llvm::SmallPtrSet VisitedWorklist; + + while (!PQ.empty()) { + DomTreeNodePair RootPair = PQ.top(); + PQ.pop(); + DomTreeNode *Root = RootPair.first; + unsigned RootLevel = RootPair.second.first; + + // Walk all dominator tree children of Root, inspecting their CFG edges with + // targets elsewhere on the dominator tree. Only targets whose level is at + // most Root's level are added to the iterated dominance frontier of the + // definition set. + + Worklist.clear(); + Worklist.push_back(Root); + VisitedWorklist.insert(Root); + + while (!Worklist.empty()) { + DomTreeNode *Node = Worklist.pop_back_val(); + NodeTy *BB = Node->getBlock(); + // Succ is the successor in the direction we are calculating IDF, so it is + // successor for IDF, and predecessor for Reverse IDF. + auto DoWork = [&](NodeTy *Succ) { + DomTreeNode *SuccNode = DT.getNode(Succ); + + const unsigned SuccLevel = SuccNode->getLevel(); + if (SuccLevel > RootLevel) + return; + + if (!VisitedPQ.insert(SuccNode).second) + return; + + NodeTy *SuccBB = SuccNode->getBlock(); + if (useLiveIn && !LiveInBlocks->count(SuccBB)) + return; + + PHIBlocks.emplace_back(SuccBB); + if (!DefBlocks->count(SuccBB)) + PQ.push(std::make_pair( + SuccNode, std::make_pair(SuccLevel, SuccNode->getDFSNumIn()))); + }; + + for (auto *Succ : BB->getSuccessors()) + DoWork(Succ); + + for (auto DomChild : *Node) { + if (VisitedWorklist.insert(DomChild).second) + Worklist.push_back(DomChild); + } + } + } +} + +template class IDFCalculator; + +} // namespace fir diff --git a/flang/lib/Optimizer/StdConverter.cpp b/flang/lib/Optimizer/StdConverter.cpp new file mode 100644 index 0000000000000..55285bd7b8377 --- /dev/null +++ b/flang/lib/Optimizer/StdConverter.cpp @@ -0,0 +1,231 @@ +//===-- StdConverter.cpp --------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Dialect/FIRAttr.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROpsSupport.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/KindMapping.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Conversion/AffineToStandard/AffineToStandard.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/IR/StandardTypes.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Transforms/DialectConversion.h" +#include "llvm/ADT/ArrayRef.h" + +// This module performs the conversion of some FIR operations. +// Convert some FIR types to standard dialect? + +static llvm::cl::opt disableFirToStd( + "disable-fir-to-std", + llvm::cl::desc("disable conversion of fir.select_type and affine dialect " + "to the standard dialect pass"), + llvm::cl::init(false), llvm::cl::Hidden); + +namespace fir { +namespace { + +using SmallVecResult = llvm::SmallVector; +using OperandTy = llvm::ArrayRef; +using AttributeTy = llvm::ArrayRef; + +/// FIR to standard type converter +/// This converts a subset of FIR types to standard types +class FIRToStdTypeConverter : public mlir::TypeConverter { +public: + using TypeConverter::TypeConverter; + + explicit FIRToStdTypeConverter(KindMapping &map) : kindMap{map} { + addConversion([&](CplxType type) { + return mlir::ComplexType::get(toFloatType(type.getFKind())); + }); + addConversion([&](RealType type) { return toFloatType(type.getFKind()); }); + addConversion([&](IntType type) { return toIntegerType(type.getFKind()); }); + } + +private: + mlir::Type toFloatType(KindTy kind) { + auto *ctx = kindMap.getContext(); + switch (kindMap.getRealTypeID(kind)) { + case llvm::Type::TypeID::HalfTyID: + return mlir::FloatType::getF16(ctx); +#if 0 + // TODO: there is no BF16 type in LLVM yet, so add this when one becomes + // available + case llvm::Type::TypeID:: FIXME TyID: + return mlir::FloatType::getBF16(ctx); +#endif + case llvm::Type::TypeID::FloatTyID: + return mlir::FloatType::getF32(ctx); + case llvm::Type::TypeID::DoubleTyID: + return mlir::FloatType::getF64(ctx); + case llvm::Type::TypeID::X86_FP80TyID: // MLIR does not support yet + [[fallthrough]]; + case llvm::Type::TypeID::FP128TyID: // MLIR does not support yet + [[fallthrough]]; + default: + return RealType::get(ctx, kind); + } + } + + mlir::Type toIntegerType(KindTy kind) { + return mlir::IntegerType::get(kindMap.getIntegerBitsize(kind), + kindMap.getContext()); + } + + // clang++ erroneously complains this variable is unused (see CMakeLists.txt) + KindMapping &kindMap; +}; + +/// FIR conversion pattern template +template +class FIROpConversion : public mlir::ConversionPattern { +public: + explicit FIROpConversion( + mlir::MLIRContext *ctx /*, FIRToStdTypeConverter &lowering*/) + : ConversionPattern(FromOp::getOperationName(), 1, + ctx) /*, lowering(lowering)*/ + {} + + static Block *createBlock(mlir::ConversionPatternRewriter &rewriter, + Block *insertBefore) { + assert(insertBefore && "expected valid insertion block"); + return rewriter.createBlock(insertBefore->getParent(), + mlir::Region::iterator(insertBefore)); + } + +protected: + // mlir::Type convertType(mlir::Type ty) const { return + // lowering.convertType(ty); } + + // FIRToStdTypeConverter &lowering; +}; + +/// SelectTypeOp converted to an if-then-else chain +/// +/// This lowers the test conditions to calls into the runtime +struct SelectTypeOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(mlir::Operation *op, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto selectType = mlir::cast(op); + auto conds = selectType.getNumConditions(); + auto attrName = SelectTypeOp::getCasesAttr(); + auto caseAttr = selectType.getAttrOfType(attrName); + auto cases = caseAttr.getValue(); + // Selector must be of type !fir.box + auto selector = selectType.getSelector(operands); + auto loc = selectType.getLoc(); + auto mod = op->getParentOfType(); + for (decltype(conds) t = 0; t != conds; ++t) { + auto *dest = selectType.getSuccessor(t); + auto destOps = selectType.getSuccessorOperands(operands, t); + auto &attr = cases[t]; + if (auto a = attr.dyn_cast()) { + genTypeLadderStep(loc, /*exactTest=*/true, selector, a.getType(), dest, + destOps, mod, rewriter); + continue; + } + if (auto a = attr.dyn_cast()) { + genTypeLadderStep(loc, /*exactTest=*/false, selector, a.getType(), dest, + destOps, mod, rewriter); + continue; + } + assert(attr.isa()); + assert((t + 1 == conds) && "unit must be last"); + rewriter.replaceOpWithNewOp( + selectType, dest, mlir::ValueRange{destOps.getValue()}); + } + return success(); + } + + static void genTypeLadderStep(mlir::Location loc, bool exactTest, + mlir::Value selector, mlir::Type ty, + mlir::Block *dest, + llvm::Optional destOps, + mlir::ModuleOp module, + mlir::ConversionPatternRewriter &rewriter) { + mlir::Type tydesc = TypeDescType::get(ty); + auto tyattr = mlir::TypeAttr::get(ty); + mlir::Value t = rewriter.create(loc, tydesc, tyattr); + mlir::Type selty = BoxType::get(rewriter.getNoneType()); + mlir::Value csel = rewriter.create(loc, selty, selector); + mlir::Type tty = ReferenceType::get(rewriter.getNoneType()); + mlir::Value ct = rewriter.create(loc, tty, t); + std::vector actuals = {csel, ct}; + auto fty = rewriter.getI1Type(); + std::vector argTy = {selty, tty}; + llvm::StringRef funName = + exactTest ? "FIXME_exact_type_match" : "FIXME_isa_type_test"; + createFuncOp(rewriter.getUnknownLoc(), module, funName, + rewriter.getFunctionType(argTy, fty)); + // FIXME: need to call actual runtime routines for (1) testing if the + // runtime type of the selector is an exact match to a derived type or (2) + // testing if the runtime type of the selector is a derived type or one of + // that derived type's subtypes. + auto cmp = rewriter.create( + loc, fty, rewriter.getSymbolRefAttr(funName), actuals); + auto *thisBlock = rewriter.getInsertionBlock(); + auto *newBlock = createBlock(rewriter, dest); + rewriter.setInsertionPointToEnd(thisBlock); + if (destOps.hasValue()) + rewriter.create(loc, cmp.getResult(0), dest, + destOps.getValue(), newBlock, + llvm::None); + else + rewriter.create(loc, cmp.getResult(0), dest, + newBlock); + rewriter.setInsertionPointToEnd(newBlock); + } +}; + +/// Convert affine dialect, fir.select_type to standard dialect +class FIRToStdLoweringPass : public mlir::FunctionPass { +public: + explicit FIRToStdLoweringPass(const KindMapping &kindMap) + : kindMap{kindMap} {} + + void runOnFunction() override { + if (disableFirToStd) + return; + + // FIRToStdTypeConverter tyConv{kindMap}; + mlir::OwningRewritePatternList patterns; + // patterns.insert(context, tyConv); + patterns.insert(&getContext()); + mlir::populateAffineToStdConversionPatterns(patterns, &getContext()); + // mlir::populateFuncOpTypeConversionPattern(patterns, context, tyConv); + mlir::ConversionTarget target(getContext()); + target.addLegalDialect(); + // target.addDynamicallyLegalOp([&](mlir::FuncOp op) { + // return tyConv.isSignatureLegal(op.getType()); + //}); + target.addIllegalOp(); + + if (mlir::failed( + mlir::applyPartialConversion(getFunction(), target, patterns))) + signalPassFailure(); + } + + mlir::ModuleOp getModule() { + return getFunction().getParentOfType(); + } + +private: + const KindMapping &kindMap; +}; +} // namespace + +std::unique_ptr createFIRToStdPass(const KindMapping &kindMap) { + return std::make_unique(kindMap); +} +} // namespace fir diff --git a/flang/lib/Optimizer/Transforms/CMakeLists.txt b/flang/lib/Optimizer/Transforms/CMakeLists.txt new file mode 100644 index 0000000000000..97bfbd98b2c13 --- /dev/null +++ b/flang/lib/Optimizer/Transforms/CMakeLists.txt @@ -0,0 +1,14 @@ +add_llvm_library(FIRTransforms + CSE.cpp + MemToReg.cpp + RewriteLoop.cpp +) + +add_dependencies(FIRTransforms FIROpsIncGen) + +target_link_libraries(FIRTransforms FIROptimizer) + +install (TARGETS FIRTransforms + ARCHIVE DESTINATION lib + LIBRARY DESTINATION lib +) diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp new file mode 100644 index 0000000000000..04c0ab8eec2d5 --- /dev/null +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -0,0 +1,325 @@ +//===-- CSE.cpp -- common subexpression elimination -----------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +/// +/// \file +/// This transformation pass performs a simple common sub-expression elimination +/// algorithm on operations within a function. +/// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Dialect/FIROpsSupport.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Analysis/Dominance.h" +#include "mlir/IR/Attributes.h" +#include "mlir/IR/Builders.h" +#include "mlir/IR/Function.h" +#include "mlir/Interfaces/SideEffects.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Support/Functional.h" +#include "mlir/Transforms/Passes.h" +#include "mlir/Transforms/Utils.h" +#include "llvm/ADT/DenseMapInfo.h" +#include "llvm/ADT/Hashing.h" +#include "llvm/ADT/ScopedHashTable.h" +#include "llvm/Support/Allocator.h" +#include "llvm/Support/CommandLine.h" +#include "llvm/Support/RecyclingAllocator.h" +#include + +using namespace mlir; + +static llvm::cl::opt + leaveEffects("keep-effects", + llvm::cl::desc("disable cleaning up effects attributes"), + llvm::cl::init(false), llvm::cl::Hidden); +static llvm::cl::opt disableCSE("disable-cse", + llvm::cl::desc("disable CSE pass"), + llvm::cl::init(false), llvm::cl::Hidden); + +namespace { + +struct SimpleOperationInfo : public llvm::DenseMapInfo { + + /// Compute the hash value of an Operation + static unsigned getHashValue(const Operation *opC) { + auto *op = const_cast(opC); + // Hash the operations based upon their: + // - Operation Name + // - Attributes + // - Result Types + // - Operands + unsigned hashOps; + if (op->isCommutative()) { + std::vector vec; + for (auto i = op->operand_begin(), e = op->operand_end(); i != e; ++i) + vec.push_back((*i).getAsOpaquePointer()); + llvm::sort(vec.begin(), vec.end()); + hashOps = llvm::hash_combine_range(vec.begin(), vec.end()); + } else { + hashOps = + llvm::hash_combine_range(op->operand_begin(), op->operand_end()); + } + auto hashResTys{llvm::hash_combine_range(op->result_type_begin(), + op->result_type_end())}; + return llvm::hash_combine(op->getName(), op->getAttrs(), hashResTys, + hashOps); + } + + static bool isEqual(const Operation *lhsC, const Operation *rhsC) { + auto *lhs = const_cast(lhsC); + auto *rhs = const_cast(rhsC); + if (lhs == rhs) + return true; + if (lhs == getTombstoneKey() || lhs == getEmptyKey() || + rhs == getTombstoneKey() || rhs == getEmptyKey()) + return false; + + // Compare the operation name. + if (lhs->getName() != rhs->getName()) + return false; + // Check operand and result type counts. + if (lhs->getNumOperands() != rhs->getNumOperands() || + lhs->getNumResults() != rhs->getNumResults()) + return false; + // Compare attributes. + if (lhs->getAttrs() != rhs->getAttrs()) + return false; + // Compare operands. + if (lhs->isCommutative()) { + SmallVector lops(lhs->operand_begin(), lhs->operand_end()); + llvm::sort(lops.begin(), lops.end()); + SmallVector rops(rhs->operand_begin(), rhs->operand_end()); + llvm::sort(rops.begin(), rops.end()); + if (!std::equal(lops.begin(), lops.end(), rops.begin())) + return false; + } else { + if (!std::equal(lhs->operand_begin(), lhs->operand_end(), + rhs->operand_begin())) + return false; + } + // Compare result types. + return std::equal(lhs->result_type_begin(), lhs->result_type_end(), + rhs->result_type_begin()); + } +}; + +/// Basic common sub-expression elimination. +struct BasicCSE : public FunctionPass { + BasicCSE() = default; + BasicCSE(const BasicCSE &) {} + + /// Shared implementation of operation elimination and scoped map definitions. + using AllocatorTy = llvm::RecyclingAllocator< + llvm::BumpPtrAllocator, + llvm::ScopedHashTableVal>; + using ScopedMapTy = llvm::ScopedHashTable; + + /// Represents a single entry in the depth first traversal of a CFG. + struct CFGStackNode { + CFGStackNode(ScopedMapTy &knownValues, DominanceInfoNode *node) + : scope(knownValues), node(node), childIterator(node->begin()), + processed(false) {} + + /// Scope for the known values. + ScopedMapTy::ScopeTy scope; + + DominanceInfoNode *node; + DominanceInfoNode::iterator childIterator; + + /// If this node has been fully processed yet or not. + bool processed; + }; + + /// Attempt to eliminate a redundant operation. Returns success if the + /// operation was marked for removal, failure otherwise. + LogicalResult simplifyOperation(ScopedMapTy &knownValues, Operation *op); + + void simplifyBlock(ScopedMapTy &knownValues, DominanceInfo &domInfo, + Block *bb); + void simplifyRegion(ScopedMapTy &knownValues, DominanceInfo &domInfo, + Region ®ion); + + void cleanupBlock(Block *bb) { + for (auto &inst : *bb) { + if (fir::nonVolatileLoad(&inst) || fir::pureCall(&inst)) { + inst.removeAttr(Identifier::get("effects_token", inst.getContext())); + } else if (inst.getNumRegions()) { + for (auto ®ion : inst.getRegions()) + cleanupRegion(region); + } + } + } + void cleanupRegion(Region ®ion) { + for (auto &block : region) + cleanupBlock(&block); + } + + void runOnFunction() override; + +private: + /// Operations marked as dead and to be erased. + std::vector opsToErase; +}; + +/// Attempt to eliminate a redundant operation. +LogicalResult BasicCSE::simplifyOperation(ScopedMapTy &knownValues, + Operation *op) { + // Don't simplify operations with nested blocks. We don't currently model + // equality comparisons correctly among other things. It is also unclear + // whether we would want to CSE such operations. + if (op->getNumRegions() != 0) + return failure(); + + if (!MemoryEffectOpInterface::hasNoEffect(op) && !fir::nonVolatileLoad(op) && + !fir::pureCall(op)) + return failure(); + + // If the operation is already trivially dead just add it to the erase list. + if (isOpTriviallyDead(op)) { + opsToErase.push_back(op); + return success(); + } + + // Look for an existing definition for the operation. + if (auto *existing = knownValues.lookup(op)) { + // If we find one then replace all uses of the current operation with the + // existing one and mark it for deletion. + op->replaceAllUsesWith(existing); + if (op->isKnownNonTerminator()) + opsToErase.push_back(op); + + // If the existing operation has an unknown location and the current + // operation doesn't, then set the existing op's location to that of the + // current op. + if (existing->getLoc().isa() && + !op->getLoc().isa()) { + existing->setLoc(op->getLoc()); + } + return success(); + } + + // Otherwise, we add this operation to the known values map. + knownValues.insert(op, op); + return failure(); +} + +void BasicCSE::simplifyBlock(ScopedMapTy &knownValues, DominanceInfo &domInfo, + Block *bb) { + std::intptr_t token = reinterpret_cast(bb); + for (auto &inst : *bb) { + if (fir::nonVolatileLoad(&inst) || fir::pureCall(&inst)) + inst.setAttr("effects_token", + IntegerAttr::get(IndexType::get(inst.getContext()), token)); + if (dyn_cast(&inst) || fir::impureCall(&inst)) + token = reinterpret_cast(&inst); + } + for (auto &inst : *bb) { + // If the operation is simplified, we don't process any held regions. + if (succeeded(simplifyOperation(knownValues, &inst))) + continue; + + // If this operation is isolated above, we can't process nested regions with + // the given 'knownValues' map. This would cause the insertion of implicit + // captures in explicit capture only regions. + if (!inst.isRegistered() || inst.isKnownIsolatedFromAbove()) { + ScopedMapTy nestedKnownValues; + for (auto ®ion : inst.getRegions()) + simplifyRegion(nestedKnownValues, domInfo, region); + continue; + } + + // Otherwise, process nested regions normally. + for (auto ®ion : inst.getRegions()) + simplifyRegion(knownValues, domInfo, region); + } +} + +void BasicCSE::simplifyRegion(ScopedMapTy &knownValues, DominanceInfo &domInfo, + Region ®ion) { + // If the region is empty there is nothing to do. + if (region.empty()) + return; + + // If the region only contains one block, then simplify it directly. + if (std::next(region.begin()) == region.end()) { + ScopedMapTy::ScopeTy scope(knownValues); + simplifyBlock(knownValues, domInfo, ®ion.front()); + return; + } + + // Note, deque is being used here because there was significant performance + // gains over vector when the container becomes very large due to the + // specific access patterns. If/when these performance issues are no + // longer a problem we can change this to vector. For more information see + // the llvm mailing list discussion on this: + // http://lists.llvm.org/pipermail/llvm-commits/Week-of-Mon-20120116/135228.html + std::deque> stack; + + // Process the nodes of the dom tree for this region. + stack.emplace_back(std::make_unique( + knownValues, domInfo.getRootNode(®ion))); + + while (!stack.empty()) { + auto ¤tNode = stack.back(); + + // Check to see if we need to process this node. + if (!currentNode->processed) { + currentNode->processed = true; + simplifyBlock(knownValues, domInfo, currentNode->node->getBlock()); + } + + // Otherwise, check to see if we need to process a child node. + if (currentNode->childIterator != currentNode->node->end()) { + auto *childNode = *(currentNode->childIterator++); + stack.emplace_back( + std::make_unique(knownValues, childNode)); + } else { + // Finally, if the node and all of its children have been processed + // then we delete the node. + stack.pop_back(); + } + } +} + +void BasicCSE::runOnFunction() { + if (disableCSE) + return; + + /// A scoped hash table of defining operations within a function. + { + ScopedMapTy knownValues; + simplifyRegion(knownValues, getAnalysis(), + getFunction().getBody()); + } + if (!leaveEffects) { + cleanupRegion(getFunction().getBody()); + } + + // If no operations were erased, then we mark all analyses as preserved. + if (opsToErase.empty()) + return markAllAnalysesPreserved(); + + /// Erase any operations that were marked as dead during simplification. + for (auto *op : opsToErase) + op->erase(); + opsToErase.clear(); + + // We currently don't remove region operations, so mark dominance as + // preserved. + markAnalysesPreserved(); +} + +} // end anonymous namespace + +std::unique_ptr> fir::createCSEPass() { + return std::make_unique(); +} + +static PassRegistration + pass("basiccse", "Eliminate common sub-expressions in functions"); diff --git a/flang/lib/Optimizer/Transforms/MemToReg.cpp b/flang/lib/Optimizer/Transforms/MemToReg.cpp new file mode 100644 index 0000000000000..a65973a70216c --- /dev/null +++ b/flang/lib/Optimizer/Transforms/MemToReg.cpp @@ -0,0 +1,761 @@ +//===-- MemToReg.cpp -- convert mem to reg SSA form -----------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Analysis/IteratedDominanceFrontier.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Analysis/Dominance.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/Pass/Pass.h" +#include "llvm/ADT/ArrayRef.h" +#include "llvm/ADT/SmallVector.h" +#include +#include + +using namespace fir; + +using DominatorTree = mlir::DominanceInfo; + +static llvm::cl::opt + disableMemToReg("disable-mem2reg", + llvm::cl::desc("disable memory to register pass"), + llvm::cl::init(false), llvm::cl::Hidden); + +/// A generalized version of a mem-to-reg pass suitable for use with an MLIR +/// dialect. This code was ported from the LLVM project. MLIR differs with its +/// use of block arguments rather than PHI nodes, etc. + +namespace { + +template +bool isAllocaPromotable(ALLOCA &ae) { + for (auto &use : ae.getResult().getUses()) { + auto *op = use.getOwner(); + if (auto load = mlir::dyn_cast(op)) { + // do nothing + } else if (auto stor = mlir::dyn_cast(op)) { + if (stor.getOperand(0).getDefiningOp() == op) { + return false; + } + } else { + return false; + } + } + return true; +} + +template +struct AllocaInfo { + llvm::SmallVector definingBlocks; + llvm::SmallVector usingBlocks; + + mlir::Operation *onlyStore; + mlir::Block *onlyBlock; + bool onlyUsedInOneBlock; + + void clear() { + definingBlocks.clear(); + usingBlocks.clear(); + onlyStore = nullptr; + onlyBlock = nullptr; + onlyUsedInOneBlock = true; + } + + /// Scan the uses of the specified alloca, filling in the AllocaInfo used + /// by the rest of the pass to reason about the uses of this alloca. + void analyzeAlloca(ALLOCA &AI) { + clear(); + + // As we scan the uses of the alloca instruction, keep track of stores, + // and decide whether all of the loads and stores to the alloca are within + // the same basic block. + for (auto UI = AI.getResult().use_begin(), E = AI.getResult().use_end(); + UI != E;) { + auto *User = UI->getOwner(); + UI++; + + if (auto SI = mlir::dyn_cast(User)) { + // Remember the basic blocks which define new values for the alloca + definingBlocks.push_back(SI.getOperation()->getBlock()); + onlyStore = SI.getOperation(); + } else { + auto LI = mlir::cast(User); + // Otherwise it must be a load instruction, keep track of variable + // reads. + usingBlocks.push_back(LI.getOperation()->getBlock()); + } + + if (onlyUsedInOneBlock) { + if (!onlyBlock) + onlyBlock = User->getBlock(); + else if (onlyBlock != User->getBlock()) + onlyUsedInOneBlock = false; + } + } + } +}; + +struct RenamePassData { + using ValVector = std::vector; + + RenamePassData(mlir::Block *b, mlir::Block *p, const ValVector &v) + : BB(b), Pred(p), Values(v) {} + RenamePassData(RenamePassData &&) = default; + RenamePassData &operator=(RenamePassData &&) = delete; + RenamePassData(const RenamePassData &) = delete; + RenamePassData &operator=(const RenamePassData &) = delete; + ~RenamePassData() = default; + + mlir::Block *BB; + mlir::Block *Pred; + ValVector Values; +}; + +template +struct LargeBlockInfo { + using INMap = llvm::DenseMap; + INMap instNumbers; + + static bool isInterestingInstruction(mlir::Operation &I) { + if (mlir::isa(I)) { + if (auto op = I.getOperand(0).getDefiningOp()) + return mlir::isa(op); + } else if (mlir::isa(I)) { + if (auto op = I.getOperand(1).getDefiningOp()) + return mlir::isa(op); + } + return false; + } + + template + unsigned getInstructionIndex(A &op) { + auto *oper = op.getOperation(); + + // has it already been numbered? + INMap::iterator it = instNumbers.find(oper); + if (it != instNumbers.end()) + return it->second; + + // No. search for the oper + auto *block = oper->getBlock(); + unsigned num = 0u; + for (auto &o : block->getOperations()) + if (isInterestingInstruction(o)) + instNumbers[&o] = num++; + + it = instNumbers.find(oper); + assert(it != instNumbers.end() && "operation not in block?"); + return it->second; + } + + template + void deleteValue(A &op) { + auto *oper = op.getOperation(); + instNumbers.erase(oper); + } + + void clear() { instNumbers.clear(); } +}; + +template +struct MemToReg + : public mlir::FunctionPass> { + explicit MemToReg() {} + + std::vector allocas; + DominatorTree *domTree = nullptr; + mlir::OpBuilder *builder = nullptr; + + /// Contains a stable numbering of basic blocks to avoid non-determinstic + /// behavior. + llvm::DenseMap BBNumbers; + llvm::DenseMap bbInitialArgs; + + /// Reverse mapping of Allocas. + llvm::DenseMap allocaLookup; + + /// The set of basic blocks the renamer has already visited. + llvm::SmallPtrSet Visited; + + llvm::DenseMap, unsigned> + BlockArgs; + llvm::DenseMap, unsigned> argToAllocaMap; + + bool rewriteSingleStoreAlloca(ALLOCA &AI, + AllocaInfo &Info, + LargeBlockInfo &LBI) { + STORE onlyStore(mlir::cast(Info.onlyStore)); + mlir::Block *StoreBB = Info.onlyStore->getBlock(); + int StoreIndex = -1; + + // Clear out usingBlocks. We will reconstruct it here if needed. + Info.usingBlocks.clear(); + + for (auto UI = AI.getResult().use_begin(), E = AI.getResult().use_end(); + UI != E;) { + auto *UserInst = UI->getOwner(); + UI++; + + if (mlir::dyn_cast(UserInst)) + continue; + + auto LI = mlir::cast(UserInst); + + // Okay, if we have a load from the alloca, we want to replace it with the + // only value stored to the alloca. We can do this if the value is + // dominated by the store. If not, we use the rest of the MemToReg + // machinery to insert the phi nodes as needed. + if (LI.getOperation()->getBlock() == StoreBB) { + // If we have a use that is in the same block as the store, compare + // the indices of the two instructions to see which one came first. If + // the load came before the store, we can't handle it. + if (StoreIndex == -1) + StoreIndex = LBI.getInstructionIndex(onlyStore); + + if (unsigned(StoreIndex) > LBI.getInstructionIndex(LI)) { + // Can't handle this load, bail out. + Info.usingBlocks.push_back(StoreBB); + continue; + } + } else if (!domTree->dominates(StoreBB, LI.getOperation()->getBlock())) { + // If the load and store are in different blocks, use BB dominance to + // check their relationships. If the store doesn't dom the use, bail + // out. + Info.usingBlocks.push_back(LI.getOperation()->getBlock()); + continue; + } + + // Otherwise, we *can* safely rewrite this load. + mlir::Value replVal = onlyStore.getOperand(0); + // If the replacement value is the load, this must occur in unreachable + // code. + if (replVal == LI.getResult()) + replVal = builder->create(LI.getLoc(), LI.getType()); + + LI.replaceAllUsesWith(replVal); + LI.erase(); + LBI.deleteValue(LI); + } + + // Finally, after the scan, check to see if the store is all that is left. + if (!Info.usingBlocks.empty()) + return false; // If not, we'll have to fall back for the remainder. + + // Remove the (now dead) store and alloca. + Info.onlyStore->erase(); + + AI.erase(); + return true; + } + + bool promoteSingleBlockAlloca(ALLOCA &AI, + AllocaInfo &Info, + LargeBlockInfo &LBI) { + // Walk the use-def list of the alloca, getting the locations of all stores. + using StoresByIndexTy = + llvm::SmallVector, 64>; + StoresByIndexTy storesByIndex; + + for (auto U = AI.getResult().use_begin(), E = AI.getResult().use_end(); + U != E; U++) + if (STORE SI = mlir::dyn_cast(U->getOwner())) + storesByIndex.emplace_back(LBI.getInstructionIndex(SI), + SI.getOperation()); + + // Sort the stores by their index, making it efficient to do a lookup with a + // binary search. + llvm::sort(storesByIndex, llvm::less_first()); + + // Walk all of the loads from this alloca, replacing them with the nearest + // store above them, if any. + for (auto UI = AI.getResult().use_begin(), E = AI.getResult().use_end(); + UI != E;) { + auto LI = mlir::dyn_cast(UI->getOwner()); + UI++; + if (!LI) + continue; + + unsigned LoadIdx{LBI.getInstructionIndex(LI)}; + + // Find the nearest store that has a lower index than this load. + typename StoresByIndexTy::iterator I = llvm::lower_bound( + storesByIndex, + std::make_pair(LoadIdx, static_cast(nullptr)), + llvm::less_first()); + if (I == storesByIndex.begin()) { + if (storesByIndex.empty()) { + // If there are no stores, the load takes the undef value. + auto undef = builder->create(LI.getLoc(), LI.getType()); + LI.replaceAllUsesWith(undef.getResult()); + } else { + // There is no store before this load, bail out (load may be affected + // by the following stores - see main comment). + return false; + } + } else { + // Otherwise, there was a store before this load, the load takes its + // value. Note, if the load was marked as nonnull we don't want to lose + // that information when we erase it. So we preserve it with an assume. + mlir::Value replVal = std::prev(I)->second->getOperand(0); + + // If the replacement value is the load, this must occur in unreachable + // code. + if (replVal == LI) + replVal = builder->create(LI.getLoc(), LI.getType()); + + LI.replaceAllUsesWith(replVal); + } + + LI.erase(); + LBI.deleteValue(LI); + } + + // Remove the (now dead) stores and alloca. + while (!AI.use_empty()) { + auto ae = AI.getResult(); + for (auto ai = ae.user_begin(), E = ae.user_end(); ai != E; ai++) + if (STORE si = mlir::dyn_cast(*ai)) { + si.erase(); + LBI.deleteValue(si); + } + } + + AI.erase(); + return true; + } + + void + computeLiveInBlocks(ALLOCA &ae, AllocaInfo &Info, + const llvm::SmallPtrSetImpl &DefBlocks, + llvm::SmallPtrSetImpl &liveInBlks) { + auto *AI = ae.getOperation(); + // To determine liveness, we must iterate through the predecessors of blocks + // where the def is live. Blocks are added to the worklist if we need to + // check their predecessors. Start with all the using blocks. + llvm::SmallVector LiveInBlockWorklist( + Info.usingBlocks.begin(), Info.usingBlocks.end()); + + // If any of the using blocks is also a definition block, check to see if + // the definition occurs before or after the use. If it happens before the + // use, the value isn't really live-in. + for (std::size_t i = 0, e{LiveInBlockWorklist.size()}; i != e; ++i) { + mlir::Block *BB = LiveInBlockWorklist[i]; + if (!DefBlocks.count(BB)) + continue; + + // Okay, this is a block that both uses and defines the value. If the + // first reference to the alloca is a def (store), then we know it isn't + // live-in. + for (mlir::Block::iterator I = BB->begin();; ++I) { + if (STORE SI = mlir::dyn_cast(I)) { + if (SI.getOperand(1).getDefiningOp() != AI) + continue; + + // We found a store to the alloca before a load. The alloca is not + // actually live-in here. + LiveInBlockWorklist[i] = LiveInBlockWorklist.back(); + LiveInBlockWorklist.pop_back(); + --i; + --e; + break; + } + + if (auto LI = mlir::dyn_cast(I)) + // Okay, we found a load before a store to the alloca. It is actually + // live into this block. + if (LI.getOperand().getDefiningOp() == AI) + break; + } + } + + // Now that we have a set of blocks where the phi is live-in, recursively + // add their predecessors until we find the full region the value is live. + while (!LiveInBlockWorklist.empty()) { + mlir::Block *BB = LiveInBlockWorklist.pop_back_val(); + + // The block really is live in here, insert it into the set. If already + // in the set, then it has already been processed. + if (!liveInBlks.insert(BB).second) + continue; + + // Since the value is live into BB, it is either defined in a predecessor + // or live into it to. Add the preds to the worklist unless they are a + // defining block. + for (mlir::Block *P : BB->getPredecessors()) { + // The value is not live into a predecessor if it defines the value. + if (DefBlocks.count(P)) + continue; + + // Otherwise it is, add to the worklist. + LiveInBlockWorklist.push_back(P); + } + } + } + + bool addBlockArgument(mlir::Block *BB, ALLOCA &Alloca, unsigned allocaNum) { + auto *ae = Alloca.getOperation(); + auto key = std::make_pair(BB, ae); + auto argNoIter = BlockArgs.find(key); + if (argNoIter != BlockArgs.end()) + return false; + auto argNo = BB->getNumArguments(); + BB->addArgument(Alloca.getAllocatedType()); + BlockArgs[key] = argNo; + argToAllocaMap[std::make_pair(BB, argNo)] = allocaNum; + return true; + } + + template + void initOperands(std::vector &opers, mlir::Location &&loc, + mlir::Block *dest, unsigned size, unsigned ai, + mlir::Value val, A &&oldOpers) { + unsigned i = 0; + for (auto v : oldOpers) + opers[i++] = v; + + // we must fill additional args with temporary undef values + for (; i < size; ++i) { + if (i == ai) + continue; + auto opTy = dest->getArgument(i).getType(); + auto typedUndef = builder->create(loc, opTy); + opers[i] = typedUndef; + } + opers[ai] = val; + } + + static void eraseIfNoUse(mlir::Value val) { + if (val.use_begin() == val.use_end()) { + val.getDefiningOp()->erase(); + } + } + + /// Set the incoming value on the branch side for the `ai`th block argument + void setParam(mlir::Block *blk, unsigned ai, mlir::Value val, + mlir::Block *target, unsigned size) { + auto *term = blk->getTerminator(); + if (auto br = mlir::dyn_cast(term)) { + if (br.getNumOperands() <= ai) { + // construct a new BranchOp to replace term + std::vector opers(size); + auto *dest = br.getDest(); + builder->setInsertionPoint(term); + initOperands(opers, br.getLoc(), dest, size, ai, val, br.getOperands()); + builder->create(br.getLoc(), dest, opers); + br.erase(); + } else { + auto oldParam = br.getOperand(ai); + br.setOperand(ai, val); + eraseIfNoUse(oldParam); + } + } else if (auto cond = mlir::dyn_cast(term)) { + if (target == cond.getTrueDest()) { + if (cond.getNumTrueOperands() <= ai) { + // construct a new CondBranchOp to replace term + std::vector opers(size); + auto *dest = cond.getTrueDest(); + builder->setInsertionPoint(term); + initOperands(opers, cond.getLoc(), dest, size, ai, val, + cond.getTrueOperands()); + auto c = cond.getCondition(); + auto *othDest = cond.getFalseDest(); + auto othOpers = cond.falseDestOperands(); + builder->create(cond.getLoc(), c, dest, opers, + othDest, othOpers); + cond.erase(); + } else { + auto oldParam = cond.getTrueOperand(ai); + cond.setTrueOperand(ai, val); + eraseIfNoUse(oldParam); + } + } else { + if (cond.getNumFalseOperands() <= ai) { + // construct a new CondBranchOp to replace term + std::vector opers(size); + auto *dest = cond.getFalseDest(); + builder->setInsertionPoint(term); + initOperands(opers, cond.getLoc(), dest, size, ai, val, + cond.getFalseOperands()); + auto c = cond.getCondition(); + auto *othDest = cond.getTrueDest(); + auto othOpers = cond.trueDestOperands(); + builder->create(cond.getLoc(), c, othDest, + othOpers, dest, opers); + cond.erase(); + } else { + auto oldParam = cond.getFalseOperand(ai); + cond.setFalseOperand(ai, val); + eraseIfNoUse(oldParam); + } + } + } else { + assert(false && "unhandled terminator"); + } + } + + inline static void addValue(RenamePassData::ValVector &vector, + RenamePassData::ValVector::size_type size, + mlir::Value value) { + if (vector.size() < size + 1) + vector.resize(size + 1); + vector[size] = value; + } + + /// Recursively traverse the CFG of the function, renaming loads and + /// stores to the allocas which we are promoting. + /// + /// IncomingVals indicates what value each Alloca contains on exit from the + /// predecessor block Pred. + void renamePass(mlir::Block *BB, mlir::Block *Pred, + RenamePassData::ValVector &IncomingVals, + std::vector &Worklist) { + NextIteration: + // Does this block take arguments? + const auto aiEnd = BB->getNumArguments(); + if ((!BB->hasNoPredecessors()) && (aiEnd > bbInitialArgs[BB])) { + // add the values from block `Pred` to the argument list in the proper + // positions + for (std::remove_const_t ai = 0; ai != aiEnd; ++ai) { + auto iter = argToAllocaMap.find(std::make_pair(BB, ai)); + if (iter == argToAllocaMap.end()) + continue; + auto allocaNo = iter->second; + auto offset = bbInitialArgs[BB]; + setParam(Pred, ai + offset, IncomingVals[allocaNo], BB, aiEnd + offset); + // use the block argument, not the live def in the pred block + addValue(IncomingVals, allocaNo, BB->getArgument(ai + offset)); + } + } + + // Don't revisit blocks. + if (!Visited.insert(BB).second) + return; + + mlir::Block::iterator II = BB->begin(); + while (true) { + if (II == BB->end()) + break; + mlir::Operation &opn = *II; + II++; + + if (auto LI = mlir::dyn_cast(opn)) { + auto *srcOpn = LI.getOperand().getDefiningOp(); + if (!srcOpn) + continue; + + if (!mlir::dyn_cast(srcOpn)) + continue; + + llvm::DenseMap::iterator ai = + allocaLookup.find(srcOpn); + if (ai == allocaLookup.end()) + continue; + + // Anything using the load now uses the current value. + LI.replaceAllUsesWith(IncomingVals[ai->second]); + LI.erase(); + } else if (auto SI = mlir::dyn_cast(opn)) { + auto *dstOpn = SI.getOperand(1).getDefiningOp(); + if (!dstOpn) + continue; + + if (!mlir::dyn_cast(dstOpn)) + continue; + + llvm::DenseMap::iterator ai = + allocaLookup.find(dstOpn); + if (ai == allocaLookup.end()) + continue; + + // Delete this instruction and mark the name as the current holder of + // the value + unsigned allocaNo = ai->second; + addValue(IncomingVals, allocaNo, SI.getOperand(0)); + SI.erase(); + } + } + + // 'Recurse' to our successors. + auto I = BB->succ_begin(); + auto E = BB->succ_end(); + if (I == E) + return; + + // Keep track of the successors so we don't visit the same successor twice + llvm::SmallPtrSet VisitedSuccs; + + // Handle the first successor without using the worklist. + VisitedSuccs.insert(*I); + Pred = BB; + BB = *I; + ++I; + + for (; I != E; ++I) + if (VisitedSuccs.insert(*I).second) + Worklist.emplace_back(*I, Pred, IncomingVals); + goto NextIteration; + } + + void doPromotion() { + auto F = this->getFunction(); + std::vector aes; + AllocaInfo info; + LargeBlockInfo lbi; + ForwardIDFCalculator IDF(*domTree); + + assert(!allocas.empty()); + + for (std::size_t allocaNum = 0, End{allocas.size()}; allocaNum != End; + ++allocaNum) { + auto ae = allocas[allocaNum]; + assert(ae.template getParentOfType() == F); + if (ae.use_empty()) { + ae.erase(); + continue; + } + info.analyzeAlloca(ae); + builder->setInsertionPointToStart(&F.front()); + if (info.definingBlocks.size() == 1) + if (rewriteSingleStoreAlloca(ae, info, lbi)) + continue; + if (info.onlyUsedInOneBlock) + if (promoteSingleBlockAlloca(ae, info, lbi)) + continue; + + // If we haven't computed a numbering for the BB's in the function, do + // so now. + if (BBNumbers.empty()) { + unsigned id = 0; + for (auto &BB : F) { + BBNumbers[&BB] = id++; + bbInitialArgs[&BB] = BB.getNumArguments(); + } + } + + // Keep the reverse mapping of the 'Allocas' array for the rename pass. + allocaLookup[allocas[allocaNum].getOperation()] = allocaNum; + + // At this point, we're committed to promoting the alloca using IDF's, + // and the standard SSA construction algorithm. Determine which blocks + // need PHI nodes and see if we can optimize out some work by avoiding + // insertion of dead phi nodes. + + // Unique the set of defining blocks for efficient lookup. + llvm::SmallPtrSet defBlocks( + info.definingBlocks.begin(), info.definingBlocks.end()); + + // Determine which blocks the value is live in. These are blocks which + // lead to uses. + llvm::SmallPtrSet liveInBlks; + computeLiveInBlocks(ae, info, defBlocks, liveInBlks); + + // At this point, we're committed to promoting the alloca using IDF's, + // and the standard SSA construction algorithm. Determine which blocks + // need phi nodes and see if we can optimize out some work by avoiding + // insertion of dead phi nodes. + IDF.setLiveInBlocks(liveInBlks); + IDF.setDefiningBlocks(defBlocks); + llvm::SmallVector phiBlocks; + IDF.calculate(phiBlocks); + llvm::sort(phiBlocks, [this](mlir::Block *A, mlir::Block *B) { + return BBNumbers.find(A)->second < BBNumbers.find(B)->second; + }); + + for (mlir::Block *BB : phiBlocks) + addBlockArgument(BB, ae, allocaNum); + + aes.push_back(ae); + } + + std::swap(allocas, aes); + if (allocas.empty()) + return; + + lbi.clear(); + + // Set the incoming values for the basic block to be null values for all + // of the alloca's. We do this in case there is a load of a value that + // has not been stored yet. In this case, it will get this null value. + RenamePassData::ValVector values(allocas.size()); + for (std::size_t i = 0, e{allocas.size()}; i != e; ++i) + values[i] = builder->create(allocas[i].getLoc(), + allocas[i].getAllocatedType()); + + // Walks all basic blocks in the function performing the SSA rename + // algorithm and inserting the phi nodes we marked as necessary + std::vector renameWorklist; + renameWorklist.emplace_back(&F.front(), nullptr, values); + do { + RenamePassData rpd(std::move(renameWorklist.back())); + renameWorklist.pop_back(); + // renamePass may add new worklist entries. + renamePass(rpd.BB, rpd.Pred, rpd.Values, renameWorklist); + } while (!renameWorklist.empty()); + + // The renamer uses the Visited set to avoid infinite loops. Clear it + // now. + Visited.clear(); + + // Remove the allocas themselves from the function. + for (auto aa : allocas) { + mlir::Operation *A = aa.getOperation(); + // If there are any uses of the alloca instructions left, they must be + // in unreachable basic blocks that were not processed by walking the + // dominator tree. Just delete the users now. + if (!A->use_empty()) { + auto undef = builder->create(aa.getLoc(), aa.getType()); + aa.replaceAllUsesWith(undef.getResult()); + } + aa.erase(); + } + } + + /// run the MemToReg pass on the FIR dialect + void runOnFunction() override { + if (disableMemToReg) + return; + + auto f = this->getFunction(); + auto &entry = f.front(); + auto bldr = mlir::OpBuilder(f.getBody()); + + domTree = &this->template getAnalysis(); + builder = &bldr; + + while (true) { + allocas.clear(); + + for (auto &op : entry) + if (ALLOCA ae = mlir::dyn_cast(op)) + if (isAllocaPromotable(ae)) + allocas.push_back(ae); + + if (allocas.empty()) + break; + + doPromotion(); + } + + domTree = nullptr; + builder = nullptr; + } +}; + +} // namespace + +using MemToRegPass = + MemToReg; + +std::unique_ptr> fir::createMemToRegPass() { + return std::make_unique(); +} + +// Register the Mem To Reg pass +static mlir::PassRegistration + pass("mem-to-reg", "Conversion from mem to reg form"); diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp new file mode 100644 index 0000000000000..c9e2fb148f2cf --- /dev/null +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -0,0 +1,202 @@ +//===-- RewriteLoop.cpp ---------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Dialect/Affine/IR/AffineOps.h" +#include "mlir/Dialect/LoopOps/LoopOps.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Transforms/DialectConversion.h" +#include "llvm/Support/CommandLine.h" +#include + +/// disable FIR to affine dialect conversion +static llvm::cl::opt + disableAffinePromo("disable-affine-promotion", + llvm::cl::desc("disable FIR to Affine pass"), + llvm::cl::init(false)); + +/// disable FIR to loop dialect conversion +static llvm::cl::opt + disableLoopConversion("disable-loop-conversion", + llvm::cl::desc("disable FIR to Loop pass"), + llvm::cl::init(false)); + +namespace fir { +namespace { + +template +class OpRewrite : public mlir::RewritePattern { +public: + explicit OpRewrite(mlir::MLIRContext *ctx) + : RewritePattern(FROM::getOperationName(), 1, ctx) {} +}; + +/// Convert `fir.loop` to `affine.for` +class AffineLoopConv : public OpRewrite { +public: + using OpRewrite::OpRewrite; +}; + +/// Convert `fir.where` to `affine.if` +class AffineWhereConv : public OpRewrite { +public: + using OpRewrite::OpRewrite; +}; + +/// Promote fir.loop and fir.where to affine.for and affine.if, in the cases +/// where such a promotion is possible. +class AffineDialectPromotion + : public mlir::FunctionPass { +public: + void runOnFunction() override { + if (disableAffinePromo) + return; + + auto *context = &getContext(); + mlir::OwningRewritePatternList patterns; + patterns.insert(context); + mlir::ConversionTarget target = *context; + target.addLegalDialect(); + // target.addDynamicallyLegalOp(); + + // apply the patterns + if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, + std::move(patterns)))) { + mlir::emitError(mlir::UnknownLoc::get(context), + "error in converting to affine dialect\n"); + signalPassFailure(); + } + } +}; + +// Conversion to the MLIR loop dialect +// +// FIR loops that cannot be converted to the affine dialect will remain as +// `fir.loop` operations. These can be converted to `loop.for` operations. MLIR +// includes a pass to lower `loop.for` operations to a CFG. + +/// Convert `fir.loop` to `loop.for` +class LoopLoopConv : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(LoopOp loop, mlir::PatternRewriter &rewriter) const override { + auto loc = loop.getLoc(); + auto low = loop.getLowerBoundOperand(); + if (!low) { + assert(loop.constantLowerBound().hasValue()); + auto lb = *loop.constantLowerBound(); + low = rewriter.create(loc, lb.getSExtValue()); + } + auto high = loop.getUpperBoundOperand(); + if (!high) { + assert(loop.constantUpperBound().hasValue()); + auto ub = *loop.constantUpperBound(); + high = rewriter.create(loc, ub.getSExtValue()); + } + auto step = loop.getStepOperand(); + if (!step) { + if (loop.constantStep().hasValue()) { + auto st = *loop.constantStep(); + step = rewriter.create(loc, st.getSExtValue()); + } else { + step = rewriter.create(loc, 1); + } + } + assert(low && high && step); + // ForOp has different bounds semantics. Adjust upper bound. + auto adjustUp = rewriter.create(loc, high, step); + auto f = rewriter.create(loc, low, adjustUp, step); + f.region().getBlocks().clear(); + rewriter.inlineRegionBefore(loop.region(), f.region(), f.region().end()); + rewriter.eraseOp(loop); + return success(); + } +}; + +/// Convert `fir.where` to `loop.if` +class LoopWhereConv : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(WhereOp where, + mlir::PatternRewriter &rewriter) const override { + auto loc = where.getLoc(); + bool hasOtherRegion = !where.otherRegion().empty(); + auto cond = where.condition(); + auto ifOp = rewriter.create(loc, cond, hasOtherRegion); + rewriter.inlineRegionBefore(where.whereRegion(), &ifOp.thenRegion().back()); + ifOp.thenRegion().back().erase(); + if (hasOtherRegion) { + rewriter.inlineRegionBefore(where.otherRegion(), + &ifOp.elseRegion().back()); + ifOp.elseRegion().back().erase(); + } + rewriter.eraseOp(where); + return success(); + } +}; + +/// Replace FirEndOp with TerminatorOp +class LoopFirEndConv : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(FirEndOp op, mlir::PatternRewriter &rewriter) const override { + rewriter.replaceOpWithNewOp(op); + return success(); + } +}; + +/// Convert `fir.loop` and `fir.where` to `loop.for` and `loop.if`. +class LoopDialectConversion : public mlir::FunctionPass { +public: + void runOnFunction() override { + if (disableLoopConversion) + return; + + auto *context = &getContext(); + mlir::OwningRewritePatternList patterns; + patterns.insert(context); + mlir::ConversionTarget target = *context; + target.addLegalDialect(); + target.addIllegalOp(); + + // apply the patterns + if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, + std::move(patterns)))) { + mlir::emitError(mlir::UnknownLoc::get(context), + "error in converting to MLIR loop dialect\n"); + signalPassFailure(); + } + } +}; +} // namespace +} // namespace fir + +/// Convert FIR loop constructs to the Affine dialect +std::unique_ptr fir::createPromoteToAffinePass() { + return std::make_unique(); +} + +/// Convert `fir.loop` and `fir.where` to `loop.for` and `loop.if`. This +/// conversion enables the `createLowerToCFGPass` to transform these to CFG +/// form. +std::unique_ptr fir::createLowerToLoopPass() { + return std::make_unique(); +} diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt index 9e7c07b9c55fa..4583abc6411dd 100644 --- a/flang/lib/Semantics/CMakeLists.txt +++ b/flang/lib/Semantics/CMakeLists.txt @@ -1,3 +1,5 @@ +set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-parameter") + add_flang_library(FortranSemantics assignment.cpp attr.cpp diff --git a/flang/not-test/fir/addrof.1.fir b/flang/not-test/fir/addrof.1.fir new file mode 100644 index 0000000000000..75cc12a55eb11 --- /dev/null +++ b/flang/not-test/fir/addrof.1.fir @@ -0,0 +1,7 @@ +fir.global @var_x : !fir.int<4> {} + +func @getAddressOfX() -> !fir.ref> { + %1 = fir.address_of(@var_x) : !fir.ref> + return %1 : !fir.ref> +} + diff --git a/flang/not-test/fir/aggregate.fir b/flang/not-test/fir/aggregate.fir new file mode 100644 index 0000000000000..c65e38deadd5f --- /dev/null +++ b/flang/not-test/fir/aggregate.fir @@ -0,0 +1,11 @@ +func @f_tuple(%a : tuple) -> i64 { + %0 = constant 1 : i32 + %1 = fir.extract_value %a, %0 : (tuple, i32) -> i64 + return %1 : i64 +} + +func @f_record(%a : !fir.type) -> i64 { + %0 = fir.field_index fb, !fir.type + %1 = fir.extract_value %a, %0 : (!fir.type, !fir.field) -> i64 + return %1 : i64 +} diff --git a/flang/not-test/fir/alloc.fir b/flang/not-test/fir/alloc.fir new file mode 100644 index 0000000000000..e7c0d663c128b --- /dev/null +++ b/flang/not-test/fir/alloc.fir @@ -0,0 +1,21 @@ +func @f1() -> !fir.ref { + %1 = fir.alloca i32 + return %1 : !fir.ref +} + +func @f2() -> !fir.ref { + %0 = constant 100 : index + %1 = fir.alloca i32, %0 + return %1 : !fir.ref +} + +func @f3() -> !fir.heap { + %1 = fir.allocmem i32 + return %1 : !fir.heap +} + +func @f4() -> !fir.heap { + %0 = constant 100 : index + %1 = fir.allocmem i32, %0 + return %1 : !fir.heap +} diff --git a/flang/not-test/fir/arrayset.fir b/flang/not-test/fir/arrayset.fir new file mode 100644 index 0000000000000..2f45aabb0da73 --- /dev/null +++ b/flang/not-test/fir/arrayset.fir @@ -0,0 +1,16 @@ +func @x(%arr : !fir.ref>) { + %1 = constant 0 : index + %2 = constant 9 : index + %a = fir.alloca !fir.array<10xf32> + fir.loop %iv = %1 to %2 unordered { + %3 = fir.coordinate_of %arr, %iv : (!fir.ref>, index) -> !fir.ref + %4 = fir.load %3 : !fir.ref + %5 = fir.coordinate_of %a, %iv : (!fir.ref>, index) -> !fir.ref + fir.store %4 to %5 : !fir.ref + } { arrayset } + %6 = fir.embox %a : (!fir.ref>) -> !fir.box> + fir.call @y(%6) : (!fir.box>) -> () + return +} + +func @y(!fir.box>) -> () diff --git a/flang/not-test/fir/bugs/bug0001.fir b/flang/not-test/fir/bugs/bug0001.fir new file mode 100644 index 0000000000000..5535adb6d0e3a --- /dev/null +++ b/flang/not-test/fir/bugs/bug0001.fir @@ -0,0 +1,41 @@ +func @r_incr(%arg0: !fir.ref) -> f64 { + %0 = fir.alloca f64 {name = "r_incr"} : !fir.ref + %1 = fir.load %arg0 : !fir.ref + fir.store %1 to %0 : !fir.ref + %2 = fir.load %arg0 : !fir.ref + %cst = constant 1.000000e+00 : f64 + %3 = fir.addf %2, %cst : f64 + fir.store %3 to %arg0 : !fir.ref + %4 = fir.load %0 : !fir.ref + return %4 : f64 +} + +func @_MAIN() { + %0 = fir.alloca f64 {name = "y"} : !fir.ref + %1 = fir.alloca f64 {name = "y2"} : !fir.ref + %2 = fir.alloca f64 {name = "y1"} : !fir.ref + %3 = fir.alloca f64 {name = "x"} : !fir.ref + %cst = constant 1.000000e+00 : f64 + fir.store %cst to %3 : !fir.ref + %4 = fir.load %3 : !fir.ref + fir.store %4 to %2 : !fir.ref + %5 = fir.load %2 : !fir.ref + %6 = call @r_incr(%3) : (!fir.ref) -> f64 + %7 = fir.addf %5, %6 : f64 + fir.store %7 to %1 : !fir.ref + %8 = fir.load %1 : !fir.ref + %9 = fir.load %3 : !fir.ref + %10 = fir.addf %8, %9 : f64 + fir.store %10 to %0 : !fir.ref + %c1_i32 = constant 1 : i32 + %11 = call @__F18IOa_BeginExternalListOutput(%c1_i32) : (i32) -> !fir.ref + %12 = fir.load %0 : !fir.ref + call @__F18IOa_OutputReal64(%11, %12) : (!fir.ref, f64) -> () + call @__F18IOa_EndIOStatement(%11) : (!fir.ref) -> () + return +} + +func @__F18IOa_BeginExternalListOutput(i32) -> !fir.ref +func @__F18IOa_OutputInteger64(!fir.ref, i64) +func @__F18IOa_OutputReal64(!fir.ref, f64) +func @__F18IOa_EndIOStatement(!fir.ref) diff --git a/flang/not-test/fir/bugs/bug0002.fir b/flang/not-test/fir/bugs/bug0002.fir new file mode 100644 index 0000000000000..f163e76035e9c --- /dev/null +++ b/flang/not-test/fir/bugs/bug0002.fir @@ -0,0 +1,12 @@ +func @foo() -> f32 { + %0 = fir.alloca f32 {name = "foo"} : !fir.ref + %1 = fir.alloca f32 {name = "x"} : !fir.ref + %cst = constant 4.200000e+01 : f32 + fir.store %cst to %1 : !fir.ref + %cst_0 = constant 6.600000e+01 : f32 + fir.store %cst_0 to %1 : !fir.ref + %2 = fir.load %1 : !fir.ref + fir.store %2 to %0 : !fir.ref + %3 = fir.load %0 : !fir.ref + return %3 : f32 +} diff --git a/flang/not-test/fir/character.fir b/flang/not-test/fir/character.fir new file mode 100644 index 0000000000000..c4a11a607d7a0 --- /dev/null +++ b/flang/not-test/fir/character.fir @@ -0,0 +1,12 @@ + +fir.global @name constant : !fir.char<1> { + constant "Your name" + //constant 1 +} + +func @get_name() -> !fir.boxchar<1> { + %j1 = fir.address_of (@name_constant) : !fir.ref> + %j2 = constant 9 : i64 + %j3 = fir.emboxchar %j1, %j2 : (!fir.ref>, i64) -> !fir.boxchar<1> + return %j3 : !fir.boxchar<1> +} diff --git a/flang/not-test/fir/commute.fir b/flang/not-test/fir/commute.fir new file mode 100644 index 0000000000000..6e55bb0e36bee --- /dev/null +++ b/flang/not-test/fir/commute.fir @@ -0,0 +1,21 @@ +func @f1(%a : i32, %b : i32) -> i32 { + %1 = addi %a, %b : i32 + %2 = addi %b, %a : i32 + %3 = muli %1, %2 : i32 + return %3 : i32 +} + +func @f2(%a : !fir.ref) -> i32 { + %1 = fir.load %a : !fir.ref + %2 = fir.load %a : !fir.ref + %3 = addi %1, %2 : i32 + %4 = fir.load %a : !fir.ref + %5 = addi %3, %4 : i32 + %6 = fir.load %a : !fir.ref + %7 = addi %5, %6 : i32 + %8 = fir.load %a : !fir.ref + %9 = addi %7, %8 : i32 + %10 = fir.load %a : !fir.ref + %11 = addi %10, %9 : i32 + return %11 : i32 +} diff --git a/flang/not-test/fir/compare.fir b/flang/not-test/fir/compare.fir new file mode 100644 index 0000000000000..8aa9f6864dc18 --- /dev/null +++ b/flang/not-test/fir/compare.fir @@ -0,0 +1,29 @@ +func @cmp(%a : !fir.real<10>, %b : !fir.real<10>) -> i1 { + %1 = "fir.cmpf"(%a, %b) {predicate = 1} : (!fir.real<10>, !fir.real<10>) -> i1 + return %1 : i1 +} + +func @cmp2(%a : !fir.real<16>, %b : !fir.real<16>) -> i1 { + %1 = fir.cmpf "ult", %a, %b : !fir.real<16> + return %1 : i1 +} + +func @cmp3(%a : !fir.complex<4>, %b : !fir.complex<4>) -> i1 { + %1 = fir.cmpc "ueq", %a, %b : !fir.complex<4> + return %1 : i1 +} + +func @neg1(%a : !fir.real<8>) -> !fir.real<8> { + %1 = "fir.negf"(%a) : (!fir.real<8>) -> !fir.real<8> + return %1 : !fir.real<8> +} + +func @neg2(%a : !fir.real<8>) -> !fir.real<8> { + %1 = fir.negf %a : !fir.real<8> + return %1 : !fir.real<8> +} + +func @neg3(%a : !fir.complex<8>) -> !fir.complex<8> { + %1 = fir.negc %a : !fir.complex<8> + return %1 : !fir.complex<8> +} diff --git a/flang/not-test/fir/complex.fir b/flang/not-test/fir/complex.fir new file mode 100644 index 0000000000000..958baa430ff46 --- /dev/null +++ b/flang/not-test/fir/complex.fir @@ -0,0 +1,22 @@ +func @foo(%a : !fir.complex<4>, %b : !fir.complex<4>, %c : !fir.complex<4>, %d : !fir.complex<4>, %e : !fir.complex<4>) -> !fir.complex<4> { + %1 = fir.addc %a, %b : !fir.complex<4> + %2 = fir.mulc %1, %c : !fir.complex<4> + %3 = fir.subc %2, %d : !fir.complex<4> + %4 = fir.divc %3, %e : !fir.complex<4> + return %4 : !fir.complex<4> +} + +func @f2(%a : !fir.complex<4>) -> f32 { + %0 = constant 0 : i32 + %1 = fir.extract_value %a, %0 : (!fir.complex<4>, i32) -> f32 + return %1 : f32 +} + +func @f3(%a : !fir.complex<4>) -> !fir.complex<4> { + %0 = constant 1 : i32 + %1 = fir.extract_value %a, %0 : (!fir.complex<4>, i32) -> f32 + %2 = constant 0.0 : f32 + %3 = fir.subf %2, %1 : f32 + %4 = fir.insert_value %a, %3, %0 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + return %4 : !fir.complex<4> +} diff --git a/flang/not-test/fir/complex.mlir b/flang/not-test/fir/complex.mlir new file mode 100644 index 0000000000000..5a36992c95674 --- /dev/null +++ b/flang/not-test/fir/complex.mlir @@ -0,0 +1,6 @@ +func @add(%a : complex, %b : complex) -> complex + +func @foo(%a : complex, %b : complex) -> complex { + %1 = call @add(%a, %b) : (complex, complex) -> complex + return %1 : complex +} diff --git a/flang/not-test/fir/constant.fir b/flang/not-test/fir/constant.fir new file mode 100644 index 0000000000000..67ca40f36611a --- /dev/null +++ b/flang/not-test/fir/constant.fir @@ -0,0 +1,19 @@ +func @x() -> !fir.array<3x!fir.char<1>> { + %1 = fir.constant "xyz" : !fir.array<3x!fir.char<1>> + return %1 : !fir.array<3x!fir.char<1>> +} + +func @y() -> !fir.real<10> { + %1 = fir.constant "42.4" : !fir.real<10> + return %1 : !fir.real<10> +} + +func @z() -> !fir.logical<1> { + %1 = fir.constant "true" : !fir.logical<1> + return %1 : !fir.logical<1> +} + +func @z2() -> !fir.ref> { + %1 = fir.constant "abc" : !fir.ref> + return %1 : !fir.ref> +} diff --git a/flang/not-test/fir/dynlayout.fir b/flang/not-test/fir/dynlayout.fir new file mode 100644 index 0000000000000..5646db53975e8 --- /dev/null +++ b/flang/not-test/fir/dynlayout.fir @@ -0,0 +1,38 @@ +// dynamic case + +// dynamically sized type +func @_QQSIZEOF_a(%p1 : i64, %p2 : i64) -> i64 { + %c1 = constant 1 : i64 // sizeof CHARACTER(1) + %1 = muli %p1, %c1 : i64 + %c2 = constant 2 : i64 // sizeof CHARACTER(2) + %2 = muli %p2, %c2 : i64 + %3 = addi %1, %2 : i64 + return %3 : i64 +} + +func @_QQOFFSETOF_a_f1(%p1 : i64, %p2 : i64) -> i32 { + %0 = constant 0 : i64 + %1 = fir.convert %0 : (i64) -> i32 + return %1 : i32 +} + +func @_QQOFFSETOF_a_f2(%p1 : i64, %p2 : i64) -> i32 { + %c1 = constant 1 : i64 + %1 = muli %p1, %c1 : i64 + %2 = fir.convert %1 : (i64) -> i32 + return %2 : i32 +} + +// get 'a%f2(x)' +func @f(%a : !fir.box>, f2:!fir.array>}>>, %x : i32, %q1 : i64, %q2 : i64) -> !fir.char<2> { + %p1p = fir.len_param_index p1, !fir.type + %p2p = fir.len_param_index p2, !fir.type + %p1c = fir.coordinate_of %a, %p1p : (!fir.box>, !fir.len) -> !fir.ref + %p2c = fir.coordinate_of %a, %p2p : (!fir.box>, !fir.len) -> !fir.ref + %p1 = fir.load %p1c : !fir.ref + %p2 = fir.load %p2c : !fir.ref + %1 = fir.field_index f2, !fir.type(%p1, %p2) : i64, i64 + %2 = fir.coordinate_of %a, %1, %x : (!fir.box>, !fir.field, i32) -> !fir.ref> + %3 = fir.load %2 : !fir.ref> + return %3 : !fir.char<2> +} diff --git a/flang/not-test/fir/embox.fir b/flang/not-test/fir/embox.fir new file mode 100644 index 0000000000000..801e7241b4245 --- /dev/null +++ b/flang/not-test/fir/embox.fir @@ -0,0 +1,6 @@ +#x0 = (d0, d1) -> (d1, d0) + +func @f(%arg : !fir.ref>) { + %1 = fir.embox %arg [#x0] : (!fir.ref>) -> !fir.box, > + return +} diff --git a/flang/not-test/fir/fir-dt.fir b/flang/not-test/fir/fir-dt.fir new file mode 100644 index 0000000000000..7dbd6bd131879 --- /dev/null +++ b/flang/not-test/fir/fir-dt.fir @@ -0,0 +1,5 @@ +func @method_impl(!fir.box>) + +fir.dispatch_table @dispatch_tbl { + fir.dt_entry method, @method_impl +} diff --git a/flang/not-test/lower/expr-test-generator.cc b/flang/not-test/lower/expr-test-generator.cc new file mode 100644 index 0000000000000..a4f3a741bfb69 --- /dev/null +++ b/flang/not-test/lower/expr-test-generator.cc @@ -0,0 +1,692 @@ +//===-- test/lower/expr-test-generator.cc -----------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include +#include +#include +#include +#include +#include +#include + +// Utility to generate Fortran expression evaluation tests. +// Given an expression "x op y", this utility can generates +// functions that evaluate the expression and takes x and y +// as argument and return the result. +// The utility allows to describe fortran intrinsic operations +// and their possible operand types in a table driven way. +// Functions to test all possible intrinsic operations can then be +// generated. +// The utility can also generate a driver function that calls the +// previous and compare the results with expectations +// (currently provided by calling a similar function compiled by a reference +// compiler). + +// TODO: Integrate with f18 libs to remove redundancies ? +// TODO: How could Peter's intrinsic table be used to generate +// intrinsic expression tests in a similar way ? + +enum class TypeCategory { Integer, Real, Complex, Logical, Character }; + +struct Type { + constexpr Type(TypeCategory c) : cat{c}, kind{} {} + constexpr Type(TypeCategory c, int k) : cat{c}, kind{k} {} + bool operator==(const Type &that) const { + return cat == that.cat && kind == that.kind; + } + bool operator!=(const Type &that) const { return !(*this == that); } + std::ostream &Dump(std::ostream &s) const { + switch (cat) { + case TypeCategory::Integer: s << "INTEGER"; break; + case TypeCategory::Real: s << "REAL"; break; + case TypeCategory::Logical: s << "LOGICAL"; break; + case TypeCategory::Complex: s << "COMPLEX"; break; + case TypeCategory::Character: s << "CHARACTER"; break; + } + if (kind) { + s << "(" << *kind << ")"; + } + return s; + } + + TypeCategory cat; + std::optional kind; // none = default +}; + +static constexpr Type DefaultReal{TypeCategory::Real}; +static constexpr Type Real4{TypeCategory::Real, 4}; +static constexpr Type Real8{TypeCategory::Real, 8}; +static constexpr Type DefaultInteger{TypeCategory::Integer}; +static constexpr Type Integer1{TypeCategory::Integer, 1}; +static constexpr Type Integer2{TypeCategory::Integer, 2}; +static constexpr Type Integer4{TypeCategory::Integer, 4}; +static constexpr Type Integer8{TypeCategory::Integer, 8}; +static constexpr Type DefaultComplex{TypeCategory::Complex}; +static constexpr Type Complex4{TypeCategory::Complex, 4}; +static constexpr Type Complex8{TypeCategory::Complex, 4}; +static constexpr Type DefaultLogical{TypeCategory::Logical}; +// Currently other types are not testable because existing Fortran +// compilers do not provide these types. + +enum class TypePattern { + OperandNumeric, + OperandLogical, + OperandComparable, + OperandOrdered +}; +enum class Constraint { None, NonZeroRHS, NoNegativeLHSWhenRealRHS }; + +struct Operation { + bool IsUnaryOp() const { return isUnaryOp; } + std::optional GetResultTypeForArguments(Type, Type) const; + std::optional GetResultTypeForArgument(Type) const; + const char *name; + const char *symbol; + TypePattern pattern; + Constraint constraint{Constraint::None}; + bool isUnaryOp{false}; +}; + +// Sorted by increasing precedence (not stricly increasing). See F2018 +// table 10.1. +static Operation operations[]{ + // TODO should be OK constexpr but g++ 8.2 not happy + // defined-binary-op cannot be described here. + {"eqv", ".EQV.", TypePattern::OperandLogical}, + {"neqv", ".NEQV.", TypePattern::OperandLogical}, + {"or", ".OR.", TypePattern::OperandLogical}, + {"and", ".AND.", TypePattern::OperandLogical}, + {"not", ".NOT.", TypePattern::OperandLogical, Constraint::None, true}, + {"eq", ".EQ.", TypePattern::OperandComparable}, + {"ne", ".NE.", TypePattern::OperandComparable}, + {"lt", ".LT.", TypePattern::OperandOrdered}, + {"le", ".LE.", TypePattern::OperandOrdered}, + {"gt", ".GT.", TypePattern::OperandOrdered}, + {"ge", ".GE.", TypePattern::OperandOrdered}, + // TODO: Concat + {"add", "+", TypePattern::OperandNumeric}, + {"sub", "-", TypePattern::OperandNumeric}, + {"minus", "-", TypePattern::OperandNumeric, Constraint::None, true}, + {"plus", "+", TypePattern::OperandNumeric, Constraint::None, true}, + {"mult", "*", TypePattern::OperandNumeric}, + {"div", "/", TypePattern::OperandNumeric, Constraint::NonZeroRHS}, + {"power", "**", TypePattern::OperandNumeric, + Constraint::NoNegativeLHSWhenRealRHS}, // TODO: check power pattern + // defined-unary-op cannot be described here. +}; + +static bool IsLogical(const Type t) { return t.cat == TypeCategory::Logical; } +static bool IsCharacter(const Type t) { + return t.cat == TypeCategory::Character; +} +static bool IsComplex(const Type t) { return t.cat == TypeCategory::Complex; } +static bool IsReal(const Type t) { return t.cat == TypeCategory::Real; } + +static bool IsOrderedNumeric(const Type t) { + return t.cat == TypeCategory::Real || t.cat == TypeCategory::Integer; +} + +static bool IsNumeric(const Type t) { + return t.cat == TypeCategory::Real || t.cat == TypeCategory::Integer || + t.cat == TypeCategory::Complex; +} + +std::optional Operation::GetResultTypeForArgument(Type t) const { + switch (pattern) { + case TypePattern::OperandNumeric: + if (IsNumeric(t)) { + return t; + } + break; + case TypePattern::OperandLogical: + if (IsLogical(t)) { + return t; + } + break; + case TypePattern::OperandComparable: + case TypePattern::OperandOrdered: + assert(false && "No unary comparisons"); + break; + } + return std::nullopt; +} + +static std::optional SelectBiggestKindForResult( + TypeCategory resultCat, Type lhs, Type rhs) { + if (!lhs.kind && !rhs.kind) { + return Type{resultCat}; + } else if (lhs.kind && rhs.kind) { + return Type{resultCat, std::max(*lhs.kind, *rhs.kind)}; + } else { + // Cannot know without more info about compiler what default compares to. + return std::nullopt; + } +} + +std::optional Operation::GetResultTypeForArguments( + Type lhs, Type rhs) const { + // See Fortran 2018 table 10.2 and section 10.1.9.3 + switch (pattern) { + case TypePattern::OperandNumeric: + if (!IsNumeric(rhs) || !IsNumeric(lhs)) { + return std::nullopt; + } + if (lhs.cat == rhs.cat) { + return SelectBiggestKindForResult(lhs.cat, lhs, rhs); + } + // different categories + if (IsComplex(lhs)) { + if (IsReal(rhs)) { + return SelectBiggestKindForResult(TypeCategory::Complex, lhs, rhs); + } + return lhs; + } + if (IsComplex(rhs)) { + if (IsReal(lhs)) { + return SelectBiggestKindForResult(TypeCategory::Complex, lhs, rhs); + } + return rhs; + } + if (IsReal(lhs)) { + // rhs must be integer + return lhs; + } + if (IsReal(rhs)) { + // lhs must be integer + return rhs; + } + assert(false && "no more operand cases"); + case TypePattern::OperandLogical: + if (IsLogical(rhs) && IsLogical(lhs)) { + return SelectBiggestKindForResult(TypeCategory::Logical, lhs, rhs); + } + break; + case TypePattern::OperandComparable: + if (IsNumeric(lhs) && IsNumeric(rhs)) { + return DefaultLogical; + } else if (IsCharacter(lhs) && IsCharacter(lhs) && lhs.kind == rhs.kind) { + return DefaultLogical; + } + break; + case TypePattern::OperandOrdered: + if (IsOrderedNumeric(lhs) && IsOrderedNumeric(rhs)) { + return DefaultLogical; + } else if (IsCharacter(lhs) && IsCharacter(lhs) && lhs.kind == rhs.kind) { + return DefaultLogical; + } + break; + } + return std::nullopt; +} + +// Test Plan Part + +// Only string list input for now +using Input = std::vector; +// TODO: more inputs method (e.g. random pick) + +enum class Eval { Constant, Dynamic }; +struct TestPlan { + std::vector operationToTests; + std::vector> inputs; + Eval referenceEvaluationMethod{Eval::Dynamic}; + Eval testEvaluationMethod{Eval::Dynamic}; +}; + +static inline std::string IndexedName(const char *name, std::size_t index) { + return std::string{name} + std::to_string(index); +} + +static constexpr auto passedName{"passed"}; +static constexpr auto failedName{"failed"}; + +struct CodeGenerator { + static constexpr auto varNameBase{"x"}; + static constexpr auto paramNameBase{"a"}; + static constexpr auto loopIndexNameBase{"i"}; + static constexpr auto testResultName{"test_res"}; + static constexpr auto refResultName{"ref_res"}; + + template + void GenerateEvaluationFunction( + const std::string &functionName, std::ostream &s) const { + GenerateEvaluationFunctionStmtAndSpec(functionName, s); + GenerateExpressionEvaluation(functionName, s); + s << "END FUNCTION" << std::endl; + s << std::endl; + } + + void GenerateEvaluationFunction(const std::string &functionNameBase, + std::ostream &s, Eval ev, bool isReference) const { + auto functionName{isReference ? GetReferenceFunctionName(functionNameBase) + : GetTestFunctionName(functionNameBase)}; + switch (ev) { + case Eval::Constant: + GenerateEvaluationFunction(functionName, s); + break; + case Eval::Dynamic: + GenerateEvaluationFunction(functionName, s); + break; + } + } + + void GenerateDriverSubroutine(const std::string &functionNameBase, + std::ostream &s, Eval refEval, Eval testEval) const { + s << "SUBROUTINE " << GetDriverName(functionNameBase) << "(" << passedName + << ", " << failedName << ")" << std::endl; + std::size_t numInputs{inputs.size()}; + assert(numInputs > 0 && "Expected non empty inputs in driver"); + if (refEval == Eval::Dynamic || testEval == Eval::Dynamic) { + // Inputs are required inside the driver only if one evaluation function + // is dynamic and inputs need to be passed to it from the driver. + for (std::size_t i{0}; i < numInputs; ++i) { + GenerateInputAsArrayParameter(i, s); + } + } + s << "INTEGER :: " << passedName << ", " << failedName << std::endl; + resultType.Dump(s) << " :: " << testResultName << ", " << refResultName + << std::endl; + + // TODO: Add a test number limit in cases there are many inputs ? This would + // need to be kept in sync with folding evaluation. + for (std::size_t i{0}; i < numInputs; ++i) { + s << "DO " << IndexedName(loopIndexNameBase, i) << " = 1," + << inputs[i]->second.size() << std::endl; + } + + // TODO: Handle constraints (e.g divide by zero). Would also need to be kept + // in sync with folding evaluation. + s << refResultName << " = "; + auto refFuncName{GetReferenceFunctionName(functionNameBase)}; + switch (refEval) { + case Eval::Dynamic: + GenerateEvaluationFunctionCall(refFuncName, s); + break; + case Eval::Constant: + GenerateEvaluationFunctionCall(refFuncName, s); + break; + } + s << testResultName << " = "; + auto testFuncName{GetTestFunctionName(functionNameBase)}; + switch (testEval) { + case Eval::Dynamic: + GenerateEvaluationFunctionCall(testFuncName, s); + break; + case Eval::Constant: + GenerateEvaluationFunctionCall(testFuncName, s); + break; + } + + s << "IF ("; + GenerateResultsComparison(s); + s << ") THEN" << std::endl; + s << passedName << " = " << passedName << " + 1" << std::endl; + s << "ELSE" << std::endl; + s << failedName << " = " << failedName << " + 1" << std::endl; + GenerateFailureMessage(functionNameBase, s); + s << "END IF" << std::endl; + + for (std::size_t i{0}; i < numInputs; ++i) { + s << "END DO" << std::endl; + } + s << "END SUBROUTINE" << std::endl; + s << std::endl; + } + + template + void GenerateEvaluationFunctionCall( + const std::string &functionName, std::ostream &s) const { + s << functionName << "("; + if constexpr (Ev == Eval::Dynamic) { + ApplyOnInputIndexes( + [&](std::size_t i) { + return GetArrayElement(paramNameBase, loopIndexNameBase, i); + }, + ", ", s); + } else { + static_assert(Ev == Eval::Constant, "unhandled evaluation method"); + ApplyOnInputIndexes( + [&](std::size_t i) { return IndexedName(loopIndexNameBase, i); }, + ", ", s); + } + s << ")" << std::endl; + } + + void GenerateFailureMessage( + const std::string &functionNameBase, std::ostream &s) const { + s << "PRINT *, \"FAILED " << functionNameBase << " test: \""; + for (std::size_t i{0}; i < inputs.size(); ++i) { + auto loopId{IndexedName(loopIndexNameBase, i)}; + s << ", \"" << loopId << " = \", " << loopId; + } + s << std::endl; + s << "PRINT *, \" expected \", " << refResultName << ", \" got: \"," + << testResultName << std::endl; + } + + void GenerateInputAsArrayParameter(std::size_t i, std::ostream &s) const { + const auto &literals{inputs[i]->second}; + const auto size{literals.size()}; + assert(size > 0 && "No actual literal input for test"); + inputs[i]->first.Dump(s) + << ", PARAMETER :: " << IndexedName(paramNameBase, i) << "(" << size + << ") = ["; + s << literals[0]; + for (std::size_t i{1}; i < size; ++i) { + s << ", " << literals[i]; + } + s << "]" << std::endl; + } + + void GenerateDriverCall( + const std::string &functionNameBase, std::ostream &s) const { + s << "CALL " << GetDriverName(functionNameBase) << "(" << passedName << ", " + << failedName << ")" << std::endl; + } + + template + void GenerateEvaluationFunctionStmtAndSpec( + const std::string &functionName, std::ostream &s) const { + resultType.Dump(s) << " FUNCTION " << functionName << "("; + assert(inputs.size() && "expect at least on argument"); + const auto &name{Ev == Eval::Constant ? loopIndexNameBase : varNameBase}; + s << IndexedName(name, 0); + for (std::size_t i{1}; i < inputs.size(); ++i) { + s << ", " << IndexedName(name, i); + } + s << ")" << std::endl; + std::size_t i{0}; + if constexpr (Ev == Eval::Constant) { + for (const auto *input : inputs) { + s << "INTEGER :: " << IndexedName(name, i++) << std::endl; + } + } else { + for (const auto *input : inputs) { + input->first.Dump(s) << " :: " << IndexedName(name, i++) << std::endl; + } + } + } + + template + void GenerateExpressionEvaluation( + const std::string &resultName, std::ostream &s) const { + if constexpr (Ev == Eval::Constant) { + GenerateConstantExpressionEvaluation(resultName, s); + } else { + static_assert( + Ev == Eval::Dynamic, "unhandled expression evaluation method"); + s << resultName << " = "; + GenerateExpression( + [&](std::size_t i) { return IndexedName(varNameBase, i); }, s); + s << std::endl; + } + } + + void GenerateConstantExpressionEvaluation( + const std::string &resultName, std::ostream &s) const { + // Declare constant inputs + for (std::size_t i{0}; i < inputs.size(); ++i) { + GenerateInputAsArrayParameter(i, s); + } + // Evaluate in a parameter array using ac-implied-do + auto cstResultName{IndexedName(paramNameBase, inputs.size())}; + assert(inputs.size() > 0 && "expected at least one operands"); + resultType.Dump(s) << " , PARAMETER :: " << cstResultName << "(*"; + for (std::size_t i{1}; i < inputs.size(); ++i) { + s << ", *"; + } + s << ") = RESHAPE ([("; + for (std::size_t i{1}; i < inputs.size(); ++i) { + s << "("; + } + + // Expression evaluation inside ac-implied-do + // TODO: how to handle constraints ? + GenerateExpression( + [&](std::size_t i) { + return GetArrayElement(paramNameBase, loopIndexNameBase, i); + }, + s); + + // ac-implied-do (opening ")" were emited before). + s << ", "; + ApplyOnInputIndexes( + [&](std::size_t i) { + return IndexedName(loopIndexNameBase, i) + " = 1," + + std::to_string(inputs[i]->second.size()) + ")"; + }, + ",", s); + + // RESHAPE SHAPE argument + s << "], ["; + ApplyOnInputIndexes( + [&](std::size_t i) { return inputs[i]->second.size(); }, ",", s); + s << "])" << std::endl; + + // dynamically fetch requested result from the constant array + s << resultName << " = " << cstResultName << "("; + ApplyOnInputIndexes( + [&](std::size_t i) { return IndexedName(loopIndexNameBase, i); }, ",", + s); + s << ")" << std::endl; + } + + template + void inline ApplyOnInputIndexes( + const T &callable, const std::string &sep, std::ostream &s) const { + auto size{inputs.size()}; + if (size != 0) { + s << callable(0); + } + for (std::size_t i{1}; i < size; ++i) { + s << ", " << callable(i); + } + } + + template + void inline GenerateExpression( + const T &operandGenerator, std::ostream &s) const { + if (inputs.size() == 1) { + s << op.symbol << " " << operandGenerator(0); + } else { + assert(inputs.size() == 2 && "expected binary opreation"); + s << operandGenerator(0) << " " << op.symbol << " " + << operandGenerator(1); + } + } + + void GenerateEvaluationFunctionInterface(const std::string &functionNameBase, + std::ostream &s, Eval ev, bool isReference) const { + auto functionName{isReference ? GetReferenceFunctionName(functionNameBase) + : GetTestFunctionName(functionNameBase)}; + switch (ev) { + case Eval::Constant: + GenerateEvaluationFunctionStmtAndSpec(functionName, s); + break; + case Eval::Dynamic: + GenerateEvaluationFunctionStmtAndSpec(functionName, s); + break; + } + s << "END FUNCTION" << std::endl; + } + + void GenerateResultsComparison(std::ostream &s) const { + auto compareReal{[&](const std::string &x, const std::string &y) { + // TODO: This should not always be an absolute comparison (epsilon margin + // for fp.). + s << x << ".EQ." << y << " .OR. "; + s << "(IEEE_IS_NAN(" << x << ") .AND. IEEE_IS_NAN(" << y << "))"; + }}; + if (resultType.cat == TypeCategory::Real) { + compareReal(refResultName, testResultName); + } else if (resultType.cat == TypeCategory::Complex) { + s << "("; + compareReal(std::string{refResultName} + "%RE", + std::string{testResultName} + "%RE"); + s << ") .AND. ("; + compareReal(std::string{refResultName} + "%IM", + std::string{testResultName} + "%IM"); + s << ")"; + } else { + const auto *compareOp{ + resultType.cat == TypeCategory::Logical ? ".EQV." : ".EQ."}; + s << refResultName << compareOp << testResultName; + } + } + + // a0(i0) and such + static std::string GetArrayElement( + const char *arrayNameBase, const char *indexNameBase, std::size_t i) { + return IndexedName(arrayNameBase, i) + "(" + IndexedName(indexNameBase, i) + + ")"; + } + + static std::string GetTestFunctionName(const std::string &functionNameBase) { + return functionNameBase + "_test"; + } + static std::string GetReferenceFunctionName( + const std::string &functionNameBase) { + return functionNameBase + "_ref"; + } + static std::string GetDriverName(const std::string &functionNameBase) { + return functionNameBase + "_driver"; + } + Type resultType; + const Operation &op; + std::vector *> inputs; +}; + +// Test Generator +struct TestGenerator { + + void GenerateTests(std::ostream &testFile, std::ostream &refFile) { + std::stringstream testContentStream; + std::stringstream testInterfaceStream; + std::stringstream referenceAndDriverContentStream; + std::stringstream programContentStream; + auto generateInBuffers{ + [&](const CodeGenerator &codeGen, const std::string &functionNameBase) { + codeGen.GenerateEvaluationFunction(functionNameBase, + testContentStream, plan.testEvaluationMethod, false); + codeGen.GenerateEvaluationFunctionInterface(functionNameBase, + testInterfaceStream, plan.testEvaluationMethod, false); + codeGen.GenerateEvaluationFunction(functionNameBase, + referenceAndDriverContentStream, plan.referenceEvaluationMethod, + true); + codeGen.GenerateDriverSubroutine(functionNameBase, + referenceAndDriverContentStream, plan.referenceEvaluationMethod, + plan.testEvaluationMethod); + codeGen.GenerateDriverCall(functionNameBase, programContentStream); + }}; + + for (const auto *opName : plan.operationToTests) { + const auto *op{GetOperation(opName)}; + assert(op && "Broken test plan: undefined operation"); + for (const auto &input1 : plan.inputs) { + if (op->IsUnaryOp()) { + if (auto resultType{op->GetResultTypeForArgument(input1.first)}) { + CodeGenerator codeGen{*resultType, *op, {&input1}}; + auto functionNameBase{GetDistinctFunctionNameBase(*op)}; + generateInBuffers(codeGen, functionNameBase); + } + } else { + for (const auto &input2 : plan.inputs) { + if (auto resultType{op->GetResultTypeForArguments( + input1.first, input2.first)}) { + CodeGenerator codeGen{*resultType, *op, {&input1, &input2}}; + auto functionNameBase{GetDistinctFunctionNameBase(*op)}; + generateInBuffers(codeGen, functionNameBase); + } + } + } + } + } + + // Organize generated code + testFile << "! Generated test file" << std::endl; + testFile << testContentStream.rdbuf(); + testFile << "! End of generated test file" << std::endl; + + refFile << "! Generated reference and driver " << std::endl; + refFile << "MODULE REFERENCE_AND_DRIVER" << std::endl; + refFile << "USE IEEE_ARITHMETIC" << std::endl; // for IEEE_IS_NAN + refFile << "INTERFACE" << std::endl; + refFile << testInterfaceStream.rdbuf(); + refFile << "END INTERFACE" << std::endl; + refFile << std::endl; + refFile << "CONTAINS" << std::endl; + refFile << referenceAndDriverContentStream.rdbuf(); + refFile << "END MODULE" << std::endl; + refFile << std::endl; + refFile << "PROGRAM EXPR_TEST" << std::endl; + refFile << "USE REFERENCE_AND_DRIVER" << std::endl; + refFile << "INTEGER :: " << passedName << ", " << failedName << std::endl; + refFile << passedName << " = 0 " << std::endl; + refFile << failedName << " = 0 " << std::endl; + refFile << programContentStream.rdbuf(); + refFile << "PRINT *, \"Passed: \"," << passedName << ", \" Failed: \", " + << failedName << std::endl; + refFile << "IF (" << failedName << ".GT. 0) ERROR STOP 1" << std::endl; + refFile << "END PROGRAM" << std::endl; + refFile << "! End of generated reference and driver" << std::endl; + } + + const Operation *GetOperation(const char *name) { + assert(name && "nullptr string for test name"); + for (const auto &op : operations) { + assert(op.name && "Broken operation"); + if (std::strcmp(name, op.name) == 0) { + return &op; + } + } + return nullptr; + } + + std::string GetDistinctFunctionNameBase(const Operation &op) { + return IndexedName(op.name, funcId++); + } + + TestPlan plan; + std::size_t funcId{0}; +}; + +// Test driver +int main(int argc, char **argv) { + Eval testEvalMethod{Eval::Dynamic}; + Eval refEvalMethod{Eval::Dynamic}; + int planId{0}; + for (int i{0}; i < argc; ++i) { + if (std::strcmp(argv[i], "test=folding") == 0) { + testEvalMethod = Eval::Constant; + } else if (std::strcmp(argv[i], "ref=folding") == 0) { + refEvalMethod = Eval::Constant; + } + } + + TestGenerator{ + { + {"eqv", "neqv", "or", "and", "not", "eq", "ne", "lt", "le", "gt", + "ge", "add", "sub", "minus", "plus", "mult", "div", "power"}, + { + {Integer1, {"-1_1", "12_1", "2_1"}}, + {Integer2, {"-1_2", "12500_2", "2_2"}}, + {Integer4, {"31000_4", "-64354_4"}}, + {Integer8, {"3000001_8", "-2654637545_8"}}, + {Real4, {"1.03687448_4", "3.1254641_4"}}, + {Real8, {"1.036874168446448_8", "3.12254533554641_8"}}, + {Complex4, {"(-0.5_4,10.35544_4)", "(-5._4, 0.15647_4)"}}, + {Complex8, + {"(-0.5_8,10.35546579874_8)", + "(-5.64654654_8, 0.155876974647_8)"}}, + {DefaultLogical, {".false.", ".true."}}, + }, + refEvalMethod, + testEvalMethod, + }} + .GenerateTests(std::cout, std::cerr); +} diff --git a/flang/not-test/lower/test_expression_lowering.sh b/flang/not-test/lower/test_expression_lowering.sh new file mode 100755 index 0000000000000..5ef373ffe463a --- /dev/null +++ b/flang/not-test/lower/test_expression_lowering.sh @@ -0,0 +1,55 @@ +#!/usr/bin/env bash +# Test Fortran expression lowering by driving compilations +# and executions of programs generated by expr-test-generation.cc +# +# Usage: cmd bbc llc +# To keep generated files, run `export KEEP=TRUE` before the test call. + +BBC=$1 +LLC=$2 +CPP=g++ +FCC=pgfortran # So far, only works with pgfortran because of pgmath linking. +FCC_OPTIONS="-Kieee" # That is required because bit to bit compare so far. +SRC=$PWD/expr-test-generator.cc + +function die { + echo "$(basename $0): $*" >&2 + exit 1 +} + +temp=`mktemp -d ./tmp.XXXXXX` +cd $temp +[[ $KEEP ]] || trap "cd .. && rm -rf $temp" EXIT + +testGen=./genTests +testFile=test.f90 +driverFile=driver.f90 +bbcLog=bbc.log +assembly=a.s +testObject=test.o +testExec=./test_exec +testLog=test.log +llFile=test.mlir.ll + +$CPP $SRC -std=c++17 -o $testGen +[[ $? -ne 0 ]] && die "test generator compilation failure" +$testGen 1>$testFile 2>$driverFile +[[ $? -ne 0 ]] && die "test generation failure" +$BBC -disable-fir2std -emit-llvm $testFile 2>$bbcLog +[[ $? -ne 0 ]] && die "bbc test.f90 compilation failure" +# FIR internal mangling -> pgfortran mangling (until done by FIR lowering) +sed -i 's,_QP\([[:alnum:]_]*\),\1_,g' $llFile +$LLC $llFile -o $assembly +[[ $? -ne 0 ]] && die "llc failed compiling bbc output" +as $assembly -o $testObject +[[ $? -ne 0 ]] && die "as failed compiling llc output" +$FCC $testObject $driverFile -o $testExec $FCC_OPTIONS +[[ $? -ne 0 ]] && die "driver.f90 compilation/linking failure" +$testExec > $testLog +result=$? +cat $testLog +if [ $result -ne 0 ]; then + echo "FAIL" +else + echo "PASS" +fi diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index 7d5c88e78825d..47618231056f9 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -1,10 +1,4 @@ -#===-- runtime/CMakeLists.txt ----------------------------------------------===# -# -# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -# See https://llvm.org/LICENSE.txt for license information. -# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -# -#===------------------------------------------------------------------------===# +set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -DFORTRAN_IN_RUNTIME") include(CheckCXXSymbolExists) include(CheckCXXSourceCompiles) diff --git a/flang/runtime/io-api.h b/flang/runtime/io-api.h index 13254ce6f66e7..12c575df7bf35 100644 --- a/flang/runtime/io-api.h +++ b/flang/runtime/io-api.h @@ -28,6 +28,9 @@ using Cookie = IoStatementState *; using ExternalUnit = int; using AsynchronousId = int; static constexpr ExternalUnit DefaultUnit{-1}; // READ(*), WRITE(*), PRINT +} // namespace Fortran::runtime::io + +namespace Fortran::runtime::io { // INQUIRE specifiers are encoded as simple base-26 packings of // the spellings of their keywords. @@ -316,4 +319,5 @@ enum Iostat IONAME(EndIoStatement)(Cookie); } // extern "C" } // namespace Fortran::runtime::io + #endif diff --git a/flang/test/CMakeLists.txt b/flang/test/CMakeLists.txt index 7282b8ced3208..075791ac3ef21 100644 --- a/flang/test/CMakeLists.txt +++ b/flang/test/CMakeLists.txt @@ -13,6 +13,12 @@ configure_lit_site_cfg( MAIN_CONFIG ${CMAKE_CURRENT_SOURCE_DIR}/lit.cfg.py ) +configure_lit_site_cfg( + ${CMAKE_CURRENT_SOURCE_DIR}/Unit/lit.site.cfg.py.in + ${CMAKE_CURRENT_BINARY_DIR}/Unit/lit.site.cfg.py + MAIN_CONFIG + ${CMAKE_CURRENT_SOURCE_DIR}/Unit/lit.cfg.py + ) configure_lit_site_cfg( ${CMAKE_CURRENT_SOURCE_DIR}/Unit/lit.site.cfg.py.in @@ -25,11 +31,13 @@ set(FLANG_TEST_PARAMS flang_site_config=${CMAKE_CURRENT_BINARY_DIR}/lit.site.cfg.py) set(FLANG_TEST_DEPENDS - f18 FileCheck count not module_files fir-opt + f18 FileCheck count not module_files + opt llc + tco bbc + fir-opt + FortranRuntime FortranDecimal ) -list(APPEND FLANG_TEST_DEPENDS tco) - if (FLANG_BUILD_NEW_DRIVER) list(APPEND FLANG_TEST_DEPENDS flang-new) endif() diff --git a/flang/test/Examples/hello.f90 b/flang/test/Examples/hello.f90 new file mode 100644 index 0000000000000..62dff1f1ff232 --- /dev/null +++ b/flang/test/Examples/hello.f90 @@ -0,0 +1,14 @@ +! Note: The Fortran runtime libraries have dependences on the C++ runtime and +! LLVM libraries. To work around the former, this test explicitly links in +! libstdc++.a. To work around the latter, the source of Common/enum-set.h was +! hacked to exclude references to llvm ADTs. +! Note: On linux, the Fortran runtime wants to include libm as well. + +! RUN: bbc %s -o - | tco | llc --filetype=obj -o %t.o +! RUN: %CC -I%S/../.. %S/main.c -c -o %t.main.o +! RUN: %CC %t.o %t.main.o -L%L -lFortranRuntime -lFortranDecimal -lstdc++ -lm +! RUN: ./a.out | FileCheck %s + +! CHECK: Hello, World! + print *, "Hello, World!" + end diff --git a/flang/test/Examples/main.c b/flang/test/Examples/main.c new file mode 100644 index 0000000000000..7742730637c88 --- /dev/null +++ b/flang/test/Examples/main.c @@ -0,0 +1,14 @@ +#include "runtime/main.h" +#include "runtime/stop.h" + +/* main entry into PROGRAM */ +void _QQmain(); + +/* C main stub */ +int main(int argc, const char *argv[], const char *envp[]) +{ + RTNAME(ProgramStart)(argc, argv, envp); + _QQmain(); + RTNAME(ProgramEndStatement)(); + return 0; +} diff --git a/flang/test/Fir/char01.fir b/flang/test/Fir/char01.fir new file mode 100644 index 0000000000000..4bf3771ff0c09 --- /dev/null +++ b/flang/test/Fir/char01.fir @@ -0,0 +1,13 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// CHECK-LABEL: @test +func @test(%arg0 : !fir.ref>, %arg1 : !fir.ref>, %arg2 : i32) { + // CHECK: getelementptr i8, i8* + %1 = fir.coordinate_of %arg1, %arg2 : (!fir.ref>, i32) -> !fir.ref> + // CHECK: load i8, i8* + %2 = fir.load %1 : !fir.ref> + // CHECK: store i8 + fir.store %2 to %arg0 : !fir.ref> + // CHECK: ret void + return +} diff --git a/flang/test/Fir/complex.fir b/flang/test/Fir/complex.fir new file mode 100644 index 0000000000000..4578fd8372a4e --- /dev/null +++ b/flang/test/Fir/complex.fir @@ -0,0 +1,82 @@ +// RUN: cc -c %S/print_complex.c +// RUN: tco %s | llc | as -o %t +// RUN: cc %t print_complex.o +// RUN: ./a.out | FileCheck %s + +// CHECK: <0.935893, 2.252526> + +func @foo(%a : !fir.complex<4>, %b : !fir.complex<4>, %c : !fir.complex<4>, %d : !fir.complex<4>, %e : !fir.complex<4>) -> !fir.complex<4> { + %1 = fir.addc %a, %b : !fir.complex<4> + %2 = fir.mulc %1, %c : !fir.complex<4> + %3 = fir.subc %2, %d : !fir.complex<4> + %4 = fir.divc %3, %e : !fir.complex<4> + return %4 : !fir.complex<4> +} + +func @real_part(%a : !fir.complex<4>) -> f32 { + %0 = constant 0 : i32 + %1 = fir.extract_value %a, %0 : (!fir.complex<4>, i32) -> f32 + return %1 : f32 +} + +func @conj(%a : !fir.complex<4>) -> !fir.complex<4> { + %0 = constant 1 : i32 + %1 = fir.extract_value %a, %0 : (!fir.complex<4>, i32) -> f32 + %2 = fir.negf %1 : f32 + %3 = fir.insert_value %a, %2, %0 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + return %3 : !fir.complex<4> +} + +func @print_complex(f32, f32) + +func @main() -> i32 { + %0 = fir.alloca !fir.complex<4> + %1 = fir.alloca !fir.complex<4> + %2 = fir.alloca !fir.complex<4> + %3 = fir.alloca !fir.complex<4> + %4 = fir.alloca !fir.complex<4> + + %5 = fir.undefined !fir.complex<4> + %c0 = constant 0 : i32 + %c1 = constant 1 : i32 + + %f0 = constant 4.0 : f32 + %f1 = constant 52.5 : f32 + %6 = fir.insert_value %5, %f0, %c0 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + %7 = fir.insert_value %6, %f1, %c1 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + fir.store %7 to %0 : !fir.ref> + + %8 = fir.load %0 : !fir.ref> + %9 = fir.call @conj(%8) : (!fir.complex<4>) -> !fir.complex<4> + fir.store %9 to %1 : !fir.ref> + + %a0 = constant 95.65 : f32 + %a1 = constant 234.1 : f32 + %a2 = fir.insert_value %5, %a0, %c0 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + %a3 = fir.insert_value %a2, %a1, %c1 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + fir.store %a3 to %2 : !fir.ref> + + %b0 = constant 33.0 : f32 + %b1 = constant 87.69 : f32 + %b2 = fir.insert_value %5, %b0, %c0 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + %b3 = fir.insert_value %b2, %b1, %c1 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + fir.store %b3 to %3 : !fir.ref> + + %d0 = constant 791.0 : f32 + %d1 = constant 3.5923 : f32 + %d2 = fir.insert_value %5, %d0, %c0 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + %d3 = fir.insert_value %d2, %d1, %c1 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + fir.store %d3 to %4 : !fir.ref> + + %l0 = fir.load %0 : !fir.ref> + %l1 = fir.load %1 : !fir.ref> + %l2 = fir.load %2 : !fir.ref> + %l3 = fir.load %3 : !fir.ref> + %l4 = fir.load %4 : !fir.ref> + + %10 = fir.call @foo(%l0, %l1, %l2, %l3, %l4) : (!fir.complex<4>, !fir.complex<4>, !fir.complex<4>, !fir.complex<4>, !fir.complex<4>) -> !fir.complex<4> + %11 = fir.extract_value %10, %c0 : (!fir.complex<4>, i32) -> f32 + %12 = fir.extract_value %10, %c1 : (!fir.complex<4>, i32) -> f32 + fir.call @print_complex(%11, %12) : (f32, f32) -> () + return %c0 : i32 +} diff --git a/flang/test/Fir/coordinate01.fir b/flang/test/Fir/coordinate01.fir new file mode 100644 index 0000000000000..e7553477a8186 --- /dev/null +++ b/flang/test/Fir/coordinate01.fir @@ -0,0 +1,19 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// CHECK-LABEL: @foo1 +func @foo1(%i : i32, %j : i32, %k : i32) { + %1 = fir.alloca !fir.array<10 x 20 x 30 x f32> + %2 = fir.convert %1 : (!fir.ref>) -> !fir.ref> + // CHECK: getelementptr [20 x [10 x float]], [20 x [10 x float]]* % + %3 = fir.coordinate_of %2, %i, %j, %k : (!fir.ref>, i32, i32, i32) -> !fir.ref + return +} + +// CHECK-LABEL: @foo +func @foo(%i : i32, %j : i32, %k : i32) { + %1 = fir.alloca !fir.array<10 x 20 x 30 x f32> + %2 = fir.convert %1 : (!fir.ref>) -> !fir.ref + // CHECK: getelementptr float, float* % + %3 = fir.coordinate_of %2, %i : (!fir.ref, i32) -> !fir.ref + return +} diff --git a/flang/test/Fir/cse.fir b/flang/test/Fir/cse.fir new file mode 100644 index 0000000000000..91272292a118e --- /dev/null +++ b/flang/test/Fir/cse.fir @@ -0,0 +1,50 @@ +// Test CSE pass + +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// CHECK-LABEL: @fun +func @fun(%a : !fir.ref) -> i64 { + // CHECK: load i64 + %1 = fir.load %a : !fir.ref + %2 = fir.load %a : !fir.ref + // CHECK-NOT: load i64 + // CHECK-COUNT-6: add i64 + %3 = addi %1, %2 : i64 + %4 = fir.load %a : !fir.ref + %5 = addi %3, %4 : i64 + %6 = fir.load %a : !fir.ref + %7 = addi %5, %6 : i64 + %8 = fir.load %a : !fir.ref + %9 = addi %7, %8 : i64 + %10 = fir.load %a : !fir.ref + %11 = addi %10, %9 : i64 + %12 = fir.load %a : !fir.ref + %13 = addi %11, %12 : i64 + // CHECK-NEXT: ret i64 + return %13 : i64 +} + +// CHECK-LABEL: @bar +func @bar(%a : !fir.ref) -> i64 + +// CHECK-LABEL: @fun2 +func @fun2(%a : !fir.ref) -> i64 { + // CHECK: load i64 + %1 = fir.load %a : !fir.ref + // CHECK-NEXT: call i64 + %2 = fir.call @bar(%a) { pure = true } : (!fir.ref) -> i64 + // CHECK-COUNT-6: add i64 + %3 = addi %1, %2 : i64 + %4 = fir.call @bar(%a) { pure = true } : (!fir.ref) -> i64 + %5 = addi %3, %4 : i64 + %6 = fir.call @bar(%a) { pure = true } : (!fir.ref) -> i64 + %7 = addi %5, %6 : i64 + %8 = fir.call @bar(%a) { pure = true } : (!fir.ref) -> i64 + %9 = addi %7, %8 : i64 + %10 = fir.call @bar(%a) { pure = true } : (!fir.ref) -> i64 + %11 = addi %10, %9 : i64 + %12 = fir.call @bar(%a) { pure = true } : (!fir.ref) -> i64 + %13 = addi %11, %12 : i64 + // CHECK-NEXT: ret i64 + return %13 : i64 +} diff --git a/flang/test/Fir/embox-write.fir b/flang/test/Fir/embox-write.fir new file mode 100644 index 0000000000000..465848fdbd647 --- /dev/null +++ b/flang/test/Fir/embox-write.fir @@ -0,0 +1,18 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// CHECK-LABEL: @set_all_n +func @set_all_n(%n : index, %x : i32) { + %aTmp = fir.alloca i32, %n + %aMem = fir.convert %aTmp : (!fir.ref) -> !fir.ref> + %c1 = constant 1 : index + %aDim = fir.gendims %c1, %n, %c1 : (index, index, index) -> !fir.dims<1> + %a = fir.embox %aMem, %aDim : (!fir.ref>, !fir.dims<1>) -> !fir.box> + // CHECK: phi i64 + // CHECK-NEXT: icmp + fir.loop %i = %c1 to %n unordered { + %1 = fir.coordinate_of %a, %i : (!fir.box>, index) -> !fir.ref + // CHECK: store i32 %{{.*}}, i32* %{{.*}} + fir.store %x to %1 : !fir.ref + } + return +} diff --git a/flang/test/Fir/global.fir b/flang/test/Fir/global.fir new file mode 100644 index 0000000000000..822a8f3e5612e --- /dev/null +++ b/flang/test/Fir/global.fir @@ -0,0 +1,34 @@ +// RUN: tco %s | FileCheck %s + +// CHECK: @g_i0 = global i32 0 +fir.global @g_i0 : i32 { + %1 = constant 0 : i32 + fir.has_value %1 : i32 +} + +// CHECK: @g_i2 = global i32 2 +fir.global @g_i2 : i32 { + %1 = constant 2 : i32 + fir.has_value %1 : i32 +} + +// CHECK: @g_ci5 = constant i32 5 +fir.global @g_ci5 constant : i32 { + %c = constant 5 : i32 + fir.has_value %c : i32 +} + +// CHECK: @i_i515 = internal global i32 515 +fir.global internal @i_i515 (515:i32) : i32 + +// CHECK: @C_i511 = common global i32 511 +fir.global common @C_i511 (511:i32) : i32 + +// CHECK: @w_i86 = weak global i32 86 +fir.global weak @w_i86 (86:i32) : i32 + +// CHECK: @str1 = global [6 x i8] c"Hello!" +fir.global @str1 : !fir.array<6 x !fir.char<1>> { + %1 = fir.string_lit "Hello!"(6) : !fir.char<1> + fir.has_value %1 : !fir.array<6 x !fir.char<1>> +} diff --git a/flang/test/Fir/loop.fir b/flang/test/Fir/loop.fir new file mode 100644 index 0000000000000..d85bb2e202260 --- /dev/null +++ b/flang/test/Fir/loop.fir @@ -0,0 +1,22 @@ +// Test lowering FIR to LLVM IR of fir.select{|_rank|_case} + +// RUN: tco %s | FileCheck %s + +// CHECK-LABEL: @x +func @x(%lb : index, %ub : index, %step : index, %b : i1, %addr : !fir.ref) { + // CHECK: %[[COND:.*]] = icmp slt i64 + // CHECK: br i1 %[[COND]] + fir.loop %iv = %lb to %ub step %step unordered { + // CHECK: br i1 % + fir.where %b { + // CHECK: store i64 + fir.store %iv to %addr : !fir.ref + } otherwise { + %zero = constant 0 : index + // CHECK: store i64 + fir.store %zero to %addr : !fir.ref + } + } + // CHECK: ret void + return +} diff --git a/flang/test/Fir/loop10.fir b/flang/test/Fir/loop10.fir new file mode 100644 index 0000000000000..7c657e21d2863 --- /dev/null +++ b/flang/test/Fir/loop10.fir @@ -0,0 +1,24 @@ +// Test lowering FIR to LLVM IR of fir.select{|_rank|_case} + +// RUN: tco %s | FileCheck %s + +// CHECK: @x({{.*}} %[[ADDR:.*]]) +func @x(%addr : !fir.ref>) -> index { + %c0 = constant 0 : index + %c10 = constant 10 : index + // CHECK: %[[ROW:.*]] = phi i64 + // CHECK: icmp slt i64 %[[ROW]], 11 + fir.loop %iv = %c0 to %c10 { + // CHECK: %[[COL:.*]] = phi i64 + // CHECK: icmp slt i64 %[[COL]], 11 + fir.loop %jv = (0) to (10) { + // CHECK: getelementptr {{.*}} %[[ADDR]], i64 0, i64 %[[ROW]], i64 %[[COL]] + %ptr = fir.coordinate_of %addr, %jv, %iv : (!fir.ref>, index, index) -> !fir.ref + %c22 = constant 22 : i32 + // CHECK: store i32 22, + fir.store %c22 to %ptr : !fir.ref + } + } + // CHECK: ret i64 10 + return %c10 : index +} diff --git a/flang/test/Fir/print_complex.c b/flang/test/Fir/print_complex.c new file mode 100644 index 0000000000000..c821bc25de552 --- /dev/null +++ b/flang/test/Fir/print_complex.c @@ -0,0 +1,5 @@ +#include + +void print_complex(float x, float y) { + printf("<%f, %f>\n", x, y); +} diff --git a/flang/test/Fir/real.fir b/flang/test/Fir/real.fir new file mode 100644 index 0000000000000..45cafbee369eb --- /dev/null +++ b/flang/test/Fir/real.fir @@ -0,0 +1,51 @@ +// Test lowering of REAL operations from FIR to LLVM IR + +// RUN: tco %s | FileCheck %s + +// CHECK-LABEL: @bar +func @bar(%a : !fir.real<2>, %b : !fir.real<4>, %c : !fir.real<8>, %d : !fir.real<10>, %e : !fir.real<16>) -> !fir.real<10> { + // CHECK: fpext half %{{.*}} to x86_fp80 + %1 = fir.convert %a : (!fir.real<2>) -> !fir.real<10> + // CHECK: fpext float %{{.*}} to x86_fp80 + %2 = fir.convert %b : (!fir.real<4>) -> !fir.real<10> + // CHECK: fpext double %{{.*}} to x86_fp80 + %3 = fir.convert %c : (!fir.real<8>) -> !fir.real<10> + // CHECK-NOT: fpext + // CHECK-NOT: fptrunc + %4 = fir.convert %d : (!fir.real<10>) -> !fir.real<10> + // CHECK: fptrunc fp128 %{{.*}} to x86_fp80 + %5 = fir.convert %e : (!fir.real<16>) -> !fir.real<10> + // CHECK-NEXT: call x86_fp80 + %6 = call @foop(%1, %2, %3, %4, %5) : (!fir.real<10>, !fir.real<10>, !fir.real<10>, !fir.real<10>, !fir.real<10>) -> !fir.real<10> + return %6 : !fir.real<10> +} + +// CHECK-LABEL: @foo +func @foo(%a : !fir.real<16>, %b : !fir.real<16>, %c : !fir.real<16>, %d : !fir.real<16>, %e : !fir.real<16>) -> !fir.real<16> { + // CHECK: fadd fp128 + %1 = fir.addf %a, %b : !fir.real<16> + // CHECK: fmul fp128 + %2 = fir.mulf %1, %c : !fir.real<16> + // CHECK: fsub fp128 + %3 = fir.subf %2, %d : !fir.real<16> + // CHECK: fdiv fp128 + %4 = fir.divf %3, %e : !fir.real<16> + // CHECK: frem fp128 + %5 = fir.modf %4, %a : !fir.real<16> + return %5 : !fir.real<16> +} + +// CHECK-LABEL: @foop +func @foop(%a : !fir.real<10>, %b : !fir.real<10>, %c : !fir.real<10>, %d : !fir.real<10>, %e : !fir.real<10>) -> !fir.real<10> { + // CHECK: fadd x86_fp80 + %1 = fir.addf %a, %b : !fir.real<10> + // CHECK: fmul x86_fp80 + %2 = fir.mulf %1, %c : !fir.real<10> + // CHECK: fsub x86_fp80 + %3 = fir.subf %2, %d : !fir.real<10> + // CHECK: fdiv x86_fp80 + %4 = fir.divf %3, %e : !fir.real<10> + // CHECK: frem x86_fp80 + %5 = fir.modf %4, %a : !fir.real<10> + return %5 : !fir.real<10> +} diff --git a/flang/test/Fir/recursive-type.fir b/flang/test/Fir/recursive-type.fir new file mode 100644 index 0000000000000..595302e7f0acc --- /dev/null +++ b/flang/test/Fir/recursive-type.fir @@ -0,0 +1,11 @@ +// Test lowering FIR to LLVM IR for a recursive type + +// RUN: tco %s | FileCheck %s + +// CHECK-LABEL: %t = type { %t* } +!t = type !fir.type>}> + +// CHECK-LABEL: @a(%t %{{.*}}) +func @a(%a : !t) { + return +} diff --git a/flang/test/Fir/select-type.fir b/flang/test/Fir/select-type.fir new file mode 100644 index 0000000000000..8882d6a89a32f --- /dev/null +++ b/flang/test/Fir/select-type.fir @@ -0,0 +1,22 @@ +// Test lowering of select_type for FIR to LLVM IR + +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// CHECK-LABEL: @f +func @f(%a : !fir.box) -> i32 { + %1 = constant 4 : i32 + %2 = constant 8 : i32 + %3 = constant 16 : i32 + // CHECK-DAG: call i1 @FIXME_exact_type_match + // CHECK-DAG: call i1 @FIXME_isa_type_test + fir.select_type %a : !fir.box [#fir.instance>, ^bb2(%1:i32), #fir.subsumed>, ^bb3(%3:i32), unit, ^bb4(%2:i32)] +^bb2(%4 : i32) : + return %4 : i32 +^bb3(%5 : i32) : + %6 = addi %5, %5 : i32 + return %6 : i32 +^bb4(%7 : i32) : + %8 = muli %7, %7 : i32 + // CHECK: ret i32 % + return %8 : i32 +} diff --git a/flang/test/Fir/select.fir b/flang/test/Fir/select.fir new file mode 100644 index 0000000000000..cc326809d6a33 --- /dev/null +++ b/flang/test/Fir/select.fir @@ -0,0 +1,63 @@ +// Test lowering FIR to LLVM IR of fir.select{|_rank|_case} + +// RUN: tco %s | FileCheck %s + +// CHECK-LABEL: @f +func @f(%a : i32) -> i32 { + %1 = constant 1 : i32 + %2 = constant 42 : i32 + // CHECK: icmp eq i32 %{{.*}}, 1 + fir.select %a : i32 [1, ^bb2(%1:i32), unit, ^bb3(%2:i32)] +^bb2(%3 : i32) : + return %3 : i32 +^bb3(%4 : i32) : + %5 = addi %4, %4 : i32 + // CHECK: ret i32 + return %5 : i32 +} + +// CHECK-LABEL: @g +func @g(%a : i32) -> i32 { + %1 = constant 1 : i32 + %2 = constant 42 : i32 + // CHECK-DAG: icmp eq i32 %{{.*}}, 1 + // CHECK-DAG: icmp eq i32 %{{.*}}, -1 + fir.select_rank %a : i32 [1, ^bb2(%1:i32), -1, ^bb4, unit, ^bb3(%2:i32)] +^bb2(%3 : i32) : + return %3 : i32 +^bb3(%4 : i32) : + %5 = addi %4, %4 : i32 + return %5 : i32 +^bb4: + // CHECK: ret i32 + return %a : i32 +} + +// CHECK-LABEL: @h +func @h(%a : i32) -> i32 { + %1 = constant 1 : i32 + %2 = constant 42 : i32 + %b1 = constant 4 : i32 + %b2 = constant 14 : i32 + %b3 = constant 82 : i32 + %b4 = constant 96 : i32 + // CHECK-DAG: icmp eq i32 %{{.*}}, 1 + // CHECK-DAG: icmp sle i32 4, %{{.*}} + // CHECK-DAG: icmp sle i32 %{{.*}}, 14 + // CHECK-DAG: icmp sle i32 82, %{{.*}} + // CHECK-DAG: icmp sle i32 %{{.*}}, 96 + fir.select_case %a : i32 [#fir.point, %1, ^bb2(%1:i32), #fir.lower, %b1, ^bb4, #fir.upper, %b2, ^bb6, #fir.interval, %b3, %b4, ^bb5, unit, ^bb3(%2:i32)] +^bb2(%3 : i32) : + return %3 : i32 +^bb3(%4 : i32) : + %5 = addi %4, %4 : i32 + br ^bb2(%5 : i32) +^bb4: + return %a : i32 +^bb5: + return %1 : i32 +^bb6: + %x = addi %b4, %b3 : i32 + // CHECK: ret i32 + return %x : i32 +} diff --git a/flang/test/Fir/widechar.fir b/flang/test/Fir/widechar.fir new file mode 100644 index 0000000000000..c6ae703099805 --- /dev/null +++ b/flang/test/Fir/widechar.fir @@ -0,0 +1,22 @@ +// RUN: tco %s | FileCheck %s + +// CHECK-LABEL: @character_literal1 +func @character_literal1() -> !fir.array<13 x !fir.char<1>> { + %0 = fir.string_lit "Hello, World!"(13) : !fir.char<1> + // CHECK: ret [13 x i8] c"Hello, World!" + return %0 : !fir.array<13 x !fir.char<1>> +} + +// CHECK-LABEL: @character_literal2 +func @character_literal2() -> !fir.array<2 x !fir.char<2>> { + %0 = fir.string_lit [234, 456](2) : !fir.char<2> + // CHECK: ret [2 x i16] [i16 234, i16 456] + return %0 : !fir.array<2 x !fir.char<2>> +} + +// CHECK-LABEL: @character_literal4 +func @character_literal4() -> !fir.array<3 x !fir.char<4>> { + %0 = fir.string_lit [89123, 999256, 4](3) : !fir.char<4> + // CHECK: ret [3 x i32] [i32 89123, i32 999256, i32 4] + return %0 : !fir.array<3 x !fir.char<4>> +} diff --git a/flang/test/Lower/arguments.f90 b/flang/test/Lower/arguments.f90 new file mode 100644 index 0000000000000..2478dc251c1ff --- /dev/null +++ b/flang/test/Lower/arguments.f90 @@ -0,0 +1,23 @@ +! RUN: bbc %s -o - | FileCheck %s + +! CHECK-LABEL: _QQmain +program test1 + ! CHECK-DAG: %[[TMP:.*]] = fir.alloca + ! CHECK-DAG: %[[TEN:.*]] = constant + ! CHECK: fir.store %[[TEN]] to %[[TMP]] + ! CHECK-NEXT: fir.call @_QPfoo + call foo(10) +contains + +! CHECK-LABEL: func @_QPfoo +subroutine foo(avar1) + integer :: avar1 +! integer :: my_data, my_data2 +! DATA my_data / 150 / +! DATA my_data2 / 150 / +! print *, my_data, my_data2 + print *, avar1 +end subroutine +! CHECK: } +end program test1 + diff --git a/flang/test/Lower/array-init-driver.c b/flang/test/Lower/array-init-driver.c new file mode 100644 index 0000000000000..4cbdbde177b25 --- /dev/null +++ b/flang/test/Lower/array-init-driver.c @@ -0,0 +1,24 @@ +#include + +void _QPsetall(float (*)[20][10], float *); +void _QPsub1(float (*)[20][10], float (*)[20][10], float (*)[20][10]); + +static float arr_a[20][10]; +static float arr_b[20][10]; +static float arr_c[20][10]; +static float x; + +int main() +{ + x = 4.0; + _QPsetall(&arr_a, &x); + x = 5.0; + arr_a[5][5] = 2.0; + _QPsetall(&arr_b, &x); + printf("sub1\n"); + _QPsub1(&arr_c, &arr_b, &arr_a); + printf("c(1,1) = %f\n", arr_c[0][0]); + printf("c(2,9) = %f\n", arr_c[8][1]); + printf("c(6,6) = %f\n", arr_c[5][5]); + return 0; +} diff --git a/flang/test/Lower/array-init.f90 b/flang/test/Lower/array-init.f90 new file mode 100644 index 0000000000000..8377eb6ec8450 --- /dev/null +++ b/flang/test/Lower/array-init.f90 @@ -0,0 +1,48 @@ +! RUN: bbc -emit-llvm -o - %s | tco | llc | as -o %t +! RUN: cc %t %S/array-init-driver.c +! RUN: ./a.out | FileCheck %s + +subroutine setall(a, x) + real :: a(10,20) + real :: x + integer :: i, j + do i = 2, 9 + a(i, 1) = -1.0 + do j = 2, 19 + a(i, j) = x + end do + a(i, 20) = -2.0 + end do + do j = 1, 20 + a(1, j) = 0.0 + a(10, j) = -3.0 + end do +end subroutine setall + +! Two subroutines that mean the same thing semantically. sub1 has explicit +! loops over the arrays, but there are no loop-carried dependences. The +! operation can be performed concurrently across the entire 2-D iteration +! space. sub2 has implicit loops and obviates the need for any analyis. + +! expected results from our temporary .c driver +! +! CHECK-LABEL: sub1 +! CHECK: c(1,1) = 0.0 +! CHECK: c(2,9) = 9.0 +! CHECK: c(6,6) = 7.0 + +subroutine sub1(a,b,c) + real :: a(10,20), b(10,20), c(2:11,20) + integer :: i, j + do i = 1, 10 + do j = 1, 20 + a(i,j) = b(i,j) + c(i+1,j) + end do + end do +end subroutine sub1 + +!subroutine sub2(a,b,c) +! real :: a(10,20), b(10,20), c(10,20) +! integer :: i, j +! a = b + c +!end subroutine sub2 diff --git a/flang/test/Lower/call-site-mangling.f90 b/flang/test/Lower/call-site-mangling.f90 new file mode 100644 index 0000000000000..29c34568e1e37 --- /dev/null +++ b/flang/test/Lower/call-site-mangling.f90 @@ -0,0 +1,52 @@ +! RUN: bbc %s -o "-" -emit-fir | FileCheck %s + +subroutine sub() + real :: x + ! CHECK-LABEL: fir.call @_QPasubroutine() + call AsUbRoUtInE(); + ! CHECK-LABEL: fir.call @_QPfoo() + x = foo() +end subroutine + +module testMod +contains + subroutine sub() + end subroutine + + function foo() + end function +end module + +subroutine sub1() + use testMod + real :: x + ! CHECK-LABEL: fir.call @_QMtestmodPsub() + call Sub(); + ! CHECK-LABEL: fir.call @_QMtestmodPfoo() + x = foo() +end subroutine + +subroutine sub2() + use testMod, localfoo => foo, localsub => sub + real :: x + ! CHECK-LABEL: fir.call @_QMtestmodPsub() + call localsub(); + ! CHECK-LABEL: fir.call @_QMtestmodPfoo() + x = localfoo() +end subroutine + + + +subroutine sub3() + real :: x + ! CHECK-LABEL: fir.call @_QFsub3Psub() + call sub(); + ! CHECK-LABEL: fir.call @_QFsub3Pfoo() + x = foo() +contains + subroutine sub() + end subroutine + + function foo() + end function +end subroutine diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 new file mode 100644 index 0000000000000..9c455ac1bae41 --- /dev/null +++ b/flang/test/Lower/character-assignment.f90 @@ -0,0 +1,106 @@ +! RUN: bbc %s -o "-" -emit-fir | FileCheck %s + +! Simple character assignment tests +! CHECK-LABEL: assign1 +subroutine assign1(lhs, rhs) + character(*, 1) :: lhs, rhs + lhs = rhs + ! Unboxing + ! CHECK-DAG:[[lhs:%[0-9]+]]:2 = fir.unboxchar %arg0 + ! CHECK-DAG:[[rhs:%[0-9]+]]:2 = fir.unboxchar %arg1 + + ! Compute minimum length + ! CHECK-DAG:%[[cmp_len:[0-9]+]] = cmpi "slt", [[lhs]]#1, [[rhs]]#1 + ! CHECK-DAG:[[min_len:%[0-9]+]] = select %[[cmp_len]], [[lhs]]#1, [[rhs]]#1 + + ! Allocate temp in case rhs and lhs may overlap + ! CHECK: [[tmp:%[0-9]+]] = fir.alloca !fir.char<1>, [[min_len]] + + ! Copy of rhs into temp + ! CHECK: fir.loop [[i:%[[:alnum:]_]+]] + ! CHECK-DAG: [[rhs_addr:%[0-9]+]] = fir.coordinate_of [[rhs]]#0, [[i]] + ! CHECK-DAG: [[tmp_addr:%[0-9]+]] = fir.coordinate_of [[tmp]], [[i]] + ! CHECK-DAG: [[rhs_elt:%[0-9]+]] = fir.load [[rhs_addr]] + ! CHECK: fir.store [[rhs_elt]] to [[tmp_addr]] + ! CHECK: } + + ! Copy of temp into lhs + ! CHECK: fir.loop [[i:%[[:alnum:]]+]] + ! CHECK-DAG: [[tmp_addr:%[0-9]+]] = fir.coordinate_of [[tmp]], [[i]] + ! CHECK-DAG: [[lhs_addr:%[0-9]+]] = fir.coordinate_of [[lhs]]#0, [[i]] + ! CHECK-DAG: [[tmp_elt:%[0-9]+]] = fir.load [[tmp_addr]] + ! CHECK: fir.store [[tmp_elt]] to [[lhs_addr]] + ! CHECK: } + + ! Padding + ! CHECK: [[c32:%[[:alnum:]_]+]] = constant 32 : i8 + ! CHECK: [[blank:%[0-9]+]] = fir.convert [[c32]] : (i8) -> !fir.char<1> + ! CHECK: fir.loop [[i:%[[:alnum:]_]+]] + ! CHECK-DAG: [[lhs_addr:%[0-9]+]] = fir.coordinate_of [[lhs]]#0, [[i]] + ! CHECK: fir.store [[blank]] to [[lhs_addr]] + ! CHECK: } +end subroutine + +! Test substring assignment +! CHECK-LABEL: assign_substring1 +subroutine assign_substring1(str, rhs, lb, ub) + character(*, 1) :: rhs, str + integer(8) :: lb, ub + str(lb:ub) = rhs + ! CHECK-DAG: [[lb:%[0-9]+]] = fir.load %arg2 + ! CHECK-DAG: [[ub:%[0-9]+]] = fir.load %arg3 + ! CHECK-DAG: [[str:%[0-9]+]]:2 = fir.unboxchar %arg0 + + ! Compute substring offset + ! CHECK-DAG: [[lbi:%[0-9]+]] = fir.convert [[lb]] : (i64) -> index + ! CHECK-DAG: [[c1:%[[:alnum:]_]+]] = constant 1 + ! CHECK-DAG: [[offset:%[0-9]+]] = subi [[lbi]], [[c1]] + ! CHECK-DAG: [[lhs_addr:%[0-9]+]] = fir.coordinate_of [[str]]#0, [[offset]] + + + ! Compute substring length + ! CHECK-DAG: [[diff:%[0-9]+]] = subi [[ub]], [[lb]] + ! CHECK-DAG: [[c1:%[[:alnum:]_]+]] = constant 1 + ! CHECK-DAG: [[pre_lhs_len:%[0-9]+]] = addi [[diff]], [[c1]] + ! CHECK-DAG: [[c0:%[[:alnum:]_]+]] = constant 0 + ! CHECK-DAG: [[cmp_len:%[0-9]+]] = cmpi "slt", [[pre_lhs_len]], [[c0]] + ! CHECK-DAG: [[lhs_len:%[0-9]+]] = select [[cmp_len]], [[c0]], [[pre_lhs_len]] + + ! CHECK: [[lhs_box:%[0-9]+]] = fir.emboxchar [[lhs_addr]], [[lhs_len]] + + ! The rest of the assignment is just as the one above, only test that the + ! substring box is the one used + ! ... + ! CHECK: [[lhs:%[0-9]+]]:2 = fir.unboxchar [[lhs_box]] + ! ... + ! CHECK: fir.coordinate_of [[lhs]]#0, {{.*}} + ! ... +end subroutine + +! CHECK-LABEL: assign_constant +! CHECK: (%[[ARG:.*]]:{{.*}}) +subroutine assign_constant(lhs) + character(*, 1) :: lhs + ! CHECK-DAG: %[[lhs:.*]]:2 = fir.unboxchar %[[ARG]] : + ! CHECK-DAG: %[[tmp:.*]] = fir.address_of(@{{.*}}) : + lhs = "Hello World" + ! CHECK: fir.loop %[[i:.*]] = %{{.*}} to %{{.*}} { + ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[i]] + ! CHECK-DAG: %[[tmp_elt:.*]] = fir.load %[[tmp_addr]] + ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[i]] + ! CHECK: fir.store %[[tmp_elt]] to %[[lhs_addr]] + ! CHECK: } + + ! Padding + ! CHECK-DAG: %[[c32:.*]] = constant 32 : i8 + ! CHECK-DAG: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> + ! CHECK: fir.loop %[[j:.*]] = %{{.*}} to %{{.*}} { + ! CHECK: %[[jhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[j]] + ! CHECK: fir.store %[[blank]] to %[[jhs_addr]] + ! CHECK: } +end subroutine + +! CHECK-LABEL: fir.global @_QQ48656C6C6F20576F726C64 +! CHECK: %[[lit:.*]] = fir.string_lit "Hello World"(11) : !fir.char<1> +! CHECK: fir.has_value %[[lit]] : !fir.array<11x!fir.char<1>> +! CHECK: } diff --git a/flang/test/Lower/control-flow.f90 b/flang/test/Lower/control-flow.f90 new file mode 100644 index 0000000000000..b9485f4315b3a --- /dev/null +++ b/flang/test/Lower/control-flow.f90 @@ -0,0 +1,25 @@ +! Tests for control-flow + +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! check the lowering of a RETURN in the body of a SUBROUTINE +! CHECK-LABEL one +subroutine one(a,b,c) + d = 1.0 + if (a .ne. b) then + ! CHECK: call @_QPone_a + call one_a(d) + ! CHECK: cond_br %{{.*}}, ^bb[[TB:.*]], ^ + if (d .eq. 1.0) then + ! CHECK-NEXT: ^bb[[TB]]: + ! CHECK-NEXT: br ^bb[[EXIT:.*]] + return + endif + else + e = 4.0 + call one_b(c,d,e) + endif + ! CHECK: ^bb[[EXIT]]: + ! CHECK-NEXT: return +end subroutine one + diff --git a/flang/test/Lower/end-to-end-character-assignment-driver.cpp b/flang/test/Lower/end-to-end-character-assignment-driver.cpp new file mode 100644 index 0000000000000..6e3a3c9ba4668 --- /dev/null +++ b/flang/test/Lower/end-to-end-character-assignment-driver.cpp @@ -0,0 +1,357 @@ +//===-- test/lower/test-character-assignment.cc -----------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//----------------------------------------------------------------------------// + +#include +#include +#include +#include +#include +#include +#include + +// Driver to tests Fortran subroutine from character-assignment.f90 + +// So far lowering of fir::boxchar dummy to llvm does not layout character +// arguments like other compiler do for F77. Templates provides a patch for +// that. + +using LenT = std::int64_t; +struct Fchar { + char *data; + LenT len; +}; + +template using SubF18 = void (*)(Fchar, Fchar, T...); +template +using SubF77 = void (*)(char *, char *, T..., LenT, LenT); +template +void CallSubroutine(SubF18 f, Fchar s1, Fchar s2, T... args) { + f(s1, s2, args...); +} + +template +void CallSubroutine(SubF77 f, Fchar s1, Fchar s2, T... args) { + f(s1.data, s2.data, args..., s1.len, s2.len); +} + +// Define structures to create and manipulate Fortran Character +// A canary is always added at the end of character storage so that +// invalid overwrites can be detected. +template struct CharStorage {}; +template<> struct CharStorage<1> { + using Type = std::string; + static const Type canary; +}; +const CharStorage<1>::Type CharStorage<1>::canary{"_CaNaRy"}; + +template<> struct CharStorage<2> { + using Type = std::u16string; + static const Type canary; +}; +const CharStorage<2>::Type CharStorage<2>::canary{u"_CaNaRy"}; + +template<> struct CharStorage<4> { + using Type = std::u32string; + static const Type canary; +}; +const CharStorage<4>::Type CharStorage<4>::canary{U"_CaNaRy"}; + +template struct FcharData { + using String = typename CharStorage::Type; + using CharT = typename String::value_type; + FcharData(String str) + : data{str + CharStorage::canary}, len{static_cast( + str.length())} {} + Fchar getFchar() { + const char *addr{reinterpret_cast(data.data())}; + return Fchar{const_cast(addr), len}; + } + + // UTF-8 dump + std::ostream &dump(std::ostream &os) const { + if constexpr (std::is_same_v) { + os << data; + } else { + std::wstring_convert, CharT> cvt; + os << cvt.to_bytes(data); + } + return os; + } + // Hex dump + std::ostream &dumpHex(std::ostream &os) const { + os << std::hex; + for (auto c : data) { + if constexpr (std::is_same_v) { + os << " 0x" << std::setw(2) << std::setfill('0') + << (int)((unsigned char)c); + } else { + os << " 0x" << std::setw(sizeof(CharT) * 2) << std::setfill('0') << c; + } + } + os << std::dec; + return os; + } + + String data; + LenT len; // may differ from string length for test purposes +}; + +template +bool Check(const FcharData &test, const FcharData &ref, + const std::string &desc) { + if (test.data != ref.data) { + std::cout << "Failed: " << desc << std::endl; + ref.dump(std::cout << " expected: '") << "'" << std::endl; + test.dump(std::cout << " got : '") << "'" << std::endl; + return false; + } + return true; +} + +// Call compiled test subroutine and compare variable afterwards with a +// reference. Compare against result from reference subroutine. +template +bool TestSubroutine(const std::string &testName, SubF18 fooTest, + SubF18 fooRef, const FcharData &s1, const FcharData &s2, + T... otherArgs) { + // Make copies because data may be modified + FcharData testS1{s1}, testS2{s2}; + CallSubroutine(fooTest, testS1.getFchar(), testS2.getFchar(), otherArgs...); + + // Compare against reference subroutine + FcharData refS1{s1}, refS2{s2}; + CallSubroutine(fooRef, refS1.getFchar(), refS2.getFchar(), otherArgs...); + + auto description{testName + " KIND=" + std::to_string(Kind)}; + bool result{Check(testS1, refS1, description + " s1")}; + result &= Check(testS2, refS2, description + " s2"); + return result; +} + +// Compare against precomputed results. +template +bool TestSubroutine(const std::string &testName, SubF18 fooTest, + const FcharData &s1, const FcharData &refS1, + const FcharData &s2, const FcharData &refS2, T... otherArgs) { + // Make copies because data may be modified + FcharData testS1{s1}, testS2{s2}; + CallSubroutine(fooTest, testS1.getFchar(), testS2.getFchar(), otherArgs...); + auto description{testName + " KIND=" + std::to_string(Kind)}; + bool result{Check(testS1, refS1, description + " s1")}; + result &= Check(testS2, refS2, description + " s2"); + return result; +} + +// Test driver code (could maybe generated somehow) + +// String data to be used as inputs during the tests. +template struct Inputs { static FcharData s1, s2, s3; }; + +template<> FcharData<1> Inputs<1>::s1{"aw*lSe4frliaw"}; +template<> FcharData<1> Inputs<1>::s2{"8\n e7t4$%&52Z"}; +template<> FcharData<1> Inputs<1>::s3{"quAli64^&$*#$8gl6"}; + +template<> FcharData<2> Inputs<2>::s1{u"\u4e4dhy7&3o8%\u4e24"}; +template<> FcharData<2> Inputs<2>::s2{u"\u4f60\u4e0d\u662f F18 !\uff1f"}; +template<> +FcharData<2> Inputs<2>::s3{ + u"\u4f60\u597d\uff0c\u6211\u66df F18 ! \u4f60\u5462\uff1f"}; + +template<> FcharData<4> Inputs<4>::s1{U"\u4e4dhy7&3o8%\u4e24"}; +template<> FcharData<4> Inputs<4>::s2{U"\u4f60\u4e0d\u662f F18 !\uff1f"}; +template<> +FcharData<4> Inputs<4>::s3{ + U"\u4f60\u597d\uff0c\u6211\u66df F18 ! \u4f60\u5462\uff1f"}; + +// Test simple assignment +extern "C" { +// Declare Fortran subroutine to be tested +// +// SUBROUTINE assignK(s1, s2) +// CHARACTER(*, K) :: s1, s2 +// s1 = s2 +// END SUBROUTINE +void _QPassign1(Fchar, Fchar); +void _QPassign2(Fchar, Fchar); +void _QPassign4(Fchar, Fchar); +} + +template +void TestNormalAssignement(Func testedSub, int &tests, int &passed) { + auto &s1{Inputs::s1}; + auto &s2{Inputs::s2}; + auto &s3{Inputs::s3}; + + assert(s1.len == s2.len && s1.len < s3.len && + "Test requires len(s1) = len(s2) < len(s3)"); + const std::string &desc{"normal character assignment"}; + + // s1 = s2 ! len(s1) == len(s3) + tests++; + if (TestSubroutine(desc, testedSub, s1, /* expect*/ s2, s2, /*expect*/ s2)) { + passed++; + } + + // s1 = s3 ! len(s1) < len(s3) + FcharData s3Tos1{s3.data.substr(0, s1.len)}; + tests++; + if (TestSubroutine(desc, testedSub, s1, /* expect*/ s3Tos1, s3, s3)) { + passed++; + } + + // s3 = s1 ! len(s1) < len(s3) + using ST = typename CharStorage::Type; + FcharData s1Tos3{ + s1.data.substr(0, s1.len) + ST(s3.len - s1.len, /* space */ 0x20)}; + tests++; + if (TestSubroutine(desc, testedSub, s3, /* expect*/ s1Tos3, s1, s1)) { + passed++; + } +} + +// Test substring assignment +extern "C" { +// SUBROUTINE assign_substringK(s1, s2, lb, ub) +// CHARACTER(*, K) :: s1, s2 +// INTEGER :: lb, ub +// s1(lb:ub) = s2 +// END SUBROUTINE +void _QPassign_substring1(Fchar s1, Fchar s2, int *lb, int *ub); +void _QPassign_substring2(Fchar, Fchar, int *, int *); +void _QPassign_substring4(Fchar, Fchar, int *, int *); +} + +template +void TestSubstringAssignement(Func testedSub, int &tests, int &passed) { + auto &s1{Inputs::s3}; + auto &s2{Inputs::s1}; + int lb{3}; + int ub{14}; + assert(1 <= lb && lb < ub && ub <= s1.len && "Failed test requirements"); + const std::string &desc{"substring character assignment"}; + + // s1(lb:ub) = s2 + auto delta{ub - lb + 1}; + auto s2CpyLen{s2.len < delta ? s2.len : delta}; + auto str{s1.data.substr(0, lb - 1) + s2.data.substr(0, s2CpyLen)}; + if (auto padding{delta - s2.len}; padding >= 0) { + using ST = typename CharStorage::Type; + str += ST(padding, /* space */ 0x20); + } + FcharData expected{str + s1.data.substr(ub, s1.len - ub)}; + tests++; + if (TestSubroutine(desc, testedSub, s1, expected, s2, s2, &lb, &ub)) { + passed++; + } +} + +// Test when RHS depends on LHS in a way that require a temp to evaluate RHS +extern "C" { +// SUBROUTINE assign_overlapK(s1, s2, lb) +// CHARACTER(*, K) :: s1, s2 +// INTEGER :: lb +// s1(lb:) = s2 +// END SUBROUTINE +void _QPassign_overlap1(Fchar s1, Fchar s2, int *lb); +void _QPassign_overlap2(Fchar, Fchar, int *); +void _QPassign_overlap4(Fchar, Fchar, int *); +} + +template +void TestOverlappingAssignement(Func testedSub, int &tests, int &passed) { + auto &s1{Inputs::s1}; + auto &s2{Inputs::s2}; + int lb{2}; + assert(lb >= 2 && "Test requires lb>=2"); + assert(s1.len >= lb && "Test requires len(s1)>=lb"); + const std::string &desc{"overlapping character assignment"}; + + // s1(lb:) = s1 ! len(s1) >= lb + auto delta{lb - 1}; + FcharData expected{ + s1.data.substr(0, delta) + s1.data.substr(0, s1.len - delta)}; + tests++; + if (TestSubroutine(desc, testedSub, s1, expected, s2, s2, &lb)) { + passed++; + } +} + +// Test assignment of character whose length is specified in specification +// expression. +extern "C" { +// SUBROUTINE assign_spec_expr_lenK(s1, s2, l1, l2) +// INTEGER :: l1, l2 +// CHARACTER(l1, K) :: s1 +// CHARACTER(l2, K) :: s2 +// s1 = s2 +// END SUBROUTINE +void _QPassign_spec_expr_len1(Fchar s1, Fchar s2, int *l1, int *l2); +void _QPassign_spec_expr_len2(Fchar s1, Fchar s2, int *l1, int *l2); +void _QPassign_spec_expr_len4(Fchar s1, Fchar s2, int *l1, int *l2); +} + +template +void TestSpecExprLenAssignement(Func testedSub, int &tests, int &passed) { + auto &s1{Inputs::s1}; + auto &s2{Inputs::s2}; + auto &s3{Inputs::s3}; + + int l1{static_cast(s1.len / 2)}; + int l2{static_cast(s2.len / 2)}; + int l3{static_cast(s3.len / 2)}; + assert(l1 == l2 && l1 < l3 && "Test requires l1 = l2 < l3"); + const std::string &desc{"assignment of character with specified expr length"}; + + // s1 = s2 ! l1 == l3 + tests++; + FcharData expect1{ + s2.data.substr(0, l1) + s1.data.substr(l1, s1.len - l1)}; + if (TestSubroutine(desc, testedSub, s1, expect1, s2, s2, &l1, &l2)) { + passed++; + } + + // s1 = s3 ! l1 < l3 + FcharData expect2{ + s3.data.substr(0, l1) + s1.data.substr(l1, s1.len - l1)}; + tests++; + if (TestSubroutine(desc, testedSub, s1, expect2, s3, s3, &l1, &l3)) { + passed++; + } + + // s3 = s1 ! l1 < l3 + using ST = typename CharStorage::Type; + FcharData expect3{s1.data.substr(0, l1) + + ST(l3 - l1, /* space */ 0x20) + s3.data.substr(l3, s3.len - l3)}; + tests++; + if (TestSubroutine(desc, testedSub, s3, expect3, s1, s1, &l3, &l1)) { + passed++; + } +} + +int main(int, char **) { + int tests{0}, passed{0}; + + TestNormalAssignement<1>(_QPassign1, tests, passed); + TestNormalAssignement<2>(_QPassign2, tests, passed); + TestNormalAssignement<4>(_QPassign4, tests, passed); + + TestSubstringAssignement<1>(_QPassign_substring1, tests, passed); + TestSubstringAssignement<2>(_QPassign_substring2, tests, passed); + TestSubstringAssignement<4>(_QPassign_substring4, tests, passed); + + TestOverlappingAssignement<1>(_QPassign_overlap1, tests, passed); + TestOverlappingAssignement<2>(_QPassign_overlap2, tests, passed); + TestOverlappingAssignement<4>(_QPassign_overlap4, tests, passed); + + TestSpecExprLenAssignement<1>(_QPassign_spec_expr_len1, tests, passed); + TestSpecExprLenAssignement<2>(_QPassign_spec_expr_len2, tests, passed); + TestSpecExprLenAssignement<4>(_QPassign_spec_expr_len4, tests, passed); + + std::cout << passed << " tests passed out of " << tests << std::endl; + return tests == passed ? 0 : -1; +} diff --git a/flang/test/Lower/end-to-end-character-assignment.f90 b/flang/test/Lower/end-to-end-character-assignment.f90 new file mode 100644 index 0000000000000..444993ad32984 --- /dev/null +++ b/flang/test/Lower/end-to-end-character-assignment.f90 @@ -0,0 +1,76 @@ +! RUN: bbc -emit-llvm -o - %s | tco | llc | as -o %t +! RUN: %CXX -std=c++17 %t %S/end-to-end-character-assignment-driver.cpp +! RUN: ./a.out + +! This is an end-to-end test that is driven from a c++ program that builds +! characters, pass them to this functions and checks expected results. + +! Simple character assignment tests +subroutine assign1(s1, s2) + character(*, 1) :: s1, s2 + s1 = s2 +end subroutine +subroutine assign2(s1, s2) + character(*, 2) :: s1, s2 + s1 = s2 +end subroutine +subroutine assign4(s1, s2) + character(*, 4) :: s1, s2 + s1 = s2 +end subroutine + +! Test substring assignment +subroutine assign_substring1(s1, s2, lb, ub) + character(*, 1) :: s1, s2 + integer :: lb, ub + s1(lb:ub) = s2 +end subroutine +subroutine assign_substring2(s1, s2, lb, ub) + character(*, 2) :: s1, s2 + integer :: lb, ub + s1(lb:ub) = s2 +end subroutine +subroutine assign_substring4(s1, s2, lb, ub) + character(*, 4) :: s1, s2 + integer :: lb, ub + s1(lb:ub) = s2 +end subroutine + +! Test overlapping assignments +! RHS depends on LHS in a way that if no temp is made to evaluate +! RHS, these tests should fail. +subroutine assign_overlap1(s1, s2, lb) + character(*, 1) :: s1, s2 + integer :: lb + s1(lb:) = s1 +end subroutine +subroutine assign_overlap2(s1, s2, lb) + character(*, 2) :: s1, s2 + integer :: lb + s1(lb:) = s1 +end subroutine +subroutine assign_overlap4(s1, s2, lb) + character(*, 4) :: s1, s2 + integer :: lb + s1(lb:) = s1 +end subroutine + +! Test when length is given in specification expressions +subroutine assign_spec_expr_len1(s1, s2, l1, l2) + integer :: l1, l2 + character(l1, 1) :: s1 + character(l2, 1) :: s2 + s1 = s2 +end subroutine +subroutine assign_spec_expr_len2(s1, s2, l1, l2) + integer :: l1, l2 + character(l1, 2) :: s1 + character(l2, 2) :: s2 + s1 = s2 +end subroutine +subroutine assign_spec_expr_len4(s1, s2, l1, l2) + integer :: l1, l2 + character(l1, 4) :: s1 + character(l2, 4) :: s2 + s1 = s2 +end subroutine diff --git a/flang/test/Lower/integer-operations.f90 b/flang/test/Lower/integer-operations.f90 new file mode 100644 index 0000000000000..f230d359cd949 --- /dev/null +++ b/flang/test/Lower/integer-operations.f90 @@ -0,0 +1,111 @@ +! RUN: bbc %s -o "-" | FileCheck %s + +! Test integer intrinsic operation lowering to fir. + +! CHECK-LABEL:eq0_test +LOGICAL FUNCTION eq0_test(x0, x1) +INTEGER(4) :: x0 +INTEGER(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = cmpi "eq", [[reg1]], [[reg2]] : i32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +eq0_test = x0 .EQ. x1 +END FUNCTION + +! CHECK-LABEL:ne1_test +LOGICAL FUNCTION ne1_test(x0, x1) +INTEGER(4) :: x0 +INTEGER(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = cmpi "ne", [[reg1]], [[reg2]] : i32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +ne1_test = x0 .NE. x1 +END FUNCTION + +! CHECK-LABEL:lt2_test +LOGICAL FUNCTION lt2_test(x0, x1) +INTEGER(4) :: x0 +INTEGER(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = cmpi "slt", [[reg1]], [[reg2]] : i32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +lt2_test = x0 .LT. x1 +END FUNCTION + +! CHECK-LABEL:le3_test +LOGICAL FUNCTION le3_test(x0, x1) +INTEGER(4) :: x0 +INTEGER(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = cmpi "sle", [[reg1]], [[reg2]] : i32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +le3_test = x0 .LE. x1 +END FUNCTION + +! CHECK-LABEL:gt4_test +LOGICAL FUNCTION gt4_test(x0, x1) +INTEGER(4) :: x0 +INTEGER(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = cmpi "sgt", [[reg1]], [[reg2]] : i32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +gt4_test = x0 .GT. x1 +END FUNCTION + +! CHECK-LABEL:ge5_test +LOGICAL FUNCTION ge5_test(x0, x1) +INTEGER(4) :: x0 +INTEGER(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = cmpi "sge", [[reg1]], [[reg2]] : i32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +ge5_test = x0 .GE. x1 +END FUNCTION + +! CHECK-LABEL:add6_test +INTEGER(4) FUNCTION add6_test(x0, x1) +INTEGER(4) :: x0 +INTEGER(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:addi [[reg1]], [[reg2]] : i32 +add6_test = x0 + x1 +END FUNCTION + +! CHECK-LABEL:sub7_test +INTEGER(4) FUNCTION sub7_test(x0, x1) +INTEGER(4) :: x0 +INTEGER(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:subi [[reg1]], [[reg2]] : i32 +sub7_test = x0 - x1 +END FUNCTION + +! CHECK-LABEL:mult8_test +INTEGER(4) FUNCTION mult8_test(x0, x1) +INTEGER(4) :: x0 +INTEGER(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:muli [[reg1]], [[reg2]] : i32 +mult8_test = x0 * x1 +END FUNCTION + +! CHECK-LABEL:div9_test +INTEGER(4) FUNCTION div9_test(x0, x1) +INTEGER(4) :: x0 +INTEGER(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:divi_signed [[reg1]], [[reg2]] : i32 +div9_test = x0 / x1 +END FUNCTION + +! End of generated test file diff --git a/flang/test/Lower/io-stmt.f90 b/flang/test/Lower/io-stmt.f90 new file mode 100644 index 0000000000000..cceacc958931b --- /dev/null +++ b/flang/test/Lower/io-stmt.f90 @@ -0,0 +1,52 @@ +! RUN: bbc %s -o - | FileCheck %s + +! CHECK-LABEL: _QQmain +! CHECK: call {{.*}}BeginOpenUnit +! CHECK-DAG: call {{.*}}SetFile +! CHECK-DAG: call {{.*}}SetAccess +! CHECK: call {{.*}}EndIoStatement + + open(8, file="foo", access="sequential") + +! CHECK: call {{.*}}BeginBackspace +! CHECK: call {{.*}}EndIoStatement + backspace(8) + +! CHECK: call {{.*}}BeginFlush +! CHECK: call {{.*}}EndIoStatement + flush(8) + +! CHECK: call {{.*}}BeginRewind +! CHECK: call {{.*}}EndIoStatement + rewind(8) + +! CHECK: call {{.*}}BeginEndfile +! CHECK: call {{.*}}EndIoStatement + endfile(8) + +! CHECK: call {{.*}}BeginWaitAll +! CHECK: call {{.*}}EndIoStatement + wait(unit=8) + +! CHECK: call {{.*}}BeginExternalListInput +! CHECK: call {{.*}}InputInteger +! CHECK: call {{.*}}InputReal32 +! CHECK: call {{.*}}EndIoStatement + read (8,*) i, f + +! CHECK: call {{.*}}BeginExternalListOutput +! 32 bit integers are output as 64 bits in the runtime API +! CHECK: call {{.*}}OutputInteger64 +! CHECK: call {{.*}}OutputReal32 +! CHECK: call {{.*}}EndIoStatement + write (8,*) i, f + +! CHECK: call {{.*}}BeginClose +! CHECK: call {{.*}}EndIoStatement + close(8) + +! CHECK: call {{.*}}BeginExternalListOutput +! CHECK: call {{.*}}OutputAscii +! CHECK: call {{.*}}EndIoStatement + print *, "A literal string" +end diff --git a/flang/test/Lower/logical-operations.f90 b/flang/test/Lower/logical-operations.f90 new file mode 100644 index 0000000000000..50a037043a891 --- /dev/null +++ b/flang/test/Lower/logical-operations.f90 @@ -0,0 +1,67 @@ +! RUN: bbc %s -o "-" | FileCheck %s + +! Test logical intrinsic operation lowering to fir. + +! CHECK-LABEL:eqv0_test +LOGICAL(1) FUNCTION eqv0_test(x0, x1) +LOGICAL(1) :: x0 +LOGICAL(1) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK-DAG:[[reg3:%[0-9]+]] = fir.convert [[reg1]] {{.*}} -> i1 +! CHECK-DAG:[[reg4:%[0-9]+]] = fir.convert [[reg2]] {{.*}} -> i1 +! CHECK:[[reg5:%[0-9]+]] = cmpi "eq", [[reg3]], [[reg4]] +! CHECK:fir.convert [[reg5]] {{.*}} -> !fir.logical<1> +eqv0_test = x0 .EQV. x1 +END FUNCTION + +! CHECK-LABEL:neqv1_test +LOGICAL(1) FUNCTION neqv1_test(x0, x1) +LOGICAL(1) :: x0 +LOGICAL(1) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK-DAG:[[reg3:%[0-9]+]] = fir.convert [[reg1]] {{.*}} -> i1 +! CHECK-DAG:[[reg4:%[0-9]+]] = fir.convert [[reg2]] {{.*}} -> i1 +! CHECK:[[reg5:%[0-9]+]] = cmpi "ne", [[reg3]], [[reg4]] +! CHECK:fir.convert [[reg5]] {{.*}} -> !fir.logical<1> +neqv1_test = x0 .NEQV. x1 +END FUNCTION + +! CHECK-LABEL:or2_test +LOGICAL(1) FUNCTION or2_test(x0, x1) +LOGICAL(1) :: x0 +LOGICAL(1) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK-DAG:[[reg3:%[0-9]+]] = fir.convert [[reg1]] {{.*}} -> i1 +! CHECK-DAG:[[reg4:%[0-9]+]] = fir.convert [[reg2]] {{.*}} -> i1 +! CHECK:[[reg5:%[0-9]+]] = or [[reg3]], [[reg4]] +! CHECK:fir.convert [[reg5]] {{.*}} -> !fir.logical<1> +or2_test = x0 .OR. x1 +END FUNCTION + +! CHECK-LABEL:and3_test +LOGICAL(1) FUNCTION and3_test(x0, x1) +LOGICAL(1) :: x0 +LOGICAL(1) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK-DAG:[[reg3:%[0-9]+]] = fir.convert [[reg1]] {{.*}} -> i1 +! CHECK-DAG:[[reg4:%[0-9]+]] = fir.convert [[reg2]] {{.*}} -> i1 +! CHECK:[[reg5:%[0-9]+]] = and [[reg3]], [[reg4]] +! CHECK:fir.convert [[reg5]] {{.*}} -> !fir.logical<1> +and3_test = x0 .AND. x1 +END FUNCTION + +! CHECK-LABEL:not4_test +LOGICAL(1) FUNCTION not4_test(x0) +LOGICAL(1) :: x0 +! CHECK:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK:[[reg2:%[0-9]+]] = fir.convert [[reg1]] {{.*}} -> i1 +! CHECK:[[reg3:%[0-9]+]] = xor [[reg2]], %true +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<1> +not4_test = .NOT. x0 +END FUNCTION + +! End of generated test file diff --git a/flang/test/Lower/program-units-fir-mangling.f90 b/flang/test/Lower/program-units-fir-mangling.f90 new file mode 100644 index 0000000000000..ee6461c78ee06 --- /dev/null +++ b/flang/test/Lower/program-units-fir-mangling.f90 @@ -0,0 +1,117 @@ +! RUN: bbc %s -o "-" -emit-fir | FileCheck %s + +! CHECK-LABEL: func @_QPsub() { +subroutine sub() +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QPasubroutine() { +subroutine AsUbRoUtInE() +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QPfoo() -> f32 { +function foo() + real(4) :: foo +! CHECK: } +end function + +module testMod +contains + ! CHECK-LABEL: func @_QMtestmodPsub() { + subroutine sub() + ! CHECK: } + end subroutine + + ! CHECK-LABEL: func @_QMtestmodPfoo() -> f32 { + function foo() + real(4) :: foo + ! CHECK: } + end function +end module + + +! CHECK-LABEL: func @_QPfoo2() +function foo2() + real(4) :: foo2 +contains + ! CHECK-LABEL: func @_QFfoo2Psub() { + subroutine sub() + ! CHECK: } + end subroutine + + ! CHECK-LABEL: func @_QFfoo2Pfoo() { + subroutine foo() + ! CHECK: } + end subroutine +end function + +! CHECK-LABEL: func @_QPsub2() +subroutine sUb2() +contains + ! CHECK-LABEL: func @_QFsub2Psub() { + subroutine sub() + ! CHECK: } + end subroutine + + ! CHECK-LABEL: func @_QFsub2Pfoo() { + subroutine Foo() + ! CHECK: } + end subroutine +end subroutine + +module testMod2 +contains + ! CHECK-LABEL: func @_QMtestmod2Psub() + subroutine sub() + contains + ! CHECK-LABEL: func @_QMtestmod2FsubPsubsub() { + subroutine subSub() + ! CHECK: } + end subroutine + end subroutine +end module + + +module color_points + interface + module subroutine draw() + end subroutine + module function erase() + integer(4) :: erase + end function + end interface +end module color_points + +submodule (color_points) color_points_a +contains + ! CHECK-LABEL: func @_QMcolor_pointsScolor_points_aPsub() { + subroutine sub + end subroutine + ! CHECK: } +end submodule + +submodule (color_points:color_points_a) impl +contains + ! CHECK-LABEL: func @_QMcolor_pointsScolor_points_aSimplPfoo() + subroutine foo + contains + ! CHECK-LABEL: func @_QMcolor_pointsScolor_points_aSimplFfooPbar() { + subroutine bar + ! CHECK: } + end subroutine + end subroutine + ! CHECK-LABEL: func @_QMcolor_pointsPdraw() { + module subroutine draw() + end subroutine + !FIXME func @_QMcolor_pointsPerase() -> i32 { + module procedure erase + ! CHECK: } + end procedure +end submodule + + +! CHECK-LABEL: func @_QQmain() { +program test +! CHECK: } +end program diff --git a/flang/test/Lower/real-operations.f90 b/flang/test/Lower/real-operations.f90 new file mode 100644 index 0000000000000..fa1bcace7675b --- /dev/null +++ b/flang/test/Lower/real-operations.f90 @@ -0,0 +1,111 @@ +! RUN: bbc %s -o "-" | FileCheck %s + +! Test real intrinsic operation lowering to FIR. + +! CHECK-LABEL:eq0_test +LOGICAL FUNCTION eq0_test(x0, x1) +REAL(4) :: x0 +REAL(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = fir.cmpf "oeq", [[reg1]], [[reg2]] : f32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +eq0_test = x0 .EQ. x1 +END FUNCTION + +! CHECK-LABEL:ne1_test +LOGICAL FUNCTION ne1_test(x0, x1) +REAL(4) :: x0 +REAL(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = fir.cmpf "une", [[reg1]], [[reg2]] : f32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +ne1_test = x0 .NE. x1 +END FUNCTION + +! CHECK-LABEL:lt2_test +LOGICAL FUNCTION lt2_test(x0, x1) +REAL(4) :: x0 +REAL(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = fir.cmpf "olt", [[reg1]], [[reg2]] : f32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +lt2_test = x0 .LT. x1 +END FUNCTION + +! CHECK-LABEL:le3_test +LOGICAL FUNCTION le3_test(x0, x1) +REAL(4) :: x0 +REAL(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = fir.cmpf "ole", [[reg1]], [[reg2]] : f32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +le3_test = x0 .LE. x1 +END FUNCTION + +! CHECK-LABEL:gt4_test +LOGICAL FUNCTION gt4_test(x0, x1) +REAL(4) :: x0 +REAL(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = fir.cmpf "ogt", [[reg1]], [[reg2]] : f32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +gt4_test = x0 .GT. x1 +END FUNCTION + +! CHECK-LABEL:ge5_test +LOGICAL FUNCTION ge5_test(x0, x1) +REAL(4) :: x0 +REAL(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:[[reg3:%[0-9]+]] = fir.cmpf "oge", [[reg1]], [[reg2]] : f32 +! CHECK:fir.convert [[reg3]] {{.*}} -> !fir.logical<4> +ge5_test = x0 .GE. x1 +END FUNCTION + +! CHECK-LABEL:add6_test +REAL(4) FUNCTION add6_test(x0, x1) +REAL(4) :: x0 +REAL(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:fir.addf [[reg1]], [[reg2]] : f32 +add6_test = x0 + x1 +END FUNCTION + +! CHECK-LABEL:sub7_test +REAL(4) FUNCTION sub7_test(x0, x1) +REAL(4) :: x0 +REAL(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:fir.subf [[reg1]], [[reg2]] : f32 +sub7_test = x0 - x1 +END FUNCTION + +! CHECK-LABEL:mult8_test +REAL(4) FUNCTION mult8_test(x0, x1) +REAL(4) :: x0 +REAL(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:fir.mulf [[reg1]], [[reg2]] : f32 +mult8_test = x0 * x1 +END FUNCTION + +! CHECK-LABEL:div9_test +REAL(4) FUNCTION div9_test(x0, x1) +REAL(4) :: x0 +REAL(4) :: x1 +! CHECK-DAG:[[reg1:%[0-9]+]] = fir.load %arg0 +! CHECK-DAG:[[reg2:%[0-9]+]] = fir.load %arg1 +! CHECK:fir.divf [[reg1]], [[reg2]] : f32 +div9_test = x0 / x1 +END FUNCTION + +! End of generated test file diff --git a/flang/test/lit.cfg.py b/flang/test/lit.cfg.py index 4109400087e53..3e22db86de218 100644 --- a/flang/test/lit.cfg.py +++ b/flang/test/lit.cfg.py @@ -29,6 +29,13 @@ '.ff90', '.f95', '.F95', '.ff95', '.fpp', '.FPP', '.cuf' '.CUF', '.f18', '.F18', '.fir', '.f03', '.F03', '.f08', '.F08'] +# test_source_root: The root path where tests are located. +config.test_source_root = os.path.dirname(__file__) + + +# test_exec_root: The root path where tests should be run. +config.test_exec_root = os.path.join(config.flang_obj_root, 'test') + config.substitutions.append(('%PATH%', config.environment['PATH'])) llvm_config.use_default_substitutions() @@ -54,6 +61,10 @@ # Tweak the PATH to include the tools dir. llvm_config.with_environment('PATH', config.flang_tools_dir, append_path=True) llvm_config.with_environment('PATH', config.llvm_tools_dir, append_path=True) +# For out-of-tree builds, path to bbc and tco needs to be added + +if config.llvm_tools_dir != config.flang_llvm_tools_dir : + llvm_config.with_environment('PATH', config.flang_llvm_tools_dir, append_path=True) if config.flang_standalone_build: # For builds with FIR, set path for tco and enable related tests @@ -62,6 +73,15 @@ if config.llvm_tools_dir != config.flang_llvm_tools_dir: llvm_config.with_environment('PATH', config.flang_llvm_tools_dir, append_path=True) +config.substitutions.append(('%B', config.flang_obj_root)) +config.substitutions.append(("%L", config.flang_lib_dir)) +if len(config.macos_sysroot) > 0: + config.substitutions.append(("%CXX", config.cplusplus_executable + " -isysroot " + config.macos_sysroot)) + config.substitutions.append(("%CC", config.c_executable + " -isysroot " + config.macos_sysroot)) +else: + config.substitutions.append(("%CXX", config.cplusplus_executable)) + config.substitutions.append(("%CC", config.c_executable)) + # For each occurrence of a flang tool name, replace it with the full path to # the build directory holding that tool. tools = [] diff --git a/flang/test/lit.site.cfg.py.in b/flang/test/lit.site.cfg.py.in index 7a59280283813..8f13c3013e024 100644 --- a/flang/test/lit.site.cfg.py.in +++ b/flang/test/lit.site.cfg.py.in @@ -2,14 +2,17 @@ import sys -config.llvm_tools_dir = "@LLVM_TOOLS_DIR@" +config.llvm_tools_dir = "@LLVM_TOOLS_BINARY_DIR@" config.flang_obj_root = "@FLANG_BINARY_DIR@" config.flang_src_dir = "@FLANG_SOURCE_DIR@" config.flang_tools_dir = "@FLANG_TOOLS_DIR@" config.flang_intrinsic_modules_dir = "@FLANG_INTRINSIC_MODULES_DIR@" config.flang_llvm_tools_dir = "@CMAKE_BINARY_DIR@/bin" +config.flang_lib_dir = "@LLVM_LIBRARY_OUTPUT_INTDIR@" config.python_executable = "@PYTHON_EXECUTABLE@" -config.flang_standalone_build = @FLANG_STANDALONE_BUILD@ +config.c_executable = "@CMAKE_C_COMPILER@" +config.cplusplus_executable = "@CMAKE_CXX_COMPILER@" +config.macos_sysroot = "@CMAKE_OSX_SYSROOT@" # Control the regression test for flang-new driver import lit.util diff --git a/flang/tools/CMakeLists.txt b/flang/tools/CMakeLists.txt index 98b20a1ff358b..f18a184839336 100644 --- a/flang/tools/CMakeLists.txt +++ b/flang/tools/CMakeLists.txt @@ -1,15 +1,8 @@ -#===-- tools/CMakeLists.txt ------------------------------------------------===# -# -# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -# See https://llvm.org/LICENSE.txt for license information. -# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -# -#===------------------------------------------------------------------------===# - add_subdirectory(f18) +add_subdirectory(f18-parse-demo) +add_subdirectory(fir-opt) +add_subdirectory(bbc) +add_subdirectory(tco) if(FLANG_BUILD_NEW_DRIVER) add_subdirectory(flang-driver) endif() -add_subdirectory(tco) -add_subdirectory(f18-parse-demo) -add_subdirectory(fir-opt) diff --git a/flang/tools/bbc/CMakeLists.txt b/flang/tools/bbc/CMakeLists.txt new file mode 100644 index 0000000000000..0398a2cac76ab --- /dev/null +++ b/flang/tools/bbc/CMakeLists.txt @@ -0,0 +1,20 @@ +set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-parameter") +get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) + +set(LIBS + FIRDialect + FIROptimizer + FIRTransforms + ${dialect_libs} + MLIRLLVMIR + MLIRAffineToStandard + FortranCommon + FortranParser + FortranEvaluate + FortranSemantics + FortranLower +) + +add_llvm_tool(bbc bbc.cpp) +llvm_update_compile_flags(bbc) +target_link_libraries(bbc PRIVATE ${LIBS}) diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp new file mode 100644 index 0000000000000..5d72d4812cbe8 --- /dev/null +++ b/flang/tools/bbc/bbc.cpp @@ -0,0 +1,274 @@ +//===- bbc.cpp - Burnside Bridge Compiler -----------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +/// +/// \file +/// This is a tool for translating Fortran sources to the FIR dialect of MLIR. +/// +//===----------------------------------------------------------------------===// + +#include "flang/Common/Fortran-features.h" +#include "flang/Common/default-kinds.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/ConvertExpr.h" +#include "flang/Optimizer/CodeGen/CodeGen.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Optimizer/Support/KindMapping.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "flang/Parser/characters.h" +#include "flang/Parser/dump-parse-tree.h" +#include "flang/Parser/message.h" +#include "flang/Parser/parse-tree-visitor.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Parser/parsing.h" +#include "flang/Parser/provenance.h" +#include "flang/Parser/unparse.h" +#include "flang/Semantics/expression.h" +#include "flang/Semantics/semantics.h" +#include "flang/Semantics/unparse-with-symbols.h" +#include "mlir/Conversion/LoopToStandard/ConvertLoopToStandard.h" +#include "mlir/IR/MLIRContext.h" +#include "mlir/IR/Module.h" +#include "mlir/Parser.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Pass/PassManager.h" +#include "mlir/Transforms/Passes.h" +#include "llvm/Support/CommandLine.h" +#include "llvm/Support/ErrorOr.h" +#include "llvm/Support/InitLLVM.h" +#include "llvm/Support/MemoryBuffer.h" +#include "llvm/Support/SourceMgr.h" +#include "llvm/Support/ToolOutputFile.h" +#include "llvm/Support/raw_ostream.h" + +//===----------------------------------------------------------------------===// +// Some basic command-line options +//===----------------------------------------------------------------------===// + +static llvm::cl::opt inputFilename(llvm::cl::Positional, + llvm::cl::Required, + llvm::cl::desc("")); + +static llvm::cl::opt + outputFilename("o", llvm::cl::desc("Specify the output filename"), + llvm::cl::value_desc("filename")); + +static llvm::cl::list + includeDirs("I", llvm::cl::desc("include search paths")); + +static llvm::cl::list + moduleDirs("module", llvm::cl::desc("module search paths")); + +static llvm::cl::opt + moduleSuffix("module-suffix", llvm::cl::desc("module file suffix override"), + llvm::cl::init(".mod")); + +static llvm::cl::opt + emitLLVM("emit-llvm", + llvm::cl::desc("Add passes to lower to and emit LLVM IR"), + llvm::cl::init(false)); + +static llvm::cl::opt + emitFIR("emit-fir", + llvm::cl::desc("Dump the FIR created by lowering and exit"), + llvm::cl::init(false)); + +static llvm::cl::opt fixedForm("Mfixed", + llvm::cl::desc("used fixed form"), + llvm::cl::init(false)); + +static llvm::cl::opt freeForm("Mfree", llvm::cl::desc("used free form"), + llvm::cl::init(false)); + +static llvm::cl::opt warnStdViolation("Mstandard", + llvm::cl::desc("emit warnings"), + llvm::cl::init(false)); + +static llvm::cl::opt warnIsError("Werror", + llvm::cl::desc("warnings are errors"), + llvm::cl::init(false)); + +static llvm::cl::opt dumpSymbols("dump-symbols", + llvm::cl::desc("dump the symbol table"), + llvm::cl::init(false)); + +//===----------------------------------------------------------------------===// + +namespace { + +// TODO: vestigal struct that should be deleted +struct DriverOptions { + Fortran::parser::Encoding encoding{Fortran::parser::Encoding::UTF_8}; + std::string prefix; +}; + +} // namespace + +static int exitStatus{EXIT_SUCCESS}; + +// Print the module without the "module { ... }" wrapper. +static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) { + for (auto &op : mlirModule.getBody()->without_terminator()) + out << op << '\n'; + out << '\n'; +} + +// Convert Fortran input to MLIR (target is FIR dialect) +static void convertFortranSourceToMLIR( + std::string path, Fortran::parser::Options options, DriverOptions &driver, + Fortran::semantics::SemanticsContext &semanticsContext) { + if (!(fixedForm || freeForm)) { + auto dot = path.rfind("."); + if (dot != std::string::npos) { + std::string suffix{path.substr(dot + 1)}; + options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff"; + } + } + + // prep for prescan and parse + options.searchDirectories = includeDirs; + Fortran::parser::Parsing parsing{semanticsContext.allSources()}; + parsing.Prescan(path, options); + if (!parsing.messages().empty() && + (warnIsError || parsing.messages().AnyFatalError())) { + llvm::errs() << driver.prefix << "could not scan " << path << '\n'; + parsing.messages().Emit(llvm::errs(), parsing.cooked()); + exitStatus = EXIT_FAILURE; + return; + } + + // parse the input Fortran + parsing.Parse(llvm::outs()); + parsing.messages().Emit(llvm::errs(), parsing.cooked()); + if (!parsing.consumedWholeFile()) { + parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(), + "parser FAIL (final position)"); + exitStatus = EXIT_FAILURE; + return; + } + if ((!parsing.messages().empty() && + (warnIsError || parsing.messages().AnyFatalError())) || + !parsing.parseTree().has_value()) { + llvm::errs() << driver.prefix << "could not parse " << path << '\n'; + exitStatus = EXIT_FAILURE; + return; + } + + // run semantics + auto &parseTree{*parsing.parseTree()}; + Fortran::semantics::Semantics semantics{semanticsContext, parseTree, + parsing.cooked()}; + semantics.Perform(); + semantics.EmitMessages(llvm::errs()); + if (semantics.AnyFatalError()) { + llvm::errs() << driver.prefix << "semantic errors in " << path << '\n'; + exitStatus = EXIT_FAILURE; + return; + } + if (dumpSymbols) + semantics.DumpSymbols(llvm::outs()); + + // MLIR+FIR + fir::NameUniquer nameUniquer; + auto burnside = Fortran::lower::LoweringBridge::create( + semanticsContext.defaultKinds(), &parsing.cooked()); + fir::KindMapping kindMap{&burnside.getMLIRContext()}; + burnside.lower(parseTree, nameUniquer); + mlir::ModuleOp mlirModule = burnside.getModule(); + std::error_code ec; + std::string outputName = outputFilename; + if (!outputName.size()) + outputName = llvm::sys::path::stem(inputFilename).str().append(".mlir"); + llvm::raw_fd_ostream out(outputName, ec); + if (ec) { + llvm::errs() << "could not open output file " << outputName << '\n'; + return; + } + if (emitFIR) { + // Do lowering, but nothing else. Dump FIR and exit. + printModule(mlirModule, out); + return; + } + + // Otherwise run the default passes. + mlir::PassManager pm(mlirModule.getContext()); + mlir::applyPassManagerCLOptions(pm); + pm.addPass(fir::createLowerToLoopPass()); + pm.addPass(fir::createFIRToStdPass(kindMap)); + pm.addPass(mlir::createLowerToCFGPass()); + pm.addPass(fir::createMemToRegPass()); + pm.addPass(fir::createCSEPass()); + pm.addPass(mlir::createCanonicalizerPass()); + + if (emitLLVM) { + // Continue to lower from MLIR down to LLVM IR. Emit LLVM and MLIR. + pm.addPass(fir::createFIRToLLVMPass(nameUniquer)); + std::error_code ec; + llvm::ToolOutputFile outFile(outputName + ".ll", ec, + llvm::sys::fs::OF_None); + if (ec) { + llvm::errs() << "can't open output file " + outputName + ".ll"; + return; + } + pm.addPass(fir::createLLVMDialectToLLVMPass(outFile.os())); + if (mlir::succeeded(pm.run(mlirModule))) { + outFile.keep(); + printModule(mlirModule, out); + return; + } + } else { + // Emit MLIR and do not lower to LLVM IR. + if (mlir::succeeded(pm.run(mlirModule))) { + printModule(mlirModule, out); + return; + } + } + // Something went wrong. Try to dump the MLIR module. + llvm::errs() << "oops, pass manager reported failure\n"; + mlirModule.dump(); +} + +int main(int argc, char **argv) { + fir::registerFIR(); + fir::registerFIRPasses(); + [[maybe_unused]] llvm::InitLLVM y(argc, argv); + + mlir::registerPassManagerCLOptions(); + mlir::PassPipelineCLParser passPipe("", "Compiler passes to run"); + llvm::cl::ParseCommandLineOptions(argc, argv, "Burnside Bridge Compiler\n"); + + DriverOptions driver; + driver.prefix = argv[0] + ": "s; + + if (includeDirs.size() == 0) + includeDirs.push_back("."); + if (moduleDirs.size() == 0) + moduleDirs.push_back("."); + + Fortran::parser::Options options; + options.predefinitions.emplace_back("__F18", "1"); + options.predefinitions.emplace_back("__F18_MAJOR__", "1"); + options.predefinitions.emplace_back("__F18_MINOR__", "1"); + options.predefinitions.emplace_back("__F18_PATCHLEVEL__", "1"); +#if __x86_64__ + options.predefinitions.emplace_back("__x86_64__", "1"); +#endif + + Fortran::common::IntrinsicTypeDefaultKinds defaultKinds; + Fortran::parser::AllSources allSources; + Fortran::semantics::SemanticsContext semanticsContext{ + defaultKinds, options.features, allSources}; + semanticsContext.set_moduleDirectory(moduleDirs.front()) + .set_moduleFileSuffix(moduleSuffix) + .set_searchDirectories(includeDirs) + .set_warnOnNonstandardUsage(warnStdViolation) + .set_warningsAreErrors(warnIsError); + + convertFortranSourceToMLIR(inputFilename, options, driver, semanticsContext); + return exitStatus; +} diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt index fc84bbf09c59d..e7ecd957ad79e 100644 --- a/flang/tools/f18/CMakeLists.txt +++ b/flang/tools/f18/CMakeLists.txt @@ -3,6 +3,9 @@ set(LLVM_LINK_COMPONENTS FrontendOpenMP Support ) + +set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-parameter") + add_flang_tool(f18 dump.cpp f18.cpp diff --git a/flang/tools/tco/CMakeLists.txt b/flang/tools/tco/CMakeLists.txt index 4a22427486d71..d206cc0d0c3e8 100644 --- a/flang/tools/tco/CMakeLists.txt +++ b/flang/tools/tco/CMakeLists.txt @@ -1,3 +1,4 @@ +set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-parameter") get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) set(LIBS diff --git a/flang/tools/tco/tco.cpp b/flang/tools/tco/tco.cpp index 62e31fe47ed14..aae6f962ce311 100644 --- a/flang/tools/tco/tco.cpp +++ b/flang/tools/tco/tco.cpp @@ -11,8 +11,13 @@ // //===----------------------------------------------------------------------===// +#include "flang/Optimizer/OptPasses.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/InitFIR.h" +#include "flang/Optimizer/Support/InternalNames.h" #include "flang/Optimizer/Support/KindMapping.h" +#include "mlir/Conversion/SCFToStandard/SCFToStandard.h" +#include "mlir/IR/AsmState.h" #include "mlir/IR/BuiltinOps.h" #include "mlir/IR/MLIRContext.h" #include "mlir/Parser.h" @@ -24,11 +29,13 @@ #include "llvm/Support/InitLLVM.h" #include "llvm/Support/MemoryBuffer.h" #include "llvm/Support/SourceMgr.h" +#include "llvm/Support/TargetSelect.h" #include "llvm/Support/ToolOutputFile.h" #include "llvm/Support/raw_ostream.h" using namespace llvm; +// list of program return codes static cl::opt inputFilename(cl::Positional, cl::desc(""), cl::init("-")); @@ -41,6 +48,10 @@ static cl::opt emitFir("emit-fir", cl::desc("Parse and pretty-print the input"), cl::init(false)); +static cl::opt targetTriple("target", + cl::desc("specify a target triple"), + cl::init("native")); + static void printModuleBody(mlir::ModuleOp mod, raw_ostream &output) { for (auto &op : mod.getBody()->without_terminator()) output << op << '\n'; @@ -64,6 +75,7 @@ compileFIR(const mlir::PassPipelineCLParser &passPipeline) { mlir::DialectRegistry registry; fir::support::registerDialects(registry); mlir::MLIRContext context(registry); + fir::support::loadDialects(context); auto owningRef = mlir::parseSourceFile(sourceMgr, &context); if (!owningRef) { @@ -79,21 +91,48 @@ compileFIR(const mlir::PassPipelineCLParser &passPipeline) { ToolOutputFile out(outputFilename, ec, sys::fs::OF_None); // run passes - mlir::PassManager pm{&context}; + fir::KindMapping kindMap{&context}; + fir::setTargetTriple(*owningRef, targetTriple); + fir::setKindMapping(*owningRef, kindMap); + mlir::PassManager pm(&context, mlir::OpPassManager::Nesting::Implicit); + pm.enableVerifier(/*verifyPasses=*/true); mlir::applyPassManagerCLOptions(pm); if (emitFir) { // parse the input and pretty-print it back out // -emit-fir intentionally disables all the passes + } else if (passPipeline.hasAnyOccurrences()) { + // FIXME: handle result + (void)passPipeline.addToPipeline(pm, [&](const Twine &msg) { + mlir::emitError(mlir::UnknownLoc::get(&context)) << msg; + return mlir::failure(); + }); } else { - // TODO: Actually add passes when added to FIR code base - // add all the passes - // the user can disable them individually + // simplify the IR + pm.addNestedPass(fir::createArrayValueCopyPass()); + pm.addPass(mlir::createCanonicalizerPass()); + pm.addNestedPass(fir::createCSEPass()); + pm.addPass(mlir::createInlinerPass()); + pm.addPass(mlir::createCSEPass()); + + // convert control flow to CFG form + pm.addNestedPass(fir::createFirToCfgPass()); + pm.addNestedPass(fir::createControlFlowLoweringPass()); + pm.addPass(mlir::createLowerToCFGPass()); + + pm.addPass(mlir::createCanonicalizerPass()); + pm.addNestedPass(fir::createCSEPass()); + + // pm.addPass(fir::createMemToRegPass()); + pm.addPass(fir::createFirCodeGenRewritePass()); + pm.addPass(fir::createFirTargetRewritePass()); + pm.addPass(fir::createFIRToLLVMPass()); + pm.addPass(fir::createLLVMDialectToLLVMPass(out.os())); } // run the pass manager if (mlir::succeeded(pm.run(*owningRef))) { // passes ran successfully, so keep the output - if (emitFir) + if (emitFir || passPipeline.hasAnyOccurrences()) printModuleBody(*owningRef, out.os()); out.keep(); return mlir::success(); @@ -106,8 +145,13 @@ compileFIR(const mlir::PassPipelineCLParser &passPipeline) { } int main(int argc, char **argv) { - fir::support::registerMLIRPassesForFortranTools(); + fir::support::registerFIRPasses(); + fir::registerOptPasses(); + [[maybe_unused]] InitLLVM y(argc, argv); + InitializeAllTargets(); + mlir::registerAsmPrinterCLOptions(); + mlir::registerMLIRContextCLOptions(); mlir::registerPassManagerCLOptions(); mlir::PassPipelineCLParser passPipe("", "Compiler passes to run"); cl::ParseCommandLineOptions(argc, argv, "Tilikum Crossing Optimizer\n"); From fde389b668576890209098e3e04e86f02937fa70 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 9 Apr 2020 10:17:59 -0700 Subject: [PATCH 0003/1017] Update README fix the fallout from the pass manager changes in MLIR lapack work More CHARACTER runtime support add lowering for CHARACTER comparison calls to the runtime [audit] add back changes that were lost with merge Work on adjustable arrays. - This requires analysis of local symbols. - To do that requires getting the symbol table (scope), which required threading the SemanticsContext for the main program. - Added sorting and sorrted symbol tables to the PFT. - Refactored temporaries. - Misc. refactoring to follow LLVM coding standard, etc. part 2 - implement the lower of variables With these changes, I can compile code like srot.f. A couple minor bug fixes implement format for data transfer statements update the lapack list add a check and TODO add plumbing to connect up character comparison; add test improve the folder for convert on bools DCE was broken. This adds back the Op traits to make it work correctly. Also tightens and repairs two tests, resp. Replace internal symbol map. The internal symbol map had served its purpose and needs to be replaced with a mapping structure that is more appropriate for Fortran variables, which can be composed of a number of runtime values. This new map will allow us to lower more complicated entities correctly by tracking their component values. --- flang/LAPACK-bugs.txt | 33 +- flang/include/flang/Lower/CharRT.h | 36 +++ flang/include/flang/Lower/ConvertExpr.h | 6 +- flang/lib/Lower/Bridge.cpp | 304 +++++++++++++----- flang/lib/Lower/CharRT.cpp | 132 ++++++++ flang/lib/Optimizer/CodeGen.cpp | 16 +- flang/lib/Optimizer/StdConverter.cpp | 3 +- flang/lib/Optimizer/Transforms/CSE.cpp | 11 +- flang/lib/Optimizer/Transforms/MemToReg.cpp | 10 +- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 5 +- flang/test/Fir/convert-fold.fir | 28 ++ flang/test/Fir/coordinate01.fir | 10 +- flang/test/Lower/character-compare.f90 | 10 + flang/tools/bbc/bbc.cpp | 4 +- unittests/Runtime/character.cpp | 59 ++++ 15 files changed, 553 insertions(+), 114 deletions(-) create mode 100644 flang/include/flang/Lower/CharRT.h create mode 100644 flang/lib/Lower/CharRT.cpp create mode 100644 flang/test/Fir/convert-fold.fir create mode 100644 flang/test/Lower/character-compare.f90 create mode 100644 unittests/Runtime/character.cpp diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index b1da627c1127b..a8fcc3408037c 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -1,18 +1,39 @@ NEED ATTENTION ______________ -[Eric] error: branch has N operands for successor #M, but target block has K -[Eric] UNREACHABLE executed at Lower/ConvertExpr.cpp:403! CHAR comparison +[Eric] -[Varun] UNREACHABLE executed at Lower/Bridge.cpp:1061! DATA -[Varun] UNREACHABLE executed at Lower/Bridge.cpp:1241! local w/ initializer (implied SAVE) + We do not correctly handle adjusted arrays of CHARACTER with adjusted LEN + . bbc: IR/Types.h:279: U mlir::Type::cast() const [U = fir::ReferenceType]: Assertion `isa()' failed. + +[Varun] + + DATA statement + . UNREACHABLE executed at Lower/Bridge.cpp:1102! + + Lowering globals in general + . UNREACHABLE executed at Lower/Bridge.cpp:1294! + +[Unassigned] + + Intrinsics lowering problems (3) + . bbc: Lower/Intrinsics.cpp:474: Assertion `!bestMatchDistance.isLoosingPrecision() && "runtime selection looses precision"' failed. + . bbc: Lower/Intrinsics.cpp:504: Assertion `arg != nullptr' failed. + . bbc: Lower/Intrinsics.cpp:628: Assertion `false && "no runtime found for this intrinsics"' failed. -UNREACHABLE executed at Lower/Bridge.cpp:1236! adjustable array? -UNREACHABLE executed at Lower/ConvertExpr.cpp:798! intrinsic subroutine FIXED _____ + +CHARACTER comparison calls: UNREACHABLE executed at Lower/ConvertExpr.cpp:405! + +UNREACHABLE executed at Lower/ConvertExpr.cpp:798! intrinsic subroutine + +UNREACHABLE executed at Lower/Bridge.cpp:1243! adjustable array + +error: branch has N operands for successor #M, but target block has K + UNREACHABLE executed at Lower/IO.cpp:764! FORMAT UNREACHABLE executed at Lower/ConvertExpr.cpp:848! temps on call? diff --git a/flang/include/flang/Lower/CharRT.h b/flang/include/flang/Lower/CharRT.h new file mode 100644 index 0000000000000..4be9480dbfb31 --- /dev/null +++ b/flang/include/flang/Lower/CharRT.h @@ -0,0 +1,36 @@ +//===-- Lower/CharRT.h -- lower CHARACTER operations ------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_CHARRT_H +#define FORTRAN_LOWER_CHARRT_H + +#include "mlir/Dialect/StandardOps/IR/Ops.h" + +namespace Fortran { +namespace lower { +class AbstractConverter; + +/// Generate call to a character comparison for two ssa-values of type +/// `boxchar`. +mlir::Value genBoxCharCompare(AbstractConverter &converter, mlir::Location loc, + mlir::CmpIPredicate cmp, mlir::Value lhs, + mlir::Value rhs); + +/// Generate call to a character comparison op for two unboxed variables. There +/// are 4 arguments, 2 for the lhs and 2 for the rhs. Each CHARACTER must pass a +/// reference to its buffer (`ref>`) and its LEN type parameter (some +/// integral type). +mlir::Value genRawCharCompare(AbstractConverter &converter, mlir::Location loc, + mlir::CmpIPredicate cmp, mlir::Value lhsBuff, + mlir::Value lhsLen, mlir::Value rhsBuff, + mlir::Value rhsLen); + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_CHARRT_H diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h index 3c7676a3956c2..2341ea9be4365 100644 --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -6,8 +6,8 @@ // //===----------------------------------------------------------------------===// -#ifndef FORTRAN_LOWER_CONVERT_EXPR_H_ -#define FORTRAN_LOWER_CONVERT_EXPR_H_ +#ifndef FORTRAN_LOWER_CONVERT_EXPR_H +#define FORTRAN_LOWER_CONVERT_EXPR_H #include "Intrinsics.h" @@ -70,4 +70,4 @@ mlir::Value createSomeAddress(mlir::Location loc, AbstractConverter &converter, } // namespace lower } // namespace Fortran -#endif // FORTRAN_LOWER_CONVERT_EXPR_H_ +#endif // FORTRAN_LOWER_CONVERT_EXPR_H diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 65fc9c776ddfa..eba620ed1c565 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -7,6 +7,7 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/Bridge.h" +#include "SymbolMap.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/FIRBuilder.h" @@ -53,6 +54,11 @@ static llvm::cl::opt "name"), llvm::cl::init(32)); +static llvm::cl::opt + useOldInitializerCode("enable-old-initializer-lowering", + llvm::cl::desc("TODO: remove the old code!"), + llvm::cl::init(false), llvm::cl::Hidden); + namespace { /// Information for generating a structured or unstructured increment loop. struct IncrementLoopInfo { @@ -235,10 +241,37 @@ class FirConverter : public Fortran::lower::AbstractConverter { return createI1LogicalExpression(loc, *this, *expr, localSymbols, intrinsics); } + + /// Find the symbol in the local map or return null. + mlir::Value lookupSymbol(const Fortran::semantics::Symbol &sym) { + if (auto v = localSymbols.lookupSymbol(sym)) + return v; + return {}; + } + + /// Add the symbol to the local map. If the symbol is already in the map, it + /// is not updated. Instead the value `false` is returned. + bool addSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val, + bool forced = false) { + if (forced) { + localSymbols.erase(sym); + } else { + if (auto v = lookupSymbol(sym)) + return false; + } + localSymbols.addSymbol(sym, val); + return true; + } + mlir::Value createTemporary(mlir::Location loc, - const Fortran::semantics::Symbol &sym) { - return builder->createTemporary(loc, localSymbols, genType(sym), llvm::None, - &sym); + const Fortran::semantics::Symbol &sym, + llvm::ArrayRef shape = {}) { + if (auto v = lookupSymbol(sym)) + return v; + auto newVal = builder->createTemporary(loc, genType(sym), + sym.name().ToString(), shape); + addSymbol(sym, newVal); + return newVal; } mlir::FuncOp genFunctionFIR(llvm::StringRef callee, @@ -305,7 +338,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) { const auto &details = functionSymbol.get(); - auto resultRef = localSymbols.lookupSymbol(details.result()); + auto resultRef = lookupSymbol(details.result()); mlir::Value r = builder->create(toLocation(), resultRef); genExitFunction(r); } @@ -314,6 +347,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::semantics::Symbol &symbol) { if (Fortran::semantics::IsFunction(symbol)) { // FUNCTION + if (funit.finalBlock) + builder->setInsertionPoint(funit.finalBlock, funit.finalBlock->end()); genReturnSymbol(symbol); return; } @@ -343,10 +378,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { void switchInsertionPointToOtherwise(fir::WhereOp &where) { builder->setInsertionPointToStart(&where.otherRegion().front()); } - + template mlir::OpBuilder::InsertPoint genWhereCondition(fir::WhereOp &where, - const A *stmt) { + const A *stmt) { auto cond = createLogicalExprAsI1( toLocation(), Fortran::semantics::GetExpr( @@ -560,7 +595,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto tripCount = builder->create(location, adjusted, info.stepValue); info.tripVariable = - builder->createTemporary(location, localSymbols, info.loopVariableType); + builder->createTemporary(location, info.loopVariableType); builder->create(location, tripCount, info.tripVariable); builder->create(location, lowerValue, info.loopVariable); @@ -618,8 +653,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } else if (e.isA()) { // otherwise block switchInsertionPointToOtherwise(underWhere); - } else if (e.isA()) { - builder->restoreInsertionPoint(insPt); + } else if (e.isA()) { + builder->restoreInsertionPoint(insPt); } else { genFIR(e, /*unstructuredContext*/ false); } @@ -865,11 +900,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::PrintStmt &stmt) { - genPrintStatement(*this, stmt); + genPrintStatement(*this, stmt, + eval.getOwningProcedure()->labelEvaluationMap); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::ReadStmt &stmt) { - genReadStatement(*this, stmt); + genReadStatement(*this, stmt, + eval.getOwningProcedure()->labelEvaluationMap); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::RewindStmt &stmt) { @@ -877,7 +914,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::WriteStmt &stmt) { - genWriteStatement(*this, stmt); + genWriteStatement(*this, stmt, + eval.getOwningProcedure()->labelEvaluationMap); } void genFIR(Fortran::lower::pft::Evaluation &eval, @@ -998,7 +1036,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { [&](const Fortran::parser::Name &sym) { auto ty = genType(*sym.symbol); auto load = builder->create( - toLocation(), localSymbols.lookupSymbol(*sym.symbol)); + toLocation(), lookupSymbol(*sym.symbol)); auto idxTy = mlir::IndexType::get(&mlirContext); auto zero = builder->create( toLocation(), idxTy, builder->getIntegerAttr(idxTy, 0)); @@ -1048,7 +1086,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::FormatStmt &) { - TODO(); + // do nothing. FORMAT statements have no semantics. They may be lowered if + // used by a data transfer statement. } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::EntryStmt &) { @@ -1171,7 +1210,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } /// Evaluate specification expressions of local symbol and add - /// the resulting mlir::value to localSymbols. + /// the resulting `mlir::Value` to localSymbols. /// Before evaluating a specification expression, the symbols /// appearing in the expression are gathered, and if they are also /// local symbols, their specification are evaluated first. In case @@ -1180,7 +1219,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::semantics::Symbol &symbol, Fortran::lower::SymMap &dummyArgs, llvm::DenseSet attempted) { - if (localSymbols.lookupSymbol(symbol)) + if (lookupSymbol(symbol)) return; // already instantiated if (IsProcedure(symbol)) @@ -1222,12 +1261,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(localValue && "expected dummy arguments when length not explicit"); } - localSymbols.addSymbol(symbol, localValue); + addSymbol(symbol, localValue); } else if (!type->AsIntrinsic()) { TODO(); // Derived type / polymorphic } else { if (auto actualValue = dummyArgs.lookupSymbol(symbol)) - localSymbols.addSymbol(symbol, actualValue); + addSymbol(symbol, actualValue); else createTemporary(toLocation(), symbol); } @@ -1249,6 +1288,127 @@ class FirConverter : public Fortran::lower::AbstractConverter { attempted.erase(symbol); } + /// Instantiate a global variable. If it hasn't already been processed, add + /// the global to the ModuleOp as a new uniqued symbol and initialize it with + /// the correct value. It will be referenced on demand using `fir.addr_of`. + void instantiateGlobal(const Fortran::lower::pft::Variable &var) { + llvm_unreachable("Varun: put your code here"); + } + + // FIXME: This is not quite right. The constant rows should *NOT* be entered + // into the shape. (This will allocate too much space.) + bool collectVariableDynamicShape(llvm::SmallVectorImpl &shape, + const Fortran::semantics::Symbol &sym) { + if (const auto *det = + sym.detailsIf()) { + const auto &shapeSpec = det->shape(); + if (isConstantShape(shapeSpec)) + return false; + for (const auto &subs : shapeSpec) { + if (subs.lbound().isExplicit() && subs.ubound().isExplicit()) { + auto lo = builder->convertToIndexType(genExprValue( + Fortran::semantics::SomeExpr(*subs.lbound().GetExplicit()))); + auto hi = builder->convertToIndexType(genExprValue( + Fortran::semantics::SomeExpr(*subs.ubound().GetExplicit()))); + auto one = builder->createIntegerConstant(builder->getIndexType(), 1); + auto loc = toLocation(); + auto diff = builder->create(loc, hi, lo); + auto sizeDim = builder->create(loc, one, diff); + shape.push_back(sizeDim); + } else { + TODO(); + } + } + return true; + } + return false; + } + + /// Create a stack slot for a local variable. Precondition: the insertion + /// point of the builder must be in the entry block, which is currently being + /// constructed. + mlir::Value createNewLocal(mlir::Location loc, + const Fortran::semantics::Symbol &sym, + llvm::ArrayRef shape = {}) { + return builder->create( + loc, genType(sym), sym.name().ToString(), llvm::None, shape); + } + + /// Instantiate a local variable. Precondition: Each variable will be visited + /// such that if it depends on other variables, the variables upon which it + /// depends will already have been visited. + void instantiateLocal(const Fortran::lower::pft::Variable &var) { + const auto &sym = var.getSymbol(); + + // If this is an array, collect it's dynamic shape. If it's size is constant + // `shape` will have no size. + llvm::SmallVector shape; + auto hasDynamicShape = collectVariableDynamicShape(shape, sym); + + const auto *type = sym.GetType(); + auto loc = toLocation(); + if (type->category() == Fortran::semantics::DeclTypeSpec::Character) { + const auto &lengthParam = type->characterTypeSpec().length(); + if (auto expr = lengthParam.GetExplicit()) { + auto len = + genExprValue(Fortran::evaluate::AsGenericExpr(std::move(*expr))); + if (Fortran::semantics::IsDummy(sym)) { + if (hasDynamicShape) { + // case: `CHARACTER(LEN=i_arg) :: c_var(dims)` + TODO(); + } + // case: `CHARACTER(LEN=i_arg) :: c_arg` + // Rebox the argument with the user-specified length. An alternative + // lowering would be to unbox the buffer reference and keep track of + // it and the length in the lookup table. + + // NOTE: we could have a debug mode to generate diagnostic code to + // verify that the reboxing is simpatico. + auto original = lookupSymbol(sym); + auto unboxed = builder->createUnboxChar(original); + addSymbol(sym, builder->createEmboxChar(unboxed.first, len), + /*forced=*/true); + } else { + if (hasDynamicShape) { + // case: `CHARACTER(LEN=i_arg) :: c_var(dims)` + TODO(); + } + addSymbol(sym, builder->createCharacterTemp(genType(sym), len)); + } + return; + } + // If it is deferred or assumed, then argument must be a boxchar. + assert(lookupSymbol(sym) && "CHARACTER argument must be added"); + return; + } + + // If this is an argument, we don't need to add a stack slot. + // TODO: consider pass-by-value however. + if (Fortran::semantics::IsDummy(sym)) + return; + + // FIXME: (1) If this is a POINTER variable, a !fir.ptr should be allocated + // and set to null. (2) If this is an ALLOCATABLE variable, a !fir.heap + // should be allocated and set to null (deferred, double indirect) or an + // allocmem value be allocated (immediate, one-level indirect). (3) If the + // variable is neither POINTER nor ALLOCATABLE, we should examine the size + // of the variable. If the variable is "very large" (per some heuristic), + // then it ought to be promoted to the heap, rather than allocated on the + // stack. In all cases, the `pft::Variable` can then be used to track heap + // allocations (either immediate or by promotion) and reclaim the heap space + // in the exit block. + auto local = createNewLocal(loc, sym, shape); + addSymbol(sym, local); + } + + void instantiateVar(const Fortran::lower::pft::Variable &var) { + if (var.isGlobal()) { + instantiateGlobal(var); + return; + } + instantiateLocal(var); + } + /// Prepare to translate a new function void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { assert(!builder && "expected nullptr"); @@ -1269,35 +1429,54 @@ class FirConverter : public Fortran::lower::AbstractConverter { func.addEntryBlock(); builder->setInsertionPointToStart(&func.front()); - Fortran::lower::SymMap dummyAssociations; - // plumb function's arguments - if (funit.symbol && !funit.isMainProgram()) { - auto *entryBlock = &func.front(); - const auto &details = - funit.symbol->get(); - for (const auto &v : - llvm::zip(details.dummyArgs(), entryBlock->getArguments())) { - if (std::get<0>(v)) { - dummyAssociations.addSymbol(*std::get<0>(v), std::get<1>(v)); - } else { - TODO(); // handle alternate return + if (useOldInitializerCode) { + Fortran::lower::SymMap dummyAssociations; + // plumb function's arguments + if (funit.symbol && !funit.isMainProgram()) { + auto *entryBlock = &func.front(); + const auto &details = + funit.symbol->get(); + for (const auto &v : + llvm::zip(details.dummyArgs(), entryBlock->getArguments())) { + if (std::get<0>(v)) { + dummyAssociations.addSymbol(*std::get<0>(v), std::get<1>(v)); + } else { + TODO(); // handle alternate return + } } - } - // Go through the symbol scope and evaluate specification expressions - llvm::DenseSet attempted; - assert(funit.symbol->scope() && "subprogram symbol must have a scope"); - // TODO: This loop through scope symbols offers no stability guarantee - // regarding the order. This should not be a problem given how - // instantiateLocalVariable is implemented, but may harm reproducibility. - // A solution would be to sort the symbol based on their source location. - for (const auto &iter : *funit.symbol->scope()) { - instantiateLocalVariable(iter.second.get(), dummyAssociations, - attempted); - } + // Go through the symbol scope and evaluate specification expressions + llvm::DenseSet attempted; + assert(funit.symbol->scope() && "subprogram symbol must have a scope"); + // TODO: This loop through scope symbols offers no stability guarantee + // regarding the order. This should not be a problem given how + // instantiateLocalVariable is implemented, but may harm + // reproducibility. A solution would be to sort the symbol based on + // their source location. + for (const auto &iter : *funit.symbol->scope()) { + instantiateLocalVariable(iter.second.get(), dummyAssociations, + attempted); + } - // if (details.isFunction()) - // createTemporary(toLocation(), details.result()); + // if (details.isFunction()) + // createTemporary(toLocation(), details.result()); + } + } else { + auto *entryBlock = &func.front(); + if (funit.symbol && !funit.isMainProgram()) { + const auto &details = + funit.symbol->get(); + for (const auto &v : + llvm::zip(details.dummyArgs(), entryBlock->getArguments())) { + if (std::get<0>(v)) { + addSymbol(*std::get<0>(v), std::get<1>(v)); + } else { + TODO(); // handle alternate return + } + } + } + for (const auto &var : funit.getOrderedSymbolTable()) + instantiateVar(var); } // Create most function blocks in advance. @@ -1402,36 +1581,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Location toLocation() { return toLocation(currentPosition); } - // TODO: should these be moved to convert-expr? - template - mlir::Value genCompare(mlir::Value lhs, mlir::Value rhs) { - auto lty = lhs.getType(); - assert(lty == rhs.getType()); - if (lty.isSignlessIntOrIndex()) - return builder->create(lhs.getLoc(), ICMPOPC, lhs, rhs); - if (fir::LogicalType::kindof(lty.getKind())) - return builder->create(lhs.getLoc(), ICMPOPC, lhs, rhs); - if (fir::CharacterType::kindof(lty.getKind())) { - // FIXME - // return builder->create(lhs->getLoc(), ); - } - mlir::emitError(toLocation(), "cannot generate operation on this type"); - return {}; - } - - mlir::Value genGE(mlir::Value lhs, mlir::Value rhs) { - return genCompare(lhs, rhs); - } - mlir::Value genLE(mlir::Value lhs, mlir::Value rhs) { - return genCompare(lhs, rhs); - } - mlir::Value genEQ(mlir::Value lhs, mlir::Value rhs) { - return genCompare(lhs, rhs); - } - mlir::Value genAND(mlir::Value lhs, mlir::Value rhs) { - return builder->create(lhs.getLoc(), lhs, rhs); - } - mlir::MLIRContext &mlirContext; const Fortran::parser::CookedSource *cooked; mlir::ModuleOp &module; @@ -1445,9 +1594,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // namespace -void Fortran::lower::LoweringBridge::lower(const Fortran::parser::Program &prg, - fir::NameUniquer &uniquer) { - auto pft = Fortran::lower::createPFT(prg); +void Fortran::lower::LoweringBridge::lower( + const Fortran::parser::Program &prg, fir::NameUniquer &uniquer, + const Fortran::semantics::SemanticsContext &semanticsContext) { + auto pft = Fortran::lower::createPFT(prg, semanticsContext); if (dumpBeforeFir) Fortran::lower::dumpPFT(llvm::errs(), *pft); FirConverter converter{*this, uniquer}; diff --git a/flang/lib/Lower/CharRT.cpp b/flang/lib/Lower/CharRT.cpp new file mode 100644 index 0000000000000..0b8475754ebfc --- /dev/null +++ b/flang/lib/Lower/CharRT.cpp @@ -0,0 +1,132 @@ +//===-- CharRT.cpp -- runtime support for CHARACTER type entities ---------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/CharRT.h" +#include "../../runtime/character.h" +#include "RTBuilder.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/FIRBuilder.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" + +#define TODO() llvm_unreachable("not yet implemented") + +using namespace Fortran::runtime; + +#define NAMIFY_HELPER(X) #X +#define NAMIFY(X) NAMIFY_HELPER(IONAME(X)) +#define mkRTKey(X) mkKey(RTNAME(X)) + +namespace Fortran::lower { +/// Static table of CHARACTER runtime calls +/// +/// This logical map contains the name and type builder function for each +/// runtime function listed in the tuple. This table is fully constructed at +/// compile-time. Use the `mkRTKey` macro to access the table. +static constexpr std::tuple< + mkRTKey(CharacterCompareScalar), mkRTKey(CharacterCompareScalar1), + mkRTKey(CharacterCompareScalar2), mkRTKey(CharacterCompareScalar4), + mkRTKey(CharacterCompare)> + newCharRTTable; +} // namespace Fortran::lower + +using namespace Fortran::lower; + +/// Helper function to retrieve the name of the IO function given the key `A` +template +static constexpr const char *getName() { + return std::get(newCharRTTable).name; +} + +/// Helper function to retrieve the type model signature builder of the IO +/// function as defined by the key `A` +template +static constexpr FuncTypeBuilderFunc getTypeModel() { + return std::get(newCharRTTable).getTypeModel(); +} + +inline int64_t getLength(mlir::Type argTy) { + return argTy.cast().getShape()[0]; +} + +/// Get (or generate) the MLIR FuncOp for a given runtime function. +template +static mlir::FuncOp getRuntimeFunc(Fortran::lower::FirOpBuilder &builder) { + auto name = getName(); + auto func = builder.getNamedFunction(name); + if (func) + return func; + auto funTy = getTypeModel()(builder.getContext()); + func = builder.createFunction(name, funTy); + func.setAttr("fir.runtime", builder.getUnitAttr()); + return func; +} + +/// Helper function to recover the KIND from the FIR type. +static int discoverKind(mlir::Type ty) { + if (auto charTy = ty.dyn_cast()) + return charTy.getFKind(); + if (auto eleTy = fir::dyn_cast_ptrEleTy(ty)) + return discoverKind(eleTy); + if (auto arrTy = ty.dyn_cast()) + return discoverKind(arrTy.getEleTy()); + if (auto boxTy = ty.dyn_cast()) + return discoverKind(boxTy.getEleTy()); + if (auto boxTy = ty.dyn_cast()) + return discoverKind(boxTy.getEleTy()); + llvm_unreachable("unexpected character type"); +} + +//===----------------------------------------------------------------------===// +// Lower character operations +//===----------------------------------------------------------------------===// + +mlir::Value +Fortran::lower::genRawCharCompare(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::CmpIPredicate cmp, + mlir::Value lhsBuff, mlir::Value lhsLen, + mlir::Value rhsBuff, mlir::Value rhsLen) { + auto &builder = converter.getFirOpBuilder(); + builder.setLocation(loc); + mlir::FuncOp beginFunc; + switch (discoverKind(lhsBuff.getType())) { + case 1: + beginFunc = getRuntimeFunc(builder); + break; + case 2: + beginFunc = getRuntimeFunc(builder); + break; + case 4: + beginFunc = getRuntimeFunc(builder); + break; + default: + llvm_unreachable("runtime does not support CHARACTER KIND"); + } + auto fTy = beginFunc.getType(); + auto lptr = builder.create(loc, fTy.getInput(0), lhsBuff); + auto llen = builder.create(loc, fTy.getInput(2), lhsLen); + auto rptr = builder.create(loc, fTy.getInput(1), rhsBuff); + auto rlen = builder.create(loc, fTy.getInput(3), rhsLen); + llvm::SmallVector args = {lptr, rptr, llen, rlen}; + auto tri = builder.create(loc, beginFunc, args).getResult(0); + auto zero = builder.createIntegerConstant(tri.getType(), 0); + return builder.create(loc, cmp, tri, zero); +} + +mlir::Value +Fortran::lower::genBoxCharCompare(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::CmpIPredicate cmp, + mlir::Value lhs, mlir::Value rhs) { + auto &builder = converter.getFirOpBuilder(); + builder.setLocation(loc); + assert(lhs.getType().isa() && "not a boxchar"); + assert(rhs.getType().isa() && "not a boxchar"); + auto lhsPair = builder.materializeCharacter(lhs); + auto rhsPair = builder.materializeCharacter(rhs); + return genRawCharCompare(converter, loc, cmp, lhsPair.first, lhsPair.second, + rhsPair.first, rhsPair.second); +} diff --git a/flang/lib/Optimizer/CodeGen.cpp b/flang/lib/Optimizer/CodeGen.cpp index 445117090fd5f..170fd0a9e9fc0 100644 --- a/flang/lib/Optimizer/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen.cpp @@ -2297,10 +2297,14 @@ struct NegcOpConversion : public FIROpConversion { /// /// This pass lowers all FIR dialect operations to LLVM IR dialect. An /// MLIR pass is used to lower residual Std dialect to LLVM IR dialect. -struct FIRToLLVMLoweringPass : public mlir::ModulePass { +struct FIRToLLVMLoweringPass + : public mlir::PassWrapper> { FIRToLLVMLoweringPass(fir::NameUniquer &uniquer) : uniquer{uniquer} {} - void runOnModule() override { + mlir::ModuleOp getModule() { return getOperation(); } + + void runOnOperation() override final { if (disableFirToLLVMIR) return; @@ -2362,10 +2366,14 @@ struct FIRToLLVMLoweringPass : public mlir::ModulePass { }; /// Lower from LLVM IR dialect to proper LLVM-IR and dump the module -struct LLVMIRLoweringPass : public mlir::ModulePass { +struct LLVMIRLoweringPass + : public mlir::PassWrapper> { LLVMIRLoweringPass(raw_ostream &output) : output{output} {} - void runOnModule() override { + mlir::ModuleOp getModule() { return getOperation(); } + + void runOnOperation() override final { if (disableLLVM) return; diff --git a/flang/lib/Optimizer/StdConverter.cpp b/flang/lib/Optimizer/StdConverter.cpp index 55285bd7b8377..b478c691617d6 100644 --- a/flang/lib/Optimizer/StdConverter.cpp +++ b/flang/lib/Optimizer/StdConverter.cpp @@ -188,7 +188,8 @@ struct SelectTypeOpConversion : public FIROpConversion { }; /// Convert affine dialect, fir.select_type to standard dialect -class FIRToStdLoweringPass : public mlir::FunctionPass { +class FIRToStdLoweringPass + : public mlir::PassWrapper { public: explicit FIRToStdLoweringPass(const KindMapping &kindMap) : kindMap{kindMap} {} diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp index 04c0ab8eec2d5..a8de1e94a4c75 100644 --- a/flang/lib/Optimizer/Transforms/CSE.cpp +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -109,8 +109,8 @@ struct SimpleOperationInfo : public llvm::DenseMapInfo { }; /// Basic common sub-expression elimination. -struct BasicCSE : public FunctionPass { - BasicCSE() = default; +struct BasicCSE : public mlir::PassWrapper { + BasicCSE() {} BasicCSE(const BasicCSE &) {} /// Shared implementation of operation elimination and scoped map definitions. @@ -160,7 +160,7 @@ struct BasicCSE : public FunctionPass { cleanupBlock(&block); } - void runOnFunction() override; + void runOnFunction() override final; private: /// Operations marked as dead and to be erased. @@ -317,9 +317,6 @@ void BasicCSE::runOnFunction() { } // end anonymous namespace -std::unique_ptr> fir::createCSEPass() { +std::unique_ptr fir::createCSEPass() { return std::make_unique(); } - -static PassRegistration - pass("basiccse", "Eliminate common sub-expressions in functions"); diff --git a/flang/lib/Optimizer/Transforms/MemToReg.cpp b/flang/lib/Optimizer/Transforms/MemToReg.cpp index a65973a70216c..9020c5a6c690a 100644 --- a/flang/lib/Optimizer/Transforms/MemToReg.cpp +++ b/flang/lib/Optimizer/Transforms/MemToReg.cpp @@ -164,8 +164,8 @@ struct LargeBlockInfo { }; template -struct MemToReg - : public mlir::FunctionPass> { +struct MemToReg : public mlir::PassWrapper, + mlir::FunctionPass> { explicit MemToReg() {} std::vector allocas; @@ -752,10 +752,6 @@ struct MemToReg using MemToRegPass = MemToReg; -std::unique_ptr> fir::createMemToRegPass() { +std::unique_ptr fir::createMemToRegPass() { return std::make_unique(); } - -// Register the Mem To Reg pass -static mlir::PassRegistration - pass("mem-to-reg", "Conversion from mem to reg form"); diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index c9e2fb148f2cf..0b58209d28387 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -54,7 +54,7 @@ class AffineWhereConv : public OpRewrite { /// Promote fir.loop and fir.where to affine.for and affine.if, in the cases /// where such a promotion is possible. class AffineDialectPromotion - : public mlir::FunctionPass { + : public mlir::PassWrapper { public: void runOnFunction() override { if (disableAffinePromo) @@ -162,7 +162,8 @@ class LoopFirEndConv : public mlir::OpRewritePattern { }; /// Convert `fir.loop` and `fir.where` to `loop.for` and `loop.if`. -class LoopDialectConversion : public mlir::FunctionPass { +class LoopDialectConversion + : public mlir::PassWrapper { public: void runOnFunction() override { if (disableLoopConversion) diff --git a/flang/test/Fir/convert-fold.fir b/flang/test/Fir/convert-fold.fir new file mode 100644 index 0000000000000..e7e572e503a2c --- /dev/null +++ b/flang/test/Fir/convert-fold.fir @@ -0,0 +1,28 @@ +// RUN: tco %s | FileCheck %s + +// CHECK-LABEL: @ftest +func @ftest(%x : i1) -> i1 { + // this pair of converts should be folded and DCEd + %1 = fir.convert %x : (i1) -> !fir.logical<1> + %2 = fir.convert %1 : (!fir.logical<1>) -> i1 + // CHECK-NEXT: ret i1 %0 + return %2 : i1 +} + +// CHECK-LABEL: @gtest +func @gtest(%x : !fir.logical<2>) -> !fir.logical<2> { + // this pair of converts should be folded and DCEd + %1 = fir.convert %x : (!fir.logical<2>) -> i1 + %2 = fir.convert %1 : (i1) -> !fir.logical<2> + // CHECK-NEXT: ret i16 %0 + return %2 : !fir.logical<2> +} + +// CHECK-LABEL: @htest +func @htest(%x : !fir.int<4>) -> !fir.int<4> { + // these converts are NOPs and should be folded away + %1 = fir.convert %x : (!fir.int<4>) -> !fir.int<4> + %2 = fir.convert %1 : (!fir.int<4>) -> !fir.int<4> + // CHECK-NEXT: ret i32 %0 + return %2 : !fir.int<4> +} diff --git a/flang/test/Fir/coordinate01.fir b/flang/test/Fir/coordinate01.fir index e7553477a8186..cdb4111363276 100644 --- a/flang/test/Fir/coordinate01.fir +++ b/flang/test/Fir/coordinate01.fir @@ -1,19 +1,19 @@ // RUN: tco -emit-fir %s | tco | FileCheck %s // CHECK-LABEL: @foo1 -func @foo1(%i : i32, %j : i32, %k : i32) { +func @foo1(%i : i32, %j : i32, %k : i32) -> !fir.ref { %1 = fir.alloca !fir.array<10 x 20 x 30 x f32> %2 = fir.convert %1 : (!fir.ref>) -> !fir.ref> // CHECK: getelementptr [20 x [10 x float]], [20 x [10 x float]]* % %3 = fir.coordinate_of %2, %i, %j, %k : (!fir.ref>, i32, i32, i32) -> !fir.ref - return + return %3 : !fir.ref } -// CHECK-LABEL: @foo -func @foo(%i : i32, %j : i32, %k : i32) { +// CHECK-LABEL: @foo2 +func @foo2(%i : i32, %j : i32, %k : i32) -> !fir.ref { %1 = fir.alloca !fir.array<10 x 20 x 30 x f32> %2 = fir.convert %1 : (!fir.ref>) -> !fir.ref // CHECK: getelementptr float, float* % %3 = fir.coordinate_of %2, %i : (!fir.ref, i32) -> !fir.ref - return + return %3 : !fir.ref } diff --git a/flang/test/Lower/character-compare.f90 b/flang/test/Lower/character-compare.f90 new file mode 100644 index 0000000000000..16d51bf076b9e --- /dev/null +++ b/flang/test/Lower/character-compare.f90 @@ -0,0 +1,10 @@ +! RUN: bbc %s -o - | FileCheck %s + +! CHECK-LABEL: compare +subroutine compare(x, c1, c2) + character(len=4) c1, c2 + logical x + ! CHECK: %[[RES:.*]] = call @_FortranACharacterCompareScalar1 + ! CHECK: cmpi "slt", %[[RES]], + x = c1 < c2 +end subroutine compare diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 5d72d4812cbe8..3140abd74af51 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -178,7 +178,7 @@ static void convertFortranSourceToMLIR( auto burnside = Fortran::lower::LoweringBridge::create( semanticsContext.defaultKinds(), &parsing.cooked()); fir::KindMapping kindMap{&burnside.getMLIRContext()}; - burnside.lower(parseTree, nameUniquer); + burnside.lower(parseTree, nameUniquer, semanticsContext); mlir::ModuleOp mlirModule = burnside.getModule(); std::error_code ec; std::string outputName = outputFilename; @@ -201,7 +201,7 @@ static void convertFortranSourceToMLIR( pm.addPass(fir::createLowerToLoopPass()); pm.addPass(fir::createFIRToStdPass(kindMap)); pm.addPass(mlir::createLowerToCFGPass()); - pm.addPass(fir::createMemToRegPass()); + //pm.addPass(fir::createMemToRegPass()); pm.addPass(fir::createCSEPass()); pm.addPass(mlir::createCanonicalizerPass()); diff --git a/unittests/Runtime/character.cpp b/unittests/Runtime/character.cpp new file mode 100644 index 0000000000000..fb023473f64aa --- /dev/null +++ b/unittests/Runtime/character.cpp @@ -0,0 +1,59 @@ +// Basic sanity tests of CHARACTER API; exhaustive testing will be done +// in Fortran. + +#include "../../runtime/character.h" +#include "testing.h" +#include + +using namespace Fortran::runtime; + +static void AppendAndPad(std::size_t limit) { + char x[8]; + std::size_t xLen{0}; + std::memset(x, 0, sizeof x); + xLen = RTNAME(CharacterAppend1)(x, limit, xLen, "abc", 3); + xLen = RTNAME(CharacterAppend1)(x, limit, xLen, "DE", 2); + RTNAME(CharacterPad1)(x, limit, xLen); + if (xLen > limit) { + Fail() << "xLen " << xLen << ">" << limit << '\n'; + } + if (x[limit]) { + Fail() << "x[" << limit << "]='" << x[limit] << "'\n"; + x[limit] = '\0'; + } + if (std::memcmp(x, "abcDE ", limit)) { + Fail() << "x = '" << x << "'\n"; + } +} + +static void TestCharCompare(const char *x, const char *y, std::size_t xBytes, + std::size_t yBytes, int expect) { + int cmp{RTNAME(CharacterCompareScalar1)(x, y, xBytes, yBytes)}; + if (cmp != expect) { + char buf[2][8]; + std::memset(buf, 0, sizeof buf); + std::memcpy(buf[0], x, xBytes); + std::memcpy(buf[1], y, yBytes); + Fail() << "compare '" << buf[0] << "'(" << xBytes << ") to '" << buf[1] + << "'(" << yBytes << "), got " << cmp << ", should be " << expect + << '\n'; + } +} + +static void Compare(const char *x, const char *y, std::size_t xBytes, + std::size_t yBytes, int expect) { + TestCharCompare(x, y, xBytes, yBytes, expect); + TestCharCompare(y, x, yBytes, xBytes, -expect); +} + +int main() { + StartTests(); + for (std::size_t j{0}; j < 8; ++j) { + AppendAndPad(j); + } + Compare("abc", "abc", 3, 3, 0); + Compare("abc", "def", 3, 3, -1); + Compare("ab ", "abc", 3, 2, 0); + Compare("abc", "abc", 2, 3, -1); + return EndTests(); +} From 9dd0ca92d92bb0ea366bb34420083b2c5a876472 Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Tue, 14 Apr 2020 13:58:42 -0700 Subject: [PATCH 0004/1017] Generate FIR for a group of multiway branches (#10) * Generate FIR for a group of multi-way branches - arithmetic if - assigned goto (needs assign statement, which is also implemented) - computed goto - select case * Review comment update. --- flang/lib/Lower/Bridge.cpp | 231 ++++++++++++++++++++++++++++++++----- 1 file changed, 205 insertions(+), 26 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index eba620ed1c565..e3b377785ba85 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -16,6 +16,7 @@ #include "flang/Lower/Mangler.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" +#include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Parser/parse-tree.h" @@ -292,6 +293,17 @@ class FirConverter : public Fortran::lower::AbstractConverter { return cat == Fortran::lower::CharacterCat; } + mlir::Block *blockOfLabel(Fortran::lower::pft::Evaluation &eval, + Fortran::parser::Label label) { + const auto &labelEvaluationMap = + eval.getOwningProcedure()->labelEvaluationMap; + const auto iter = labelEvaluationMap.find(label); + assert(iter != labelEvaluationMap.end() && "label missing from map"); + auto *block = iter->second->block; + assert(block && "missing labeled evaluation block"); + return block; + } + void genFIRUnconditionalBranch(mlir::Block *targetBlock) { assert(targetBlock && "missing unconditional target block"); builder->create(toLocation(), targetBlock); @@ -448,29 +460,131 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::parser::WhereStmt &) { TODO(); } + void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::ComputedGotoStmt &stmt) { - auto *exp = Fortran::semantics::GetExpr( - std::get(stmt.t)); - auto e1{genExprValue(*exp)}; - (void)e1; - TODO(); + mlir::Value selectExpr = genExprValue(*Fortran::semantics::GetExpr( + std::get(stmt.t))); + constexpr int vSize = 10; + llvm::SmallVector indexList; + llvm::SmallVector blockList; + int64_t index = 0; + for (auto &label : std::get>(stmt.t)) { + indexList.push_back(++index); + blockList.push_back(blockOfLabel(eval, label)); + } + blockList.push_back(eval.lexicalSuccessor->block); // default + builder->create(toLocation(), selectExpr, indexList, + blockList); } + void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::ForallStmt &) { TODO(); } + void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::ArithmeticIfStmt &stmt) { - auto *exp = - Fortran::semantics::GetExpr(std::get(stmt.t)); - auto e1{genExprValue(*exp)}; - (void)e1; - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::AssignedGotoStmt &) { - TODO(); + mlir::Value expr = genExprValue( + *Fortran::semantics::GetExpr(std::get(stmt.t))); + auto exprType = expr.getType(); + if (exprType.isSignlessInteger()) { + // Arithmetic expression has Integer type. Generate a SelectCaseOp + // with ranges {(-inf:-1], 0=default, [1:inf)}. + MLIRContext *context = builder->getContext(); + llvm::SmallVector attrList; + llvm::SmallVector valueList; + llvm::SmallVector blockList; + attrList.push_back(fir::UpperBoundAttr::get(context)); + valueList.push_back(builder->createIntegerConstant(exprType, -1)); + blockList.push_back(blockOfLabel(eval, std::get<1>(stmt.t))); + attrList.push_back(fir::LowerBoundAttr::get(context)); + valueList.push_back(builder->createIntegerConstant(exprType, 1)); + blockList.push_back(blockOfLabel(eval, std::get<3>(stmt.t))); + attrList.push_back(mlir::UnitAttr::get(context)); // 0 is the "default" + blockList.push_back(blockOfLabel(eval, std::get<2>(stmt.t))); + builder->create(toLocation(), expr, attrList, + valueList, blockList); + return; + } + // Arithmetic expression has Real type. Generate + // sum = expr + expr [ raise an exception if expr is a NaN ] + // if (sum < 0.0) goto L1 else if (sum > 0.0) goto L3 else goto L2 + assert(eval.localBlocks.size() == 1 && "missing arithmetic if block"); + mlir::Value sum = builder->create(toLocation(), expr, expr); + mlir::Value zero = builder->create( + toLocation(), exprType, builder->getFloatAttr(exprType, 0.0)); + mlir::Value cond1 = builder->create( + toLocation(), mlir::CmpFPredicate::OLT, sum, zero); + genFIRConditionalBranch(cond1, blockOfLabel(eval, std::get<1>(stmt.t)), + eval.localBlocks[0]); + startBlock(eval.localBlocks[0]); + mlir::Value cond2 = builder->create( + toLocation(), mlir::CmpFPredicate::OGT, sum, zero); + genFIRConditionalBranch(cond2, blockOfLabel(eval, std::get<3>(stmt.t)), + blockOfLabel(eval, std::get<2>(stmt.t))); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssignedGotoStmt &stmt) { + // Program requirement 1990 8.2.4 - + // + // At the time of execution of an assigned GOTO statement, the integer + // variable must be defined with the value of a statement label of a + // branch target statement that appears in the same scoping unit. + // Note that the variable may be defined with a statement label value + // only by an ASSIGN statement in the same scoping unit as the assigned + // GOTO statement. + + const auto &symbolLabelMap = + eval.getOwningProcedure()->assignSymbolLabelMap; + const auto &symbol = *std::get(stmt.t).symbol; + auto variable = localSymbols.lookupSymbol(symbol); + if (!variable) + variable = createTemporary(toLocation(), symbol); + auto selectExpr = builder->create(toLocation(), variable); + auto iter = symbolLabelMap.find(symbol); + if (iter == symbolLabelMap.end()) { + // This "assert" will fail for a nonconforming program unit that does not + // have any ASSIGN statements. The front end should check for this. + // If asserts are inactive, the assigned GOTO statement will be a nop. + llvm_unreachable("no assigned goto targets"); + return; + } + auto labelSet = iter->second; + constexpr int vSize = 10; + llvm::SmallVector indexList; + llvm::SmallVector blockList; + auto addLabel = [&](Fortran::parser::Label label) { + indexList.push_back(label); + blockList.push_back(blockOfLabel(eval, label)); + }; + // Add labels from an explicit list. The list may have duplicates. + for (auto &label : std::get>(stmt.t)) { + if (labelSet.count(label) == 0) { + // This "assert" will fail for a nonconforming program unit that never + // ASSIGNs this label to the selector variable. The front end should + // check that there is at least one such ASSIGN statement. If asserts + // are inactive, the label will be ignored. + llvm_unreachable("invalid assigned goto target"); + continue; + } + if (std::find(indexList.begin(), indexList.end(), label) == + indexList.end()) { // ignore duplicates + addLabel(label); + } + } + // Absent an explicit list, add all possible label targets. + if (indexList.empty()) { + for (auto &label : labelSet) { + addLabel(label); + } + } + // Add a nop/fallthrough branch to the switch for a nonconforming program + // unit that violates the program requirement above. + blockList.push_back(eval.lexicalSuccessor->block); // default + builder->create(toLocation(), selectExpr, indexList, + blockList); } void genFIR(Fortran::lower::pft::Evaluation &eval, @@ -687,8 +801,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::CaseConstruct &) { - TODO(); + for (auto &e : *eval.evaluationList) { + genFIR(e); + } } + void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::SelectRankConstruct &) { TODO(); @@ -783,18 +900,74 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::parser::EndBlockStmt &) { TODO(); } + void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SelectCaseStmt &) { - TODO(); + const Fortran::parser::SelectCaseStmt &stmt) { + using ScalarExpr = Fortran::parser::Scalar; + MLIRContext *context = builder->getContext(); + const auto selectExpr = genExprValue( + *Fortran::semantics::GetExpr(std::get(stmt.t))); + const auto selectType = selectExpr.getType(); + constexpr int vSize = 10; + llvm::SmallVector attrList; + llvm::SmallVector valueList; + llvm::SmallVector blockList; + auto *defaultBlock = eval.parentConstruct->constructExit->block; + using CaseValue = Fortran::parser::Scalar; + auto addValue = [&](const CaseValue &caseValue) { + const auto *expr = Fortran::semantics::GetExpr(caseValue.thing); + const auto v = Fortran::evaluate::ToInt64(*expr); + valueList.push_back( + v ? builder->createIntegerConstant(selectType, *v) + : builder->create(toLocation(), selectType, + genExprValue(*expr))); + }; + for (Fortran::lower::pft::Evaluation *e = eval.controlSuccessor; e; + e = e->controlSuccessor) { + const auto &caseStmt = e->getIf(); + assert(e->block && "missing CaseStmt block"); + const auto &caseSelector = + std::get(caseStmt->t); + const auto *caseValueRangeList = + std::get_if>( + &caseSelector.u); + if (!caseValueRangeList) { + defaultBlock = e->block; + continue; + } + for (auto &caseValueRange : *caseValueRangeList) { + blockList.push_back(e->block); + if (const auto *caseValue = std::get_if(&caseValueRange.u)) { + attrList.push_back(fir::PointIntervalAttr::get(context)); + addValue(*caseValue); + continue; + } + const auto &caseRange = + std::get(caseValueRange.u); + if (caseRange.lower && caseRange.upper) { + attrList.push_back(fir::ClosedIntervalAttr::get(context)); + addValue(*caseRange.lower); + addValue(*caseRange.upper); + } else if (caseRange.lower) { + attrList.push_back(fir::LowerBoundAttr::get(context)); + addValue(*caseRange.lower); + } else { + attrList.push_back(fir::UpperBoundAttr::get(context)); + addValue(*caseRange.upper); + } + } + } + attrList.push_back(mlir::UnitAttr::get(context)); + blockList.push_back(defaultBlock); + builder->create(toLocation(), selectExpr, attrList, + valueList, blockList); } + void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::CaseStmt &) { - TODO(); - } + const Fortran::parser::CaseStmt &) {} // nop void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EndSelectStmt &) { - TODO(); - } + const Fortran::parser::EndSelectStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::ChangeTeamStmt &) { TODO(); @@ -1081,9 +1254,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::AssignStmt &) { - TODO(); + const Fortran::parser::AssignStmt &stmt) { + const auto &symbol = *std::get(stmt.t).symbol; + auto variable = localSymbols.lookupSymbol(symbol); + if (!variable) + variable = createTemporary(toLocation(), symbol); + const auto labelValue = builder->createIntegerConstant( + genType(symbol), std::get(stmt.t)); + builder->create(toLocation(), labelValue, variable); } + void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::FormatStmt &) { // do nothing. FORMAT statements have no semantics. They may be lowered if @@ -1552,7 +1732,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { // lower this procedure for (auto &eval : funit.evaluationList) genFIR(eval); - endNewFunction(funit); // recursively lower internal procedures for (auto &f : funit.nestedFunctions) From ee6e198c20bc224b21348ef0aaba19089965fee9 Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 14 Apr 2020 16:21:12 -0700 Subject: [PATCH 0005/1017] use SmallVector fix compilation issue post merge remove reference to deleted header --- flang/lib/Lower/Bridge.cpp | 53 ++++++++++++++------------ flang/lib/Optimizer/Transforms/CSE.cpp | 1 - 2 files changed, 28 insertions(+), 26 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index e3b377785ba85..bc7b44b291d12 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -254,19 +254,27 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// is not updated. Instead the value `false` is returned. bool addSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val, bool forced = false) { - if (forced) { + if (forced) localSymbols.erase(sym); - } else { - if (auto v = lookupSymbol(sym)) - return false; - } + else if (lookupSymbol(sym)) + return false; localSymbols.addSymbol(sym, val); return true; } - mlir::Value createTemporary(mlir::Location loc, - const Fortran::semantics::Symbol &sym, - llvm::ArrayRef shape = {}) { + bool addCharSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val, + mlir::Value len, bool forced = false) { + if (forced) + localSymbols.erase(sym); + else if (lookupSymbol(sym)) + return false; + localSymbols.addCharSymbol(sym, val, len); + return true; + } + + mlir::Value createTemp(mlir::Location loc, + const Fortran::semantics::Symbol &sym, + llvm::ArrayRef shape = {}) { if (auto v = lookupSymbol(sym)) return v; auto newVal = builder->createTemporary(loc, genType(sym), @@ -275,13 +283,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { return newVal; } - mlir::FuncOp genFunctionFIR(llvm::StringRef callee, - mlir::FunctionType funcTy) { - if (auto func = builder->getNamedFunction(callee)) - return func; - return builder->createFunction(callee, funcTy); - } - bool isNumericScalarCategory(Fortran::common::TypeCategory cat) { return cat == Fortran::lower::IntegerCat || cat == Fortran::lower::RealCat || @@ -539,9 +540,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { const auto &symbolLabelMap = eval.getOwningProcedure()->assignSymbolLabelMap; const auto &symbol = *std::get(stmt.t).symbol; - auto variable = localSymbols.lookupSymbol(symbol); + auto variable = lookupSymbol(symbol); if (!variable) - variable = createTemporary(toLocation(), symbol); + variable = createTemp(toLocation(), symbol); auto selectExpr = builder->create(toLocation(), variable); auto iter = symbolLabelMap.find(symbol); if (iter == symbolLabelMap.end()) { @@ -685,7 +686,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { ? builder->create(location, 1) : builder->createIntegerConstant(info.loopVariableType, 1)); assert(info.stepValue && "step value must be set"); - info.loopVariable = createTemporary(location, *info.loopVariableSym); + info.loopVariable = createTemp(location, *info.loopVariableSym); // Structured loop - generate fir.loop. if (info.isStructured()) { @@ -1256,9 +1257,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::AssignStmt &stmt) { const auto &symbol = *std::get(stmt.t).symbol; - auto variable = localSymbols.lookupSymbol(symbol); + auto variable = lookupSymbol(symbol); if (!variable) - variable = createTemporary(toLocation(), symbol); + variable = createTemp(toLocation(), symbol); const auto labelValue = builder->createIntegerConstant( genType(symbol), std::get(stmt.t)); builder->create(toLocation(), labelValue, variable); @@ -1448,7 +1449,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (auto actualValue = dummyArgs.lookupSymbol(symbol)) addSymbol(symbol, actualValue); else - createTemporary(toLocation(), symbol); + createTemp(toLocation(), symbol); } if (const auto *details = symbol.detailsIf()) { @@ -1546,14 +1547,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { // verify that the reboxing is simpatico. auto original = lookupSymbol(sym); auto unboxed = builder->createUnboxChar(original); - addSymbol(sym, builder->createEmboxChar(unboxed.first, len), - /*forced=*/true); + auto addr = builder->createEmboxChar(unboxed.first, len); + addCharSymbol(sym, addr, len, /*forced=*/true); } else { + auto charTy = genType(sym); if (hasDynamicShape) { // case: `CHARACTER(LEN=i_arg) :: c_var(dims)` TODO(); } - addSymbol(sym, builder->createCharacterTemp(genType(sym), len)); + auto addr = builder->createCharacterTemp(charTy, len); + addCharSymbol(sym, addr, len); } return; } @@ -1639,7 +1642,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // if (details.isFunction()) - // createTemporary(toLocation(), details.result()); + // createTemp(toLocation(), details.result()); } } else { auto *entryBlock = &func.front(); diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp index a8de1e94a4c75..9c78b03cb360b 100644 --- a/flang/lib/Optimizer/Transforms/CSE.cpp +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -20,7 +20,6 @@ #include "mlir/IR/Function.h" #include "mlir/Interfaces/SideEffects.h" #include "mlir/Pass/Pass.h" -#include "mlir/Support/Functional.h" #include "mlir/Transforms/Passes.h" #include "mlir/Transforms/Utils.h" #include "llvm/ADT/DenseMapInfo.h" From 73679a477ff091ba57d22aa16acfda8c44e7c596 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 16 Apr 2020 14:53:28 -0700 Subject: [PATCH 0006/1017] ABS, DBLE, SIGN, MOD, ICHAR intrinsic lowering Add fir::isa_real and fir::isa_complex and rework FirOpBuilder::isCharacter --- flang/LAPACK-bugs.txt | 15 ++- flang/lib/Lower/Intrinsics.cpp | 189 ++++++++++++++++++++++++++++---- flang/test/Lower/intrinsics.f90 | 77 +++++++++++++ 3 files changed, 256 insertions(+), 25 deletions(-) create mode 100644 flang/test/Lower/intrinsics.f90 diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index a8fcc3408037c..adcd810abe2a7 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -14,12 +14,10 @@ ______________ Lowering globals in general . UNREACHABLE executed at Lower/Bridge.cpp:1294! -[Unassigned] +[Jean] - Intrinsics lowering problems (3) - . bbc: Lower/Intrinsics.cpp:474: Assertion `!bestMatchDistance.isLoosingPrecision() && "runtime selection looses precision"' failed. - . bbc: Lower/Intrinsics.cpp:504: Assertion `arg != nullptr' failed. - . bbc: Lower/Intrinsics.cpp:628: Assertion `false && "no runtime found for this intrinsics"' failed. + Intrinsics lowering problems + . bbc: Lower/Intrinsics.cpp:763: Assertion `false && "LEN_TRIM TODO"' failed. FIXED @@ -42,3 +40,10 @@ Block.cpp:200: mlir::Operation *mlir::Block::getTerminator(): Assertion `!empty( error: 'std.return' op must be the last operation in the parent block +bbc: Lower/Intrinsics.cpp:504: Assertion `arg != nullptr' failed. + . optional argument in ichar +bbc: Lower/Intrinsics.cpp:628: Assertion `false && "no runtime found for this intrinsics"' failed. + . sign, mod, dble, ichar intrinsic lowering missing +bbc: Lower/Intrinsics.cpp:474: Assertion `!bestMatchDistance.isLoosingPrecision() && "runtime selection looses precision"' failed. + . missing complex abs + diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index fa7eed501f30c..25ee5baf084d3 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -135,6 +135,11 @@ class IntrinsicLibrary::Implementation { llvm::ArrayRef args); private: + static inline mlir::Value genval(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder, + llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef args, + MathRuntimeLibrary &); // Info needed by Generators is passed in Context struct to keep Generator // signatures modification easy. struct Context { @@ -179,10 +184,21 @@ class IntrinsicLibrary::Implementation { return genWrapperCall<&I::genRuntimeCall>(c, r); } + /// Implement all conversion functions like DBLE, the first argument is + /// the value to convert. There may be an additional KIND arguments that + /// is ignored because this is already reflected in the result type. + static mlir::Value genConversion(Context &, MathRuntimeLibrary &); + + static mlir::Value genAbs(Context &, MathRuntimeLibrary &); + static mlir::Value genAimag(Context &, MathRuntimeLibrary &); static mlir::Value genConjg(Context &, MathRuntimeLibrary &); template static mlir::Value genExtremum(Context &, MathRuntimeLibrary &); + static mlir::Value genIchar(Context &, MathRuntimeLibrary &); + static mlir::Value genLenTrim(Context &, MathRuntimeLibrary &); static mlir::Value genMerge(Context &, MathRuntimeLibrary &); + static mlir::Value genMod(Context &, MathRuntimeLibrary &); + static mlir::Value genSign(Context &, MathRuntimeLibrary &); struct IntrinsicHanlder { const char *name; @@ -194,10 +210,17 @@ class IntrinsicLibrary::Implementation { /// defined here for a generic intrinsic, the defaultGenerator will /// be attempted. static constexpr IntrinsicHanlder handlers[]{ + {"abs", &I::genAbs}, + {"aimag", &I::genAimag}, {"conjg", &I::genConjg}, + {"dble", &I::genConversion}, + {"ichar", &I::genIchar}, + {"len_trim", &I::genLenTrim}, {"max", &I::genExtremum}, {"min", &I::genExtremum}, {"merge", &I::genMerge}, + {"mod", &I::genMod}, + {"sign", &I::genSign}, }; // helpers @@ -249,6 +272,12 @@ static constexpr MathsRuntimeStaticDescription llvmRuntime[] = { static constexpr MathsRuntimeStaticDescription pgmathPreciseRuntime[] = { {"acos", "__pc_acos_1", RType::c32, Args::create()}, {"acos", "__pz_acos_1", RType::c64, Args::create()}, + {"hypot", "__mth_i_hypot", RType::f32, + Args::create()}, + {"hypot", "__mth_i_dhypot", RType::f64, + Args::create()}, + {"mod", "__ps_mod_1", RType::f32, Args::create()}, + {"mod", "__pd_mod_1", RType::f64, Args::create()}, {"pow", "__pc_pow_1", RType::c32, Args::create()}, {"pow", "__pc_powi_1", RType::c32, Args::create()}, {"pow", "__pc_powk_1", RType::c32, Args::create()}, @@ -347,7 +376,7 @@ class FunctionDistance { conversions.begin(), conversions.end(), d.conversions.begin(), d.conversions.end())); } - bool isLoosingPrecision() const { + bool isLosingPrecision() const { return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0; } bool isInfinite() const { return infinite; } @@ -396,11 +425,7 @@ class FunctionDistance { return r.getFKind() * 4; if (auto cplx{t.dyn_cast()}) return cplx.getFKind() * 4; - assert(false && "not a floating-point type"); - return 0; - } - static bool isFloatingPointType(mlir::Type t) { - return t.isa() || t.isa(); + llvm_unreachable("not a floating-point type"); } static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) { if (from == to) { @@ -412,7 +437,7 @@ class FunctionDistance { : Conversion::Extend; } } - if (isFloatingPointType(from) && isFloatingPointType(to)) { + if (fir::isa_real(from) && fir::isa_real(to)) { return getFloatingPointWidth(from) > getFloatingPointWidth(to) ? Conversion::Narrow : Conversion::Extend; @@ -470,8 +495,8 @@ MathRuntimeLibrary::getFunction(Fortran::lower::FirOpBuilder &builder, } } if (bestNearMatch != nullptr) { - assert(!bestMatchDistance.isLoosingPrecision() && - "runtime selection looses precision"); + assert(!bestMatchDistance.isLosingPrecision() && + "runtime selection loses precision"); return getFuncOp(builder, *bestNearMatch); } return {}; @@ -483,6 +508,13 @@ mlir::Value IntrinsicLibrary::Implementation::genval( mlir::Location loc, Fortran::lower::FirOpBuilder &builder, llvm::StringRef name, mlir::Type resultType, llvm::ArrayRef args) { + return genval(loc, builder, name, resultType, args, runtime); +} + +mlir::Value IntrinsicLibrary::Implementation::genval( + mlir::Location loc, Fortran::lower::FirOpBuilder &builder, + llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef args, MathRuntimeLibrary &runtime) { Context context{loc, &builder, name, args, getFunctionType(resultType, args, builder)}; for (auto &handler : handlers) { @@ -501,8 +533,8 @@ getFunctionType(mlir::Type resultType, llvm::ArrayRef arguments, Fortran::lower::FirOpBuilder &builder) { llvm::SmallVector argumentTypes; for (auto &arg : arguments) { - assert(arg != nullptr); // TODO think about optionals - argumentTypes.push_back(arg.getType()); + if (arg) + argumentTypes.push_back(arg.getType()); } return mlir::FunctionType::get(argumentTypes, resultType, builder.getModule().getContext()); @@ -529,8 +561,7 @@ static std::string typeToString(mlir::Type t) { if (auto character{t.dyn_cast()}) { return "c" + std::to_string(character.getFKind()); } - assert(false && "no mangling for type"); - return ""s; + llvm_unreachable("no mangling for type"); } static std::string getIntrinsicWrapperName(const llvm::StringRef &intrinsic, @@ -596,8 +627,7 @@ IntrinsicLibrary::Implementation::genRuntimeCall(Context &context, actualFuncType.getNumInputs() != soughtFuncType.getNumInputs() || actualFuncType.getNumInputs() != context.arguments.size() || actualFuncType.getNumResults() != 1) { - assert(false); // TODO better error handling - return nullptr; + llvm_unreachable("Bad intrinsic match"); // TODO better error handling } llvm::SmallVector convertedArguments; int i = 0; @@ -625,13 +655,63 @@ IntrinsicLibrary::Implementation::genRuntimeCall(Context &context, } } else { // could not find runtime function - assert(false && "no runtime found for this intrinsics"); + llvm::errs() << "missing intrinsic: " << context.name << "\n"; + llvm_unreachable("no runtime found for this intrinsics"); // TODO: better error handling ? // - Try to have compile time check of runtime compltness ? } return {}; // gets rid of warnings } +mlir::Value +IntrinsicLibrary::Implementation::genConversion(Context &genCtxt, + MathRuntimeLibrary &) { + // There can be an optional kind in second argument. + assert(genCtxt.arguments.size() >= 1); + return genCtxt.builder->create( + genCtxt.loc, genCtxt.getResultType(), genCtxt.arguments[0]); +} + +// ABS +mlir::Value +IntrinsicLibrary::Implementation::genAbs(Context &genCtxt, + MathRuntimeLibrary &runtime) { + assert(genCtxt.arguments.size() == 1); + auto arg = genCtxt.arguments[0]; + auto type = arg.getType(); + if (fir::isa_real(type)) { + // Runtime call to fp abs. An alternative would be to use mlir AbsFOp + // but it does not support all fir floating point types. + return genRuntimeCall(genCtxt, runtime); + } + if (auto intType = type.dyn_cast()) { + // At the time of this implementation there is no abs op in mlir. + // So, implement abs here without branching. + auto shift = + genCtxt.builder->createIntegerConstant(intType, intType.getWidth() - 1); + auto mask = genCtxt.builder->create(genCtxt.loc, + arg, shift); + auto xored = genCtxt.builder->create(genCtxt.loc, arg, mask); + return genCtxt.builder->create(genCtxt.loc, xored, mask); + } + if (fir::isa_complex(type)) { + // Use HYPOT to fulfill the no underflow/overflow requirement. + auto parts = genCtxt.builder->extractParts(arg); + llvm::SmallVector args = {parts.first, parts.second}; + return genval(genCtxt.loc, *genCtxt.builder, "hypot", + genCtxt.getResultType(), args, runtime); + } + llvm_unreachable("unexpected type in ABS argument"); +} + +// AIMAG +mlir::Value IntrinsicLibrary::Implementation::genAimag(Context &genCtxt, + MathRuntimeLibrary &) { + assert(genCtxt.arguments.size() == 1); + return genCtxt.builder->extractComplexPart(genCtxt.arguments[0], + true /* isImagPart */); +} + // CONJG mlir::Value IntrinsicLibrary::Implementation::genConjg(Context &genCtxt, MathRuntimeLibrary &) { @@ -648,21 +728,90 @@ mlir::Value IntrinsicLibrary::Implementation::genConjg(Context &genCtxt, return builder.insertComplexPart(cplx, negImag, /*isImagPart=*/true); } +// ICHAR +mlir::Value IntrinsicLibrary::Implementation::genIchar(Context &genCtxt, + MathRuntimeLibrary &) { + // There can be an optional kind in second argument. + assert(genCtxt.arguments.size() >= 1); + auto &builder = *genCtxt.builder; + + auto arg = genCtxt.arguments[0]; + auto dataAndLen = builder.createUnboxChar(arg); + auto charType = fir::CharacterType::get( + builder.getContext(), builder.getCharacterKind(arg.getType())); + auto refType = fir::ReferenceType::get(charType); + auto charAddr = + builder.create(genCtxt.loc, refType, dataAndLen.first); + auto charVal = builder.create(genCtxt.loc, charType, charAddr); + return builder.create(genCtxt.loc, genCtxt.getResultType(), + charVal); +} + +// LEN_TRIM +mlir::Value IntrinsicLibrary::Implementation::genLenTrim(Context &genCtxt, + MathRuntimeLibrary &) { + // Optional KIND argument reflected in result type. + assert(genCtxt.arguments.size() >= 1); + // FIXME: LEN_TRIM needs actual runtime and to be define in CharRT.h + llvm_unreachable("LEN_TRIM TODO"); + // Fake implementation for debugging: + // return genCtxt.builder->createIntegerConstant(genCtxt.getResultType(), 0); +} + // MERGE mlir::Value IntrinsicLibrary::Implementation::genMerge(Context &genCtxt, MathRuntimeLibrary &) { assert(genCtxt.arguments.size() == 3); - [[maybe_unused]] auto resType = genCtxt.getResultType(); Fortran::lower::FirOpBuilder &builder = *genCtxt.builder; - auto &trueVal = genCtxt.arguments[0]; - auto &falseVal = genCtxt.arguments[1]; - auto &mask = genCtxt.arguments[2]; + auto trueVal = genCtxt.arguments[0]; + auto falseVal = genCtxt.arguments[1]; + auto mask = genCtxt.arguments[2]; auto i1Type = mlir::IntegerType::get(1, builder.getContext()); auto msk = builder.create(genCtxt.loc, i1Type, mask); return builder.create(genCtxt.loc, msk, trueVal, falseVal); } +// MOD +mlir::Value +IntrinsicLibrary::Implementation::genMod(Context &genCtxt, + MathRuntimeLibrary &runtime) { + assert(genCtxt.arguments.size() == 2); + auto type = genCtxt.getResultType(); + if (type.isa()) { + return genCtxt.builder->create( + genCtxt.loc, genCtxt.arguments[0], genCtxt.arguments[1]); + } + // Use runtime. Note that mlir::RemFOp alos implement floating point + // remainder, but it does not work with fir::Real type. + return genRuntimeCall(genCtxt, runtime); +} + +// SIGN +mlir::Value +IntrinsicLibrary::Implementation::genSign(Context &genCtxt, + MathRuntimeLibrary &runtime) { + assert(genCtxt.arguments.size() == 2); + auto &builder = *genCtxt.builder; + auto type = genCtxt.getResultType(); + auto abs = genval(genCtxt.loc, *genCtxt.builder, "abs", type, + {genCtxt.arguments[0]}, runtime); + if (type.isa()) { + auto zero = builder.createIntegerConstant(type, 0); + auto neg = builder.create(genCtxt.loc, zero, abs); + auto cmp = builder.create( + genCtxt.loc, mlir::CmpIPredicate::slt, genCtxt.arguments[1], zero); + return builder.create(genCtxt.loc, cmp, neg, abs); + } + // TODO: Requirements when second argument is +0./0. + auto zeroAttr = builder.getZeroAttr(type); + auto zero = builder.create(genCtxt.loc, type, zeroAttr); + auto neg = builder.create(genCtxt.loc, abs); + auto cmp = builder.create(genCtxt.loc, mlir::CmpFPredicate::OLT, + genCtxt.arguments[1], zero); + return builder.create(genCtxt.loc, cmp, neg, abs); +} + // Compare two FIR values and return boolean result as i1. template static mlir::Value createExtremumCompare(mlir::Location loc, diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 new file mode 100644 index 0000000000000..cac5f9f96a225 --- /dev/null +++ b/flang/test/Lower/intrinsics.f90 @@ -0,0 +1,77 @@ +! RUN: bbc %s -o - | FileCheck %s + +! ABS +! CHECK-LABEL: abs_testi +subroutine abs_testi(a, b) + integer :: a, b + ! CHECK: shift_right_signed + ! CHECK: xor + ! CHECK: subi + b = abs(a) +end subroutine + +! CHECK-LABEL: abs_testr +subroutine abs_testr(a, b) + real :: a, b + ! CHECK: call @llvm.fabs.f32 + b = abs(a) +end subroutine + +! CHECK-LABEL: abs_testz +subroutine abs_testz(a, b) + complex :: a + real :: b + ! CHECK: fir.extract_value + ! CHECK: fir.extract_value + ! CHECK: call @{{.*}}hypot + b = abs(a) +end subroutine + +! AIMAG +! CHECK-LABEL: aimag_test +subroutine aimag_test(a, b) + complex :: a + real :: b + ! CHECK: fir.extract_value + b = aimag(a) +end subroutine + +! DBLE +! CHECK-LABEL: dble_test +subroutine dble_test(a) + real :: a + ! CHECK: fir.convert {{.*}} : (f32) -> f64 + print *, dble(a) +end subroutine + +! ICHAR +! CHECK-LABEL: ichar_test +subroutine ichar_test(c) + character(1) :: c + ! CHECK: fir.convert {{.*}} : (!fir.char<1>) -> i32 + print *, ichar(c) +end subroutine + +! SIGN +! CHECK-LABEL: sign_testi +subroutine sign_testi(a, b, c) + integer a, b, c + ! CHECK: shift_right_signed + ! CHECK: xor + ! CHECK: subi + ! CHECK-DAG: subi + ! CHECK-DAG: cmpi "slt" + ! CHECK: select + c = sign(a, b) +end subroutine + +! CHECK-LABEL: sign_testr +subroutine sign_testr(a, b, c) + real a, b, c + ! CHECK-DAG: call {{.*}}fabs + ! CHECK-DAG: fir.negf + ! CHECK-DAG: fir.cmpf "olt" + ! CHECK: select + c = sign(a, b) +end subroutine + From 8d6a35644c9020b0e0549531f9a0ad7f34eca844 Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 15 Apr 2020 09:53:50 -0700 Subject: [PATCH 0007/1017] This is some initial work on getting Burnside to use the new symbol map for lowering. This piece primarily gets started in the direction of being able to lower dynamic arrays and character types correctly. There is still more work in fully leveraging this in the bridge, but all the existing tests pass with this rewrite. FIR changes: This patch changes the FIR region operations to be more like those found in the loop dialect. The changes are driven by the desire to be able to convert FIR into a register ssa form. The changes are specifically: - fir.loop has been replaced by fir.do_loop. The new form has the same semantics (inclusive bounds, unordered), but can now carry ssa-values around the loop and return them as results to the parent. - fir.where has been replaced by fir.if. This new form is identical to the current loop.if operation. - fir.iterate_while has been added. This operation is very similar to fir.loop with the addition that it requires a single loop-carried bool value that signals an early-exit condition to the operation. While that value is true, iterate_while will continue to iterate. When it becomes false, the loop is exited. - fir.result is the new terminator for the above ops to facilitate the carrying of ssa-values through block arguments (phi nodes). Change the syntax for fir.iterate_while to make it clear that the iterate condition is required. Fixes bugs with lowering of fir.iterate_while to CFG. The lowered code produced is now as follows. %0 = llvm.mlir.constant(1 : index) : !llvm.i64 %1 = llvm.mlir.constant(100 : index) : !llvm.i64 llvm.br ^bb1(%0, %arg0, %arg1 : !llvm.i64, !llvm.i1, !llvm.i32) ^bb1(%2: !llvm.i64, %3: !llvm.i1, %4: !llvm.i32): // 2 preds: ^bb0, ^bb2 %5 = llvm.icmp "slt" %2, %1 : !llvm.i64 %6 = llvm.and %5, %3 : !llvm.i1 llvm.cond_br %6, ^bb2, ^bb3 ^bb2: // pred: ^bb1 %7 = ... : !llvm.i1 %8 = llvm.add %2, %0 : !llvm.i64 llvm.br ^bb1(%8, %7, %4 : !llvm.i64, !llvm.i1, !llvm.i32) ^bb3: // pred: ^bb1 [review comment] improve description text to make it more clear [review] minor cleanups per review comments --- flang/lib/Lower/Bridge.cpp | 411 +++++++++++++----- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 123 ++++-- flang/test/Fir/embox-write.fir | 2 +- flang/test/Fir/loop.fir | 6 +- flang/test/Fir/loop10.fir | 5 +- flang/test/Lower/character-assignment.f90 | 68 +-- 6 files changed, 453 insertions(+), 162 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index bc7b44b291d12..9d65a8e899386 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -95,6 +95,131 @@ struct IncrementLoopInfo { }; } // namespace +static bool symIsChar(const Fortran::semantics::Symbol &sym) { + return sym.GetType()->category() == + Fortran::semantics::DeclTypeSpec::Character; +} + +static bool symIsArray(const Fortran::semantics::Symbol &sym) { + const auto *det = sym.detailsIf(); + return det ? det->IsArray() : false; +} + +static bool isExplicitShape(const Fortran::semantics::Symbol &sym) { + const auto *det = sym.detailsIf(); + if (det && det->IsArray()) + return det->shape().IsExplicitShape(); + return false; +} + +/// Temporary helper to detect shapes that do not require evaluating +/// bound expressions at runtime or to get the shape from a descriptor. +static bool isConstantShape(const Fortran::semantics::ArraySpec &shape) { + auto isConstant = [](const auto &bound) { + const auto &expr = bound.GetExplicit(); + return expr.has_value() && Fortran::evaluate::IsConstantExpr(*expr); + }; + for (const auto &susbcript : shape) { + const auto &lb = susbcript.lbound(); + const auto &ub = susbcript.ubound(); + if (isConstant(lb) && (isConstant(ub) || ub.isAssumed())) + continue; + return false; + } + return true; +} + +namespace { +struct SymbolIndexAnalyzer { + using FromBox = std::monostate; + + explicit SymbolIndexAnalyzer(const Fortran::semantics::Symbol &sym) + : sym{sym} {} + SymbolIndexAnalyzer() = delete; + SymbolIndexAnalyzer(const SymbolIndexAnalyzer &) = delete; + + void analyze() { + isChar = symIsChar(sym); + if (isChar) { + const auto &lenParam = sym.GetType()->characterTypeSpec().length(); + if (auto expr = lenParam.GetExplicit()) { + auto len = Fortran::evaluate::AsGenericExpr(std::move(*expr)); + auto asInt = Fortran::evaluate::ToInt64(len); + if (asInt) { + charLen = *asInt; + } else { + charLen = len; + staticSize = false; + } + } else { + charLen = FromBox{}; + staticSize = false; + } + } + isArray = symIsArray(sym); + for (const auto &subs : getSymShape()) { + auto low = subs.lbound().GetExplicit(); + auto high = subs.ubound().GetExplicit(); + if (staticSize && low && high) { + auto lb = Fortran::evaluate::ToInt64(*low); + auto ub = Fortran::evaluate::ToInt64(*high); + if (lb && ub) { + staticLBound.push_back(*lb); + staticShape.push_back(*ub - *lb + 1); + continue; + } + } + staticSize = false; + dynamicBound.push_back(&subs); + } + } + + const Fortran::semantics::ArraySpec &getSymShape() { + return sym.get().shape(); + } + + /// Get the CHARACTER's LEN value, if there is one. + llvm::Optional getCharLenConst() { + if (isChar) + if (auto *res = std::get_if(&charLen)) + return {*res}; + return {}; + } + + /// Get the CHARACTER's LEN expression, if there is one. + llvm::Optional getCharLenExpr() { + if (isChar) + if (auto *res = std::get_if(&charLen)) + return {*res}; + return {}; + } + + /// Is it a CHARACTER with a constant LEN? + bool charConstSize() const { + return isChar && std::holds_alternative(charLen); + } + + bool isTrivial() const { return !(isChar || isArray); } + + bool lboundIsAllOnes() const { + return staticSize && + llvm::all_of(staticLBound, [](int64_t v) { return v == 1; }); + } + + llvm::SmallVector staticLBound; + llvm::SmallVector staticShape; + llvm::SmallVector dynamicBound; + bool staticSize{true}; + bool isChar{false}; + bool isArray{false}; + +private: + std::variant charLen{ + FromBox{}}; + const Fortran::semantics::Symbol &sym; +}; +} // namespace + //===----------------------------------------------------------------------===// // FirConverter //===----------------------------------------------------------------------===// @@ -1373,23 +1498,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { return Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty); } - /// Temporary helper to detect shapes that do not require evaluating - /// bound expressions at runtime or to get the shape from a descriptor. - static bool isConstantShape(const Fortran::semantics::ArraySpec &shape) { - auto isConstant{[](const auto &bound) { - const auto &expr = bound.GetExplicit(); - return expr.has_value() && Fortran::evaluate::IsConstantExpr(*expr); - }}; - for (const auto &susbcript : shape) { - const auto &lb = susbcript.lbound(); - const auto &ub = susbcript.ubound(); - if (isConstant(lb) && (isConstant(ub) || ub.isAssumed())) - break; - return false; - } - return true; - } - /// Evaluate specification expressions of local symbol and add /// the resulting `mlir::Value` to localSymbols. /// Before evaluating a specification expression, the symbols @@ -1476,43 +1584,26 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm_unreachable("Varun: put your code here"); } - // FIXME: This is not quite right. The constant rows should *NOT* be entered - // into the shape. (This will allocate too much space.) - bool collectVariableDynamicShape(llvm::SmallVectorImpl &shape, - const Fortran::semantics::Symbol &sym) { - if (const auto *det = - sym.detailsIf()) { - const auto &shapeSpec = det->shape(); - if (isConstantShape(shapeSpec)) - return false; - for (const auto &subs : shapeSpec) { - if (subs.lbound().isExplicit() && subs.ubound().isExplicit()) { - auto lo = builder->convertToIndexType(genExprValue( - Fortran::semantics::SomeExpr(*subs.lbound().GetExplicit()))); - auto hi = builder->convertToIndexType(genExprValue( - Fortran::semantics::SomeExpr(*subs.ubound().GetExplicit()))); - auto one = builder->createIntegerConstant(builder->getIndexType(), 1); - auto loc = toLocation(); - auto diff = builder->create(loc, hi, lo); - auto sizeDim = builder->create(loc, one, diff); - shape.push_back(sizeDim); - } else { - TODO(); - } - } - return true; - } - return false; - } - /// Create a stack slot for a local variable. Precondition: the insertion /// point of the builder must be in the entry block, which is currently being /// constructed. mlir::Value createNewLocal(mlir::Location loc, const Fortran::semantics::Symbol &sym, llvm::ArrayRef shape = {}) { - return builder->create( - loc, genType(sym), sym.name().ToString(), llvm::None, shape); + auto ty = genType(sym); + auto nm = sym.name().ToString(); + if (shape.size()) + if (auto arrTy = ty.dyn_cast()) { + // elide the constant dimensions before construction + assert(shape.size() == arrTy.getDimension()); + llvm::SmallVector args; + auto typeShape = arrTy.getShape(); + for (unsigned i = 0, end = arrTy.getDimension(); i < end; ++i) + if (typeShape[i] == fir::SequenceType::getUnknownExtent()) + args.push_back(shape[i]); + return builder->create(loc, ty, nm, llvm::None, args); + } + return builder->create(loc, ty, nm, llvm::None, shape); } /// Instantiate a local variable. Precondition: Each variable will be visited @@ -1520,67 +1611,191 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// depends will already have been visited. void instantiateLocal(const Fortran::lower::pft::Variable &var) { const auto &sym = var.getSymbol(); + const auto loc = toLocation(); + builder->setLocation(loc); + auto idxTy = builder->getIndexType(); + const auto isDummy = Fortran::semantics::IsDummy(sym); + SymbolIndexAnalyzer sia(sym); + sia.analyze(); + + if (sia.isTrivial()) { + if (isDummy) { + // This is an argument. + assert(lookupSymbol(sym) && "must already be in map"); + return; + } + // TODO: What about lower host-associated variables? (They probably need + // to be handled as dummy parameters.) + + // Otherwise, it's a local variable. + auto local = createNewLocal(loc, sym); + addSymbol(sym, local); + return; + } - // If this is an array, collect it's dynamic shape. If it's size is constant - // `shape` will have no size. - llvm::SmallVector shape; - auto hasDynamicShape = collectVariableDynamicShape(shape, sym); + // The non-trivial cases are when we have an argument or local that has a + // repetition value. Arguments might be passed as simple pointers and need + // to be cast to a multi-dimensional array with constant bounds (possibly + // with a missing column), bounds computed in the callee (here), or with + // bounds from the caller (boxed somewhere else). Locals have the same + // properties except they are never boxed arguments from the caller and + // never having a missing column size. + mlir::Value addr = lookupSymbol(sym); + mlir::Value len{}; + bool mustBeDummy = false; + + if (sia.isChar) { + // if element type is a CHARACTER, determine the LEN value + if (isDummy) { + auto unboxchar = builder->createUnboxChar(addr); + auto boxAddr = unboxchar.first; + if (auto c = sia.getCharLenConst()) { + // Set/override LEN with a constant + len = builder->createIntegerConstant(idxTy, *c); + addr = builder->createEmboxChar(boxAddr, len); + } else if (auto e = sia.getCharLenExpr()) { + // Set/override LEN with an expression + len = genExprValue(*e); + addr = builder->createEmboxChar(boxAddr, len); + } else { + // LEN is from the boxchar + len = unboxchar.second; + mustBeDummy = true; + } + // XXX: Subsequent lowering expects a CHARACTER variable to be in a + // boxchar. We assert that here. We might want to reconsider this + // precondition. + assert(addr.getType().isa()); + } else { + // local CHARACTER variable + if (auto c = sia.getCharLenConst()) { + len = builder->createIntegerConstant(idxTy, *c); + } else { + auto e = sia.getCharLenExpr(); + assert(e && "CHARACTER variable must have LEN parameter"); + len = genExprValue(*e); + } + assert(!addr); + } + } - const auto *type = sym.GetType(); - auto loc = toLocation(); - if (type->category() == Fortran::semantics::DeclTypeSpec::Character) { - const auto &lengthParam = type->characterTypeSpec().length(); - if (auto expr = lengthParam.GetExplicit()) { - auto len = - genExprValue(Fortran::evaluate::AsGenericExpr(std::move(*expr))); - if (Fortran::semantics::IsDummy(sym)) { - if (hasDynamicShape) { - // case: `CHARACTER(LEN=i_arg) :: c_var(dims)` - TODO(); + if (sia.isArray) { + // if object is an array process the lower bound and extent values + llvm::SmallVector bounds; + mustBeDummy = !isExplicitShape(sym); + if (sia.staticSize) { + // object shape is constant + auto castTy = fir::ReferenceType::get(genType(sym)); + if (addr) + addr = builder->create(loc, castTy, addr); + if (sia.lboundIsAllOnes()) { + // if lower bounds are all ones, build simple shaped object + llvm::SmallVector shape; + for (auto i : sia.staticShape) + shape.push_back(builder->createIntegerConstant(idxTy, i)); + if (sia.isChar) { + if (isDummy) { + localSymbols.addCharSymbolWithShape(sym, addr, len, shape, true); + return; + } + // local CHARACTER array with constant size + auto local = createNewLocal(loc, sym); + localSymbols.addCharSymbolWithShape(sym, local, len, shape); + return; } - // case: `CHARACTER(LEN=i_arg) :: c_arg` - // Rebox the argument with the user-specified length. An alternative - // lowering would be to unbox the buffer reference and keep track of - // it and the length in the lookup table. - - // NOTE: we could have a debug mode to generate diagnostic code to - // verify that the reboxing is simpatico. - auto original = lookupSymbol(sym); - auto unboxed = builder->createUnboxChar(original); - auto addr = builder->createEmboxChar(unboxed.first, len); - addCharSymbol(sym, addr, len, /*forced=*/true); - } else { - auto charTy = genType(sym); - if (hasDynamicShape) { - // case: `CHARACTER(LEN=i_arg) :: c_var(dims)` - TODO(); + if (isDummy) { + localSymbols.addSymbolWithShape(sym, addr, shape, true); + return; } - auto addr = builder->createCharacterTemp(charTy, len); - addCharSymbol(sym, addr, len); + // local array with constant size + auto local = createNewLocal(loc, sym); + localSymbols.addSymbolWithShape(sym, local, shape); + return; + } + } else { + // cast to the known constant parts from the declaration + auto castTy = fir::ReferenceType::get(genType(sym)); + if (addr) + addr = builder->create(loc, castTy, addr); + } + // construct constants and populate `bounds` + for (const auto &i : llvm::zip(sia.staticLBound, sia.staticShape)) { + auto fst = builder->createIntegerConstant(idxTy, std::get<0>(i)); + auto snd = builder->createIntegerConstant(idxTy, std::get<1>(i)); + bounds.emplace_back(fst, snd); + } + + // default array case: populate `bounds` with lower and extent values + for (const auto &spec : sia.dynamicBound) { + auto low = spec->lbound().GetExplicit(); + auto high = spec->ubound().GetExplicit(); + if (low && high) { + // let the folder deal with the common `ub - 1 + 1` case + auto lb = genExprValue(Fortran::semantics::SomeExpr{*low}); + auto ub = genExprValue(Fortran::semantics::SomeExpr{*high}); + auto ty = ub.getType(); + auto diff = builder->create(loc, ty, ub, lb); + auto one = builder->createIntegerConstant(ty, 1); + auto sz = builder->create(loc, ty, diff, one); + auto idx = builder->create(loc, idxTy, sz); + bounds.emplace_back(lb, idx); + continue; + } + break; + } + + auto unzip = + [&](llvm::SmallVectorImpl &shape, + llvm::ArrayRef bounds) { + std::for_each(bounds.begin(), bounds.end(), [&](const auto &pair) { + mlir::Value second; + std::tie(std::ignore, second) = pair; + shape.push_back(second); + }); + }; + if (sia.isChar) { + if (isDummy) { + localSymbols.addCharSymbolWithBounds(sym, addr, len, bounds, true); + return; } + // local CHARACTER array with computed bounds + assert(!mustBeDummy); + llvm::SmallVector shape; + shape.push_back(len); + unzip(shape, bounds); + auto local = createNewLocal(loc, sym, shape); + localSymbols.addCharSymbolWithBounds(sym, local, len, bounds); return; } - // If it is deferred or assumed, then argument must be a boxchar. - assert(lookupSymbol(sym) && "CHARACTER argument must be added"); + if (isDummy) { + localSymbols.addSymbolWithBounds(sym, addr, bounds, true); + return; + } + // local array with computed bounds + assert(!mustBeDummy); + llvm::SmallVector shape; + unzip(shape, bounds); + auto local = createNewLocal(loc, sym, shape); + localSymbols.addSymbolWithBounds(sym, local, bounds); return; } - // If this is an argument, we don't need to add a stack slot. - // TODO: consider pass-by-value however. - if (Fortran::semantics::IsDummy(sym)) + // not an array, so process as scalar argument + if (sia.isChar) { + if (isDummy) { + addCharSymbol(sym, addr, len, true); + return; + } + assert(!mustBeDummy); + auto local = createNewLocal(loc, sym); + addCharSymbol(sym, local, len); return; - - // FIXME: (1) If this is a POINTER variable, a !fir.ptr should be allocated - // and set to null. (2) If this is an ALLOCATABLE variable, a !fir.heap - // should be allocated and set to null (deferred, double indirect) or an - // allocmem value be allocated (immediate, one-level indirect). (3) If the - // variable is neither POINTER nor ALLOCATABLE, we should examine the size - // of the variable. If the variable is "very large" (per some heuristic), - // then it ought to be promoted to the heap, rather than allocated on the - // stack. In all cases, the `pft::Variable` can then be used to track heap - // allocations (either immediate or by promotion) and reclaim the heap space - // in the exit block. - auto local = createNewLocal(loc, sym, shape); + } + if (isDummy) { + addSymbol(sym, addr, true); + return; + } + auto local = createNewLocal(loc, sym); addSymbol(sym, local); } diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 0b58209d28387..4c316c4338bb4 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -93,27 +93,9 @@ class LoopLoopConv : public mlir::OpRewritePattern { mlir::LogicalResult matchAndRewrite(LoopOp loop, mlir::PatternRewriter &rewriter) const override { auto loc = loop.getLoc(); - auto low = loop.getLowerBoundOperand(); - if (!low) { - assert(loop.constantLowerBound().hasValue()); - auto lb = *loop.constantLowerBound(); - low = rewriter.create(loc, lb.getSExtValue()); - } - auto high = loop.getUpperBoundOperand(); - if (!high) { - assert(loop.constantUpperBound().hasValue()); - auto ub = *loop.constantUpperBound(); - high = rewriter.create(loc, ub.getSExtValue()); - } - auto step = loop.getStepOperand(); - if (!step) { - if (loop.constantStep().hasValue()) { - auto st = *loop.constantStep(); - step = rewriter.create(loc, st.getSExtValue()); - } else { - step = rewriter.create(loc, 1); - } - } + auto low = loop.lowerBound(); + auto high = loop.upperBound(); + auto step = loop.step(); assert(low && high && step); // ForOp has different bounds semantics. Adjust upper bound. auto adjustUp = rewriter.create(loc, high, step); @@ -150,17 +132,94 @@ class LoopWhereConv : public mlir::OpRewritePattern { }; /// Replace FirEndOp with TerminatorOp -class LoopFirEndConv : public mlir::OpRewritePattern { +class LoopResultConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; mlir::LogicalResult - matchAndRewrite(FirEndOp op, mlir::PatternRewriter &rewriter) const override { + matchAndRewrite(fir::ResultOp op, + mlir::PatternRewriter &rewriter) const override { rewriter.replaceOpWithNewOp(op); return success(); } }; +class LoopIterWhileConv : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(fir::IterWhileOp whileOp, + mlir::PatternRewriter &rewriter) const override { + mlir::Location loc = whileOp.getLoc(); + + // Start by splitting the block containing the 'fir.do_loop' into two parts. + // The part before will get the init code, the part after will be the end + // point. + auto *initBlock = rewriter.getInsertionBlock(); + auto initPosition = rewriter.getInsertionPoint(); + auto *endBlock = rewriter.splitBlock(initBlock, initPosition); + + // Use the first block of the loop body as the condition block since it is + // the block that has the induction variable and loop-carried values as + // arguments. Split out all operations from the first block into a new + // block. Move all body blocks from the loop body region to the region + // containing the loop. + auto *conditionBlock = &whileOp.region().front(); + auto *firstBodyBlock = + rewriter.splitBlock(conditionBlock, conditionBlock->begin()); + auto *lastBodyBlock = &whileOp.region().back(); + rewriter.inlineRegionBefore(whileOp.region(), endBlock); + auto iv = conditionBlock->getArgument(0); + auto iterateVar = conditionBlock->getArgument(1); + + // Append the induction variable stepping logic to the last body block and + // branch back to the condition block. Loop-carried values are taken from + // operands of the loop terminator. + mlir::Operation *terminator = lastBodyBlock->getTerminator(); + rewriter.setInsertionPointToEnd(lastBodyBlock); + auto step = whileOp.step(); + auto stepped = rewriter.create(loc, iv, step).getResult(); + if (!stepped) + return failure(); + + llvm::SmallVector loopCarried; + loopCarried.push_back(stepped); + loopCarried.append(terminator->operand_begin(), terminator->operand_end()); + rewriter.create(loc, conditionBlock, loopCarried); + rewriter.eraseOp(terminator); + + // Compute loop bounds before branching to the condition. + rewriter.setInsertionPointToEnd(initBlock); + mlir::Value lowerBound = whileOp.lowerBound(); + mlir::Value upperBound = whileOp.upperBound(); + if (!lowerBound || !upperBound) + return failure(); + + // The initial values of loop-carried values is obtained from the operands + // of the loop operation. + llvm::SmallVector destOperands; + destOperands.push_back(lowerBound); + auto iterOperands = whileOp.getIterOperands(); + destOperands.append(iterOperands.begin(), iterOperands.end()); + rewriter.create(loc, conditionBlock, destOperands); + + // With the body block done, we can fill in the condition block. + rewriter.setInsertionPointToEnd(conditionBlock); + auto comp1 = + rewriter.create(loc, CmpIPredicate::slt, iv, upperBound); + // Remember to AND in the early-exit bool. + auto comparison = rewriter.create(loc, comp1, iterateVar); + rewriter.create(loc, comparison, firstBodyBlock, + ArrayRef(), endBlock, + ArrayRef()); + // The result of the loop operation is the values of the condition block + // arguments except the induction variable on the last iteration. + rewriter.replaceOp(whileOp, conditionBlock->getArguments().drop_front()); + return success(); + } +}; + /// Convert `fir.loop` and `fir.where` to `loop.for` and `loop.if`. class LoopDialectConversion : public mlir::PassWrapper { @@ -170,17 +229,27 @@ class LoopDialectConversion return; auto *context = &getContext(); - mlir::OwningRewritePatternList patterns; - patterns.insert(context); + mlir::OwningRewritePatternList patterns1; + patterns1.insert(context); + + mlir::OwningRewritePatternList patterns2; + patterns2.insert(context); mlir::ConversionTarget target = *context; target.addLegalDialect(); - target.addIllegalOp(); // apply the patterns + target.addIllegalOp(); if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, - std::move(patterns)))) { + std::move(patterns1)))) { + mlir::emitError(mlir::UnknownLoc::get(context), + "error in converting to CFG\n"); + signalPassFailure(); + } + target.addIllegalOp(); + if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, + std::move(patterns2)))) { mlir::emitError(mlir::UnknownLoc::get(context), "error in converting to MLIR loop dialect\n"); signalPassFailure(); diff --git a/flang/test/Fir/embox-write.fir b/flang/test/Fir/embox-write.fir index 465848fdbd647..6766f72c0eb2e 100644 --- a/flang/test/Fir/embox-write.fir +++ b/flang/test/Fir/embox-write.fir @@ -9,7 +9,7 @@ func @set_all_n(%n : index, %x : i32) { %a = fir.embox %aMem, %aDim : (!fir.ref>, !fir.dims<1>) -> !fir.box> // CHECK: phi i64 // CHECK-NEXT: icmp - fir.loop %i = %c1 to %n unordered { + fir.do_loop %i = %c1 to %n step %c1 unordered { %1 = fir.coordinate_of %a, %i : (!fir.box>, index) -> !fir.ref // CHECK: store i32 %{{.*}}, i32* %{{.*}} fir.store %x to %1 : !fir.ref diff --git a/flang/test/Fir/loop.fir b/flang/test/Fir/loop.fir index d85bb2e202260..2c13f992aff4b 100644 --- a/flang/test/Fir/loop.fir +++ b/flang/test/Fir/loop.fir @@ -6,12 +6,12 @@ func @x(%lb : index, %ub : index, %step : index, %b : i1, %addr : !fir.ref) { // CHECK: %[[COND:.*]] = icmp slt i64 // CHECK: br i1 %[[COND]] - fir.loop %iv = %lb to %ub step %step unordered { + fir.do_loop %iv = %lb to %ub step %step unordered { // CHECK: br i1 % - fir.where %b { + fir.if %b { // CHECK: store i64 fir.store %iv to %addr : !fir.ref - } otherwise { + } else { %zero = constant 0 : index // CHECK: store i64 fir.store %zero to %addr : !fir.ref diff --git a/flang/test/Fir/loop10.fir b/flang/test/Fir/loop10.fir index 7c657e21d2863..9969dfee8be50 100644 --- a/flang/test/Fir/loop10.fir +++ b/flang/test/Fir/loop10.fir @@ -6,12 +6,13 @@ func @x(%addr : !fir.ref>) -> index { %c0 = constant 0 : index %c10 = constant 10 : index + %c1 = constant 1 : index // CHECK: %[[ROW:.*]] = phi i64 // CHECK: icmp slt i64 %[[ROW]], 11 - fir.loop %iv = %c0 to %c10 { + fir.do_loop %iv = %c0 to %c10 step %c1 { // CHECK: %[[COL:.*]] = phi i64 // CHECK: icmp slt i64 %[[COL]], 11 - fir.loop %jv = (0) to (10) { + fir.do_loop %jv = %c0 to %c10 step %c1 { // CHECK: getelementptr {{.*}} %[[ADDR]], i64 0, i64 %[[ROW]], i64 %[[COL]] %ptr = fir.coordinate_of %addr, %jv, %iv : (!fir.ref>, index, index) -> !fir.ref %c22 = constant 22 : i32 diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index 9c455ac1bae41..db675ab57187e 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -1,23 +1,26 @@ -! RUN: bbc %s -o "-" -emit-fir | FileCheck %s +! RUN: bbc %s -o - -emit-fir | FileCheck %s +! RUN: bbc %s -o - | FileCheck --check-prefix=UNBOX %s ! Simple character assignment tests +! UNBOX-LABEL: assign1 ! CHECK-LABEL: assign1 subroutine assign1(lhs, rhs) character(*, 1) :: lhs, rhs lhs = rhs - ! Unboxing - ! CHECK-DAG:[[lhs:%[0-9]+]]:2 = fir.unboxchar %arg0 - ! CHECK-DAG:[[rhs:%[0-9]+]]:2 = fir.unboxchar %arg1 - ! Compute minimum length - ! CHECK-DAG:%[[cmp_len:[0-9]+]] = cmpi "slt", [[lhs]]#1, [[rhs]]#1 - ! CHECK-DAG:[[min_len:%[0-9]+]] = select %[[cmp_len]], [[lhs]]#1, [[rhs]]#1 + ! UNBOX-DAG: %[[lhs:.*]]:2 = fir.unboxchar %arg0 + ! UNBOX-DAG: %[[rhs:.*]]:2 = fir.unboxchar %arg1 + ! UNBOX: %[[cmp_len:[0-9]+]] = cmpi "slt", %[[lhs]]#1, %[[rhs]]#1 + ! UNBOX-NEXT: %[[min_len:[0-9]+]] = select %[[cmp_len]], %[[lhs]]#1, %[[rhs]]#1 + + ! CHECK: %[[cmp_len:[0-9]+]] = cmpi "slt", %[[lhs:.*]]#1, %[[rhs:.*]]#1 + ! CHECK-NEXT: %[[min_len:[0-9]+]] = select %[[cmp_len]], %[[lhs]]#1, %[[rhs]]#1 ! Allocate temp in case rhs and lhs may overlap - ! CHECK: [[tmp:%[0-9]+]] = fir.alloca !fir.char<1>, [[min_len]] + ! CHECK: %[[tmp:.*]] = fir.alloca !fir.char<1>, %[[min_len]] ! Copy of rhs into temp - ! CHECK: fir.loop [[i:%[[:alnum:]_]+]] + ! CHECK: fir.do_loop [[i:%[[:alnum:]_]+]] ! CHECK-DAG: [[rhs_addr:%[0-9]+]] = fir.coordinate_of [[rhs]]#0, [[i]] ! CHECK-DAG: [[tmp_addr:%[0-9]+]] = fir.coordinate_of [[tmp]], [[i]] ! CHECK-DAG: [[rhs_elt:%[0-9]+]] = fir.load [[rhs_addr]] @@ -25,7 +28,7 @@ subroutine assign1(lhs, rhs) ! CHECK: } ! Copy of temp into lhs - ! CHECK: fir.loop [[i:%[[:alnum:]]+]] + ! CHECK: fir.do_loop [[i:%[[:alnum:]]+]] ! CHECK-DAG: [[tmp_addr:%[0-9]+]] = fir.coordinate_of [[tmp]], [[i]] ! CHECK-DAG: [[lhs_addr:%[0-9]+]] = fir.coordinate_of [[lhs]]#0, [[i]] ! CHECK-DAG: [[tmp_elt:%[0-9]+]] = fir.load [[tmp_addr]] @@ -35,7 +38,7 @@ subroutine assign1(lhs, rhs) ! Padding ! CHECK: [[c32:%[[:alnum:]_]+]] = constant 32 : i8 ! CHECK: [[blank:%[0-9]+]] = fir.convert [[c32]] : (i8) -> !fir.char<1> - ! CHECK: fir.loop [[i:%[[:alnum:]_]+]] + ! CHECK: fir.do_loop [[i:%[[:alnum:]_]+]] ! CHECK-DAG: [[lhs_addr:%[0-9]+]] = fir.coordinate_of [[lhs]]#0, [[i]] ! CHECK: fir.store [[blank]] to [[lhs_addr]] ! CHECK: } @@ -47,54 +50,57 @@ subroutine assign_substring1(str, rhs, lb, ub) character(*, 1) :: rhs, str integer(8) :: lb, ub str(lb:ub) = rhs - ! CHECK-DAG: [[lb:%[0-9]+]] = fir.load %arg2 - ! CHECK-DAG: [[ub:%[0-9]+]] = fir.load %arg3 - ! CHECK-DAG: [[str:%[0-9]+]]:2 = fir.unboxchar %arg0 + ! CHECK-DAG: %[[lb:.*]] = fir.load %arg2 + ! CHECK-DAG: %[[ub:.*]] = fir.load %arg3 + ! CHECK: %[[str:.*]]:2 = fir.unboxchar %arg0 ! Compute substring offset - ! CHECK-DAG: [[lbi:%[0-9]+]] = fir.convert [[lb]] : (i64) -> index - ! CHECK-DAG: [[c1:%[[:alnum:]_]+]] = constant 1 - ! CHECK-DAG: [[offset:%[0-9]+]] = subi [[lbi]], [[c1]] - ! CHECK-DAG: [[lhs_addr:%[0-9]+]] = fir.coordinate_of [[str]]#0, [[offset]] + ! CHECK-DAG: %[[lbi:.*]] = fir.convert %[[lb]] : (i64) -> index + ! CHECK-DAG: %[[c1:.*]] = constant 1 + ! CHECK-DAG: %[[offset:.*]] = subi %[[lbi]], %[[c1]] + ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[str]]#0, %[[offset]] ! Compute substring length - ! CHECK-DAG: [[diff:%[0-9]+]] = subi [[ub]], [[lb]] - ! CHECK-DAG: [[c1:%[[:alnum:]_]+]] = constant 1 - ! CHECK-DAG: [[pre_lhs_len:%[0-9]+]] = addi [[diff]], [[c1]] - ! CHECK-DAG: [[c0:%[[:alnum:]_]+]] = constant 0 - ! CHECK-DAG: [[cmp_len:%[0-9]+]] = cmpi "slt", [[pre_lhs_len]], [[c0]] - ! CHECK-DAG: [[lhs_len:%[0-9]+]] = select [[cmp_len]], [[c0]], [[pre_lhs_len]] + ! CHECK-DAG: %[[diff:.*]] = subi %[[ub]], %[[lb]] + ! CHECK-DAG: %[[c1:.*]] = constant 1 + ! CHECK-DAG: %[[pre_lhs_len:.*]] = addi %[[diff]], %[[c1]] + ! CHECK-DAG: %[[c0:.*]] = constant 0 + ! CHECK-DAG: %[[cmp_len:.*]] = cmpi "slt", %[[pre_lhs_len]], %[[c0]] + ! CHECK-DAG: %[[lhs_len:.*]] = select %[[cmp_len]], %[[c0]], %[[pre_lhs_len]] - ! CHECK: [[lhs_box:%[0-9]+]] = fir.emboxchar [[lhs_addr]], [[lhs_len]] + ! CHECK: %[[lhs_box:.*]] = fir.emboxchar %[[lhs_addr]], %[[lhs_len]] ! The rest of the assignment is just as the one above, only test that the ! substring box is the one used ! ... - ! CHECK: [[lhs:%[0-9]+]]:2 = fir.unboxchar [[lhs_box]] + ! CHECK: %[[lhs:.*]]:2 = fir.unboxchar %[[lhs_box]] ! ... - ! CHECK: fir.coordinate_of [[lhs]]#0, {{.*}} + ! CHECK: fir.coordinate_of %[[lhs]]#0, ! ... end subroutine +! UNBOX-LABEL: assign_constant ! CHECK-LABEL: assign_constant ! CHECK: (%[[ARG:.*]]:{{.*}}) subroutine assign_constant(lhs) character(*, 1) :: lhs - ! CHECK-DAG: %[[lhs:.*]]:2 = fir.unboxchar %[[ARG]] : + ! UNBOX: %[[lhs:.*]]:2 = fir.unboxchar %arg0 ! CHECK-DAG: %[[tmp:.*]] = fir.address_of(@{{.*}}) : lhs = "Hello World" - ! CHECK: fir.loop %[[i:.*]] = %{{.*}} to %{{.*}} { + ! CHECK: fir.do_loop %[[i:.*]] = %{{.*}} to %{{.*}} { ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[i]] ! CHECK-DAG: %[[tmp_elt:.*]] = fir.load %[[tmp_addr]] - ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[i]] + ! UNBOX: = fir.coordinate_of %[[lhs]]#0, % + ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs:.*]]#0, %[[i]] ! CHECK: fir.store %[[tmp_elt]] to %[[lhs_addr]] ! CHECK: } ! Padding ! CHECK-DAG: %[[c32:.*]] = constant 32 : i8 ! CHECK-DAG: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> - ! CHECK: fir.loop %[[j:.*]] = %{{.*}} to %{{.*}} { + ! CHECK: fir.do_loop %[[j:.*]] = %{{.*}} to %{{.*}} { + ! UNBOX: = fir.coordinate_of %[[lhs]]#0, % ! CHECK: %[[jhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[j]] ! CHECK: fir.store %[[blank]] to %[[jhs_addr]] ! CHECK: } From 13be63b100c67ec64fc83262300d5b4f39eb17ce Mon Sep 17 00:00:00 2001 From: Varun Jayathirtha Date: Wed, 15 Apr 2020 10:01:35 -0700 Subject: [PATCH 0008/1017] Instantiate global scalar values. 1. Initialize scalar intrinsic types 2. Add test global inits. 3. Add TODO place holders for things that need to be implemented --- flang/lib/Lower/Bridge.cpp | 30 +++++++++++++- flang/lib/Lower/Mangler.cpp | 70 +++++++++----------------------- flang/test/Lower/global-init.f90 | 23 +++++++++++ 3 files changed, 71 insertions(+), 52 deletions(-) create mode 100755 flang/test/Lower/global-init.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 9d65a8e899386..3414302ad33e1 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1581,7 +1581,35 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// the global to the ModuleOp as a new uniqued symbol and initialize it with /// the correct value. It will be referenced on demand using `fir.addr_of`. void instantiateGlobal(const Fortran::lower::pft::Variable &var) { - llvm_unreachable("Varun: put your code here"); + const auto &sym = var.getSymbol(); + std::string globalName = mangleName(sym); + fir::GlobalOp global; + if (builder->getNamedGlobal(globalName)) + return; + if (const auto *details = + sym.detailsIf()) { + if (details->init()) { + if (details->IsArray()) { + TODO(); + return; + } else if (!sym.GetType()->AsIntrinsic()) { + TODO(); // Derived type / polymorphic + return; + } else + global = builder->createGlobal( + toLocation(), genType(sym), globalName, false, + [&](Fortran::lower::FirOpBuilder &builder) { + auto initVal = genExprValue(details->init().value()); + builder.create(toLocation(), initVal); + }); + } else + global = builder->createGlobal(toLocation(), genType(sym), globalName); + auto addrOf = builder->create( + toLocation(), global.resultType(), global.getSymbol()); + addSymbol(sym, addrOf); + } else { + TODO(); // Procedure pointer + } } /// Create a stack slot for a local variable. Precondition: the insertion diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp index 07d9e63e04232..d8a203890acaf 100644 --- a/flang/lib/Lower/Mangler.cpp +++ b/flang/lib/Lower/Mangler.cpp @@ -8,7 +8,6 @@ #include "flang/Lower/Mangler.h" #include "flang/Common/reference.h" -#include "flang/Lower/Todo.h" #include "flang/Lower/Utils.h" #include "flang/Optimizer/Dialect/FIRType.h" #include "flang/Optimizer/Support/InternalNames.h" @@ -66,8 +65,8 @@ findInterfaceIfSeperateMP(const Fortran::semantics::Symbol &symbol) { // Mangle the name of `symbol` to make it unique within FIR's symbol table using // the FIR name mangler, `mangler` std::string -Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol, - bool keepExternalInScope) { +Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer, + const Fortran::semantics::Symbol &symbol) { // Resolve host and module association before mangling const auto &ultimateSymbol = symbol.GetUltimate(); auto symbolName = toStringRef(ultimateSymbol.name()); @@ -75,14 +74,12 @@ Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol, return std::visit( Fortran::common::visitors{ [&](const Fortran::semantics::MainProgramDetails &) { - return fir::NameUniquer::doProgramEntry().str(); + return uniquer.doProgramEntry().str(); }, [&](const Fortran::semantics::SubprogramDetails &) { // Mangle external procedure without any scope prefix. - if (!keepExternalInScope && - Fortran::semantics::IsExternal(ultimateSymbol)) - return fir::NameUniquer::doProcedure(llvm::None, llvm::None, - symbolName); + if (Fortran::semantics::IsExternal(ultimateSymbol)) + return uniquer.doProcedure(llvm::None, llvm::None, symbolName); // Separate module subprograms must be mangled according to the // scope where they were declared (the symbol we have is the // definition). @@ -90,69 +87,40 @@ Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol, if (const auto *mpIface = findInterfaceIfSeperateMP(ultimateSymbol)) interface = mpIface; auto modNames = moduleNames(*interface); - return fir::NameUniquer::doProcedure(modNames, hostName(*interface), - symbolName); + return uniquer.doProcedure(modNames, hostName(*interface), + symbolName); }, [&](const Fortran::semantics::ProcEntityDetails &) { // Mangle procedure pointers and dummy procedures as variables if (Fortran::semantics::IsPointer(ultimateSymbol) || Fortran::semantics::IsDummy(ultimateSymbol)) - return fir::NameUniquer::doVariable(moduleNames(ultimateSymbol), - hostName(ultimateSymbol), - symbolName); + return uniquer.doVariable(moduleNames(ultimateSymbol), + hostName(ultimateSymbol), symbolName); // Otherwise, this is an external procedure, even if it does not // have an explicit EXTERNAL attribute. Mangle it without any // prefix. - return fir::NameUniquer::doProcedure(llvm::None, llvm::None, - symbolName); + return uniquer.doProcedure(llvm::None, llvm::None, symbolName); }, [&](const Fortran::semantics::ObjectEntityDetails &) { auto modNames = moduleNames(ultimateSymbol); auto optHost = hostName(ultimateSymbol); if (Fortran::semantics::IsNamedConstant(ultimateSymbol)) - return fir::NameUniquer::doConstant(modNames, optHost, - symbolName); - return fir::NameUniquer::doVariable(modNames, optHost, symbolName); + return uniquer.doConstant(modNames, optHost, symbolName); + return uniquer.doVariable(modNames, optHost, symbolName); }, - [&](const Fortran::semantics::CommonBlockDetails &) { - return fir::NameUniquer::doCommonBlock(symbolName); + [&](const Fortran::semantics::ObjectEntityDetails &) { + auto modNames = moduleNames(ultimateSymbol); + return uniquer.doVariable(modNames, hostName(ultimateSymbol), + toStringRef(symbolName)); }, - [&](const Fortran::semantics::DerivedTypeDetails &) -> std::string { - // Derived type mangling must used mangleName(DerivedTypeSpec&) so - // that kind type parameter values can be mangled. - llvm::report_fatal_error( - "only derived type instances can be mangled"); + [](const auto &) -> std::string { + assert(false); + return {}; }, - [](const auto &) -> std::string { TODO_NOLOC("symbol mangling"); }, }, ultimateSymbol.details()); } -std::string Fortran::lower::mangle::mangleName( - const Fortran::semantics::DerivedTypeSpec &derivedType) { - // Resolve host and module association before mangling - const auto &ultimateSymbol = derivedType.typeSymbol().GetUltimate(); - auto symbolName = toStringRef(ultimateSymbol.name()); - auto modNames = moduleNames(ultimateSymbol); - auto optHost = hostName(ultimateSymbol); - llvm::SmallVector kinds; - for (const auto ¶m : - Fortran::semantics::OrderParameterDeclarations(ultimateSymbol)) { - const auto ¶mDetails = - param->get(); - if (paramDetails.attr() == Fortran::common::TypeParamAttr::Kind) { - const auto *paramValue = derivedType.FindParameter(param->name()); - assert(paramValue && "derived type kind parameter value not found"); - auto paramExpr = paramValue->GetExplicit(); - assert(paramExpr && "derived type kind param not explicit"); - auto init = Fortran::evaluate::ToInt64(paramValue->GetExplicit()); - assert(init && "derived type kind param is not constant"); - kinds.emplace_back(*init); - } - } - return fir::NameUniquer::doType(modNames, optHost, symbolName, kinds); -} - std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) { auto result = fir::NameUniquer::deconstruct(name); return result.second.name; diff --git a/flang/test/Lower/global-init.f90 b/flang/test/Lower/global-init.f90 new file mode 100755 index 0000000000000..6f13e72e777b8 --- /dev/null +++ b/flang/test/Lower/global-init.f90 @@ -0,0 +1,23 @@ +! RUN: bbc %s -o - | FileCheck %s + +program bar +! CHECK: fir.address_of(@[[name1:.*]]my_data) +! CHECK: fir.global @[[name1]] + integer, save :: my_data = 1 + print *, my_data +call foo +contains +subroutine foo() +! CHECK: fir.address_of(@[[name2:.*foo.*my_data]]) +! CHECK: fir.global @[[name2]] + integer, save :: my_data = 2 + print *, my_data + 1 +end subroutine +subroutine foo2() +! CHECK: fir.address_of(@[[name3:.*foo2.*my_data]]) +! CHECK: fir.global @[[name3]] + integer, save :: my_data + my_data = 4 + print *, my_data +end subroutine +end program From 3d5114be54805b3ae586ec2486013aa4d1f9b206 Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 20 Apr 2020 16:57:44 -0700 Subject: [PATCH 0009/1017] Reverse conditional create step so that it is created lazily rather than speculatively. This eliminates creation of some empty fir.if blocks. Fix a bug in argument passing. When the expression is already a reference, we don't need or want to create a reference to the reference to pass the original reference. Instead just pass the reference itself. add FIXME for POINTER and ALLOCATABLE tighten some checks fix type mismatch on assignment misc fixes for LAPACK format bullet items --- flang/LAPACK-bugs.txt | 18 ++- flang/lib/Lower/Bridge.cpp | 299 +++++++++++++++++++------------------ 2 files changed, 165 insertions(+), 152 deletions(-) diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index adcd810abe2a7..11369131b361d 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -3,26 +3,30 @@ ______________ [Eric] - We do not correctly handle adjusted arrays of CHARACTER with adjusted LEN - . bbc: IR/Types.h:279: U mlir::Type::cast() const [U = fir::ReferenceType]: Assertion `isa()' failed. - + error: 'fir.coordinate_of' op cannot find coordinate with unknown extents + [Varun] DATA statement - . UNREACHABLE executed at Lower/Bridge.cpp:1102! - - Lowering globals in general - . UNREACHABLE executed at Lower/Bridge.cpp:1294! + loc("lapack/BLAS/SRC/srotmg.f":116:7): error: DATA statement is not handled. [Jean] Intrinsics lowering problems . bbc: Lower/Intrinsics.cpp:763: Assertion `false && "LEN_TRIM TODO"' failed. +[unassigned] + + . unexpected character type + + . lapack/BLAS/SRC/dznrm2.f":112:11): error: 'fir.convert' op invalid type conversion FIXED _____ +Lowering globals in general + +Handle adjusted arrays of CHARACTER with adjusted LEN CHARACTER comparison calls: UNREACHABLE executed at Lower/ConvertExpr.cpp:405! diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 3414302ad33e1..8c30f5cfd12ed 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -430,16 +430,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { return block; } - void genFIRUnconditionalBranch(mlir::Block *targetBlock) { + void genBranch(mlir::Block *targetBlock) { assert(targetBlock && "missing unconditional target block"); builder->create(toLocation(), targetBlock); } - void - genFIRUnconditionalBranch(Fortran::lower::pft::Evaluation *targetEvaluation) { - genFIRUnconditionalBranch(targetEvaluation->block); - } - void genFIRConditionalBranch(mlir::Value &cond, mlir::Block *trueTarget, mlir::Block *falseTarget) { builder->create(toLocation(), cond, trueTarget, @@ -464,29 +459,31 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// /// Generate the cleanup block before the program exits void genExitRoutine() { builder->create(toLocation()); } - void genFIRProgramExit() { genExitRoutine(); } - void genFIR(const Fortran::parser::EndProgramStmt &) { genFIRProgramExit(); } + void genFIR(const Fortran::parser::EndProgramStmt &) { genExitRoutine(); } /// END of procedure-like constructs /// /// Generate the cleanup block before the procedure exits - void genExitFunction(mlir::Value val) { - builder->create(toLocation(), val); - } void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) { const auto &details = functionSymbol.get(); auto resultRef = lookupSymbol(details.result()); - mlir::Value r = builder->create(toLocation(), resultRef); - genExitFunction(r); + mlir::Value retval = builder->create(toLocation(), resultRef); + builder->create(toLocation(), retval); } void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit, const Fortran::semantics::Symbol &symbol) { + // Make sure we end the current block with a terminator. + if (auto *finalBlock = funit.finalBlock) { + if (blockIsUnterminated()) + builder->create(toLocation(), finalBlock); + // Set insertion point to final block. + builder->setInsertionPoint(finalBlock, finalBlock->end()); + } + if (Fortran::semantics::IsFunction(symbol)) { // FUNCTION - if (funit.finalBlock) - builder->setInsertionPoint(funit.finalBlock, funit.finalBlock->end()); genReturnSymbol(symbol); return; } @@ -498,11 +495,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { // return LABEL block TODO(); mlir::Value intExpr{}; - genExitFunction(intExpr); + builder->create(toLocation(), intExpr); return; } - if (funit.finalBlock) - builder->setInsertionPoint(funit.finalBlock, funit.finalBlock->end()); + genExitRoutine(); } @@ -510,23 +506,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Statements that have control-flow semantics // - void switchInsertionPointToWhere(fir::WhereOp &where) { - builder->setInsertionPointToStart(&where.whereRegion().front()); - } - void switchInsertionPointToOtherwise(fir::WhereOp &where) { - builder->setInsertionPointToStart(&where.otherRegion().front()); - } - template - mlir::OpBuilder::InsertPoint genWhereCondition(fir::WhereOp &where, - const A *stmt) { + mlir::OpBuilder::InsertPoint + genWhereCondition(fir::WhereOp &where, const A *stmt, bool withElse = true) { auto cond = createLogicalExprAsI1( toLocation(), Fortran::semantics::GetExpr( std::get(stmt->t))); - where = builder->create(toLocation(), cond, true); + where = builder->create(toLocation(), cond, withElse); auto insPt = builder->saveInsertionPoint(); - switchInsertionPointToWhere(where); + builder->setInsertionPointToStart(&where.whereRegion().front()); return insPt; } @@ -536,10 +525,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { return builder->create(toLocation(), t, v); } - mlir::Value genFIRLoopIndex(const Fortran::parser::ScalarExpr &x) { - return genFIRLoopIndex(x, mlir::IndexType::get(&mlirContext)); - } - mlir::FuncOp getFunc(llvm::StringRef name, mlir::FunctionType ty) { if (auto func = builder->getNamedFunction(name)) { assert(func.getType() == ty); @@ -572,8 +557,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Generate fir.where. fir::WhereOp where; - auto insPt = genWhereCondition(where, &stmt); - genFIR(*eval.lexicalSuccessor, /*unstructuredContext*/ false); + auto insPt = genWhereCondition(where, &stmt, /*withElse=*/false); + genFIR(*eval.lexicalSuccessor, /*unstructuredContext=*/false); eval.lexicalSuccessor->skip = true; builder->restoreInsertionPoint(insPt); } @@ -778,18 +763,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Add entries to incrementLoopInfo. (Define extra members for a mask.) } auto n = incrementLoopInfo.size(); - for (decltype(n) i = 0; i < n; ++i) { + for (decltype(n) i = 0; i < n; ++i) genFIRIncrementLoopBegin(incrementLoopInfo[i]); - } // Generate loop body code. - for (auto &e : *eval.evaluationList) { + for (auto &e : *eval.evaluationList) genFIR(e, unstructuredContext); - } // Generate end loop code. if (infiniteLoop || whileCondition) { - genFIRUnconditionalBranch(doStmtEval.localBlocks[0]); + genBranch(doStmtEval.localBlocks[0]); } else { for (auto i = incrementLoopInfo.size(); i > 0;) genFIRIncrementLoopEnd(incrementLoopInfo[--i]); @@ -872,7 +855,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { location, builder->getIntegerAttr(info.loopVariableType, 1)); tripVariable = builder->create(location, tripVariable, one); builder->create(location, tripVariable, info.tripVariable); - genFIRUnconditionalBranch(info.headerBlock); + genBranch(info.headerBlock); } /// Generate structured or unstructured FIR for an IF construct. @@ -888,15 +871,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { insPt = genWhereCondition(underWhere, s); } else if (auto *s = e.getIf()) { // otherwise block, then nested fir.where - switchInsertionPointToOtherwise(underWhere); + builder->setInsertionPointToStart(&underWhere.otherRegion().front()); genWhereCondition(underWhere, s); } else if (e.isA()) { // otherwise block - switchInsertionPointToOtherwise(underWhere); + builder->setInsertionPointToStart(&underWhere.otherRegion().front()); } else if (e.isA()) { builder->restoreInsertionPoint(insPt); } else { - genFIR(e, /*unstructuredContext*/ false); + genFIR(e, /*unstructuredContext=*/false); } } return; @@ -927,9 +910,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::CaseConstruct &) { - for (auto &e : *eval.evaluationList) { + for (auto &e : *eval.evaluationList) genFIR(e); - } } void genFIR(Fortran::lower::pft::Evaluation &eval, @@ -1111,18 +1093,18 @@ class FirConverter : public Fortran::lower::AbstractConverter { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, + void genFIR(Fortran::lower::pft::Evaluation &, const Fortran::parser::NonLabelDoStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &eval, + void genFIR(Fortran::lower::pft::Evaluation &, const Fortran::parser::EndDoStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &eval, + void genFIR(Fortran::lower::pft::Evaluation &, const Fortran::parser::IfThenStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &eval, + void genFIR(Fortran::lower::pft::Evaluation &, const Fortran::parser::ElseIfStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &eval, + void genFIR(Fortran::lower::pft::Evaluation &, const Fortran::parser::ElseStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &eval, + void genFIR(Fortran::lower::pft::Evaluation &, const Fortran::parser::EndIfStmt &) {} // nop void genFIR(Fortran::lower::pft::Evaluation &eval, @@ -1223,11 +1205,73 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::AssignmentStmt &stmt) { - assert(stmt.typedAssignment && stmt.typedAssignment->v && - "assignment analysis failed"); - const auto &assignment = *stmt.typedAssignment->v; - std::visit( // better formatting + const Fortran::parser::ContinueStmt &) { + // do nothing + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::DeallocateStmt &) { + TODO(); + } + + // We don't have runtime library support for various features. When they are + // encountered, we emit an error message and exit immediately. + void noRuntimeSupport(llvm::StringRef stmt) { + mlir::emitError(toLocation(), "There is no runtime support for ") + << stmt << " statement.\n"; + std::exit(1); + } + + void genFIR(Fortran::lower::pft::Evaluation &, + const Fortran::parser::EventPostStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport("EVENT POST"); + } + void genFIR(Fortran::lower::pft::Evaluation &, + const Fortran::parser::EventWaitStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport("EVENT WAIT"); + } + + void genFIR(Fortran::lower::pft::Evaluation &, + const Fortran::parser::FormTeamStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport("FORM TEAM"); + } + void genFIR(Fortran::lower::pft::Evaluation &, + const Fortran::parser::LockStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport("LOCK"); + } + + /// Nullify pointer object list + /// + /// For each pointer object, reset the pointer to a disassociated status. + /// We do this by setting each pointer to null. + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::NullifyStmt &stmt) { + for (auto &po : stmt.v) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::Name &sym) { + auto ty = genType(*sym.symbol); + auto load = builder->create( + toLocation(), lookupSymbol(*sym.symbol)); + auto idxTy = mlir::IndexType::get(&mlirContext); + auto zero = builder->create( + toLocation(), idxTy, builder->getIntegerAttr(idxTy, 0)); + auto cast = + builder->create(toLocation(), ty, zero); + builder->create(toLocation(), cast, load); + }, + [&](const Fortran::parser::StructureComponent &) { TODO(); }, + }, + po.u); + } + } + + /// Shared for both assignments and pointer assignments. + void genFIR(const Fortran::evaluate::Assignment &assignment) { + std::visit( Fortran::common::visitors{ [&](const Fortran::evaluate::Assignment::Intrinsic &) { const auto *sym = @@ -1262,11 +1306,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(lhsType && "lhs cannot be typeless"); if (isNumericScalarCategory(lhsType->category())) { // Fortran 2018 10.2.1.3 p8 and p9 - // Conversions are already inserted by semantic - // analysis. - builder->create(toLocation(), - genExprValue(assignment.rhs), - genExprAddr(assignment.lhs)); + // Conversions should have been inserted by semantic analysis, + // but they can be incorrect between the rhs and lhs. Correct + // that here. + auto loc = toLocation(); + auto addr = genExprAddr(assignment.lhs); + auto val = genExprValue(assignment.rhs); + auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); + assert(toTy && "store location must be typed"); + auto cast = builder->create(loc, toTy, val); + builder->create(loc, cast, addr); } else if (isCharacterCategory(lhsType->category())) { // Fortran 2018 10.2.1.3 p10 and p11 // Generating value for lhs to get fir.boxchar. @@ -1296,87 +1345,40 @@ class FirConverter : public Fortran::lower::AbstractConverter { assignment.u); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ContinueStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::DeallocateStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EventPostStmt &) { - // call some runtime routine - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EventWaitStmt &) { - // call some runtime routine - TODO(); + void genFIR(Fortran::lower::pft::Evaluation &, + const Fortran::parser::PointerAssignmentStmt &stmt) { + genFIR(*stmt.typedAssignment->v); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::FormTeamStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::LockStmt &) { - // call some runtime routine - TODO(); - } - - /// Nullify pointer object list - /// - /// For each pointer object, reset the pointer to a disassociated status. - /// We do this by setting each pointer to null. - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::NullifyStmt &stmt) { - for (auto &po : stmt.v) { - std::visit( - Fortran::common::visitors{ - [&](const Fortran::parser::Name &sym) { - auto ty = genType(*sym.symbol); - auto load = builder->create( - toLocation(), lookupSymbol(*sym.symbol)); - auto idxTy = mlir::IndexType::get(&mlirContext); - auto zero = builder->create( - toLocation(), idxTy, builder->getIntegerAttr(idxTy, 0)); - auto cast = - builder->create(toLocation(), ty, zero); - builder->create(toLocation(), cast, load); - }, - [&](const Fortran::parser::StructureComponent &) { TODO(); }, - }, - po.u); - } - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::PointerAssignmentStmt &) { - TODO(); + void genFIR(Fortran::lower::pft::Evaluation &, + const Fortran::parser::AssignmentStmt &stmt) { + genFIR(*stmt.typedAssignment->v); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::SyncAllStmt &) { - // call some runtime routine - TODO(); + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport("SYNC ALL"); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::SyncImagesStmt &) { - // call some runtime routine - TODO(); + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport("SYNC IMAGES"); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::SyncMemoryStmt &) { - // call some runtime routine - TODO(); + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport("SYNC MEMORY"); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::SyncTeamStmt &) { - // call some runtime routine - TODO(); + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport("SYNC TEAM"); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::UnlockStmt &) { - // call some runtime routine - TODO(); + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport("UNLOCK"); } void genFIR(Fortran::lower::pft::Evaluation &eval, @@ -1390,24 +1392,32 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->create(toLocation(), labelValue, variable); } - void genFIR(Fortran::lower::pft::Evaluation &eval, + void genFIR(Fortran::lower::pft::Evaluation &, const Fortran::parser::FormatStmt &) { - // do nothing. FORMAT statements have no semantics. They may be lowered if - // used by a data transfer statement. + // do nothing. + + // FORMAT statements have no semantics. They may be lowered if used by a + // data transfer statement. } - void genFIR(Fortran::lower::pft::Evaluation &eval, + + void genFIR(Fortran::lower::pft::Evaluation &, const Fortran::parser::EntryStmt &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, + + void genFIR(Fortran::lower::pft::Evaluation &, const Fortran::parser::PauseStmt &) { - // call some runtime routine - TODO(); + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport("PAUSE"); } - void genFIR(Fortran::lower::pft::Evaluation &eval, + + void genFIR(Fortran::lower::pft::Evaluation &, const Fortran::parser::DataStmt &) { - TODO(); + // FIXME: The front-end doesn't provide the right information yet. + mlir::emitError(toLocation(), "DATA statement is not handled."); + exit(1); } + void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::NamelistStmt &) { TODO(); @@ -1437,7 +1447,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { const auto *funit = eval.getOwningProcedure(); assert(funit && "not inside main program or a procedure"); if (funit->isMainProgram()) { - genFIRProgramExit(); + genExitRoutine(); } else { if (stmt.v) { // Alternate return @@ -1458,15 +1468,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::CycleStmt &) { - genFIRUnconditionalBranch(eval.controlSuccessor); + genBranch(eval.controlSuccessor->block); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::ExitStmt &) { - genFIRUnconditionalBranch(eval.controlSuccessor); + genBranch(eval.controlSuccessor->block); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::GotoStmt &) { - genFIRUnconditionalBranch(eval.controlSuccessor); + genBranch(eval.controlSuccessor->block); } void genFIR(Fortran::lower::pft::Evaluation &eval, @@ -1486,7 +1496,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (unstructuredContext && eval.isActionStmt() && eval.controlSuccessor && eval.controlSuccessor->block && blockIsUnterminated()) { // Exit from an unstructured IF or SELECT construct block. - genFIRUnconditionalBranch(eval.controlSuccessor); + genBranch(eval.controlSuccessor->block); } } @@ -1654,7 +1664,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // TODO: What about lower host-associated variables? (They probably need // to be handled as dummy parameters.) - + // Otherwise, it's a local variable. auto local = createNewLocal(loc, sym); addSymbol(sym, local); @@ -1946,7 +1956,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // If the current block does not have a terminator branch, // append a fallthrough branch. if (blockIsUnterminated()) - genFIRUnconditionalBranch(newBlock); + genBranch(newBlock); builder->setInsertionPointToStart(newBlock); } @@ -1961,11 +1971,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { setCurrentPosition( Fortran::lower::pft::FunctionLikeUnit::stmtSourceLoc(funit.endStmt)); - if (funit.isMainProgram()) { - genFIRProgramExit(); - } else { + if (funit.isMainProgram()) + genExitRoutine(); + else genFIRProcedureExit(funit, funit.getSubprogramSymbol()); - } delete builder; builder = nullptr; From 22c732dc8d231bb97af9d374874f630049e49415 Mon Sep 17 00:00:00 2001 From: Varun Jayathirtha Date: Mon, 20 Apr 2020 23:25:04 -0700 Subject: [PATCH 0010/1017] PARAMETER type values should be 'constant' globals --- flang/lib/Lower/Bridge.cpp | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 8c30f5cfd12ed..d1944ba1940c2 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1594,6 +1594,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { const auto &sym = var.getSymbol(); std::string globalName = mangleName(sym); fir::GlobalOp global; + bool isConst = sym.attrs().test(Fortran::semantics::Attr::PARAMETER); if (builder->getNamedGlobal(globalName)) return; if (const auto *details = @@ -1607,13 +1608,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { return; } else global = builder->createGlobal( - toLocation(), genType(sym), globalName, false, + toLocation(), genType(sym), globalName, isConst, [&](Fortran::lower::FirOpBuilder &builder) { auto initVal = genExprValue(details->init().value()); builder.create(toLocation(), initVal); }); - } else + } else { global = builder->createGlobal(toLocation(), genType(sym), globalName); + } auto addrOf = builder->create( toLocation(), global.resultType(), global.getSymbol()); addSymbol(sym, addrOf); From 081e11035e4843079c1583ed38b2394813bcaa12 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 22 Apr 2020 15:24:06 -0700 Subject: [PATCH 0011/1017] [rebase] changes from rebasing. fixes cmake fallout and a bad merge draft fix the lowering of adjusted arrays --- flang/LAPACK-bugs.txt | 4 +-- flang/test/Lower/character-assignment.f90 | 36 +++++++++++------------ 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index 11369131b361d..e547316d18038 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -3,8 +3,6 @@ ______________ [Eric] - error: 'fir.coordinate_of' op cannot find coordinate with unknown extents - [Varun] DATA statement @@ -24,6 +22,8 @@ ______________ FIXED _____ +error: 'fir.coordinate_of' op cannot find coordinate with unknown extents + Lowering globals in general Handle adjusted arrays of CHARACTER with adjusted LEN diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index db675ab57187e..0ff9520dab080 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -20,28 +20,28 @@ subroutine assign1(lhs, rhs) ! CHECK: %[[tmp:.*]] = fir.alloca !fir.char<1>, %[[min_len]] ! Copy of rhs into temp - ! CHECK: fir.do_loop [[i:%[[:alnum:]_]+]] - ! CHECK-DAG: [[rhs_addr:%[0-9]+]] = fir.coordinate_of [[rhs]]#0, [[i]] - ! CHECK-DAG: [[tmp_addr:%[0-9]+]] = fir.coordinate_of [[tmp]], [[i]] - ! CHECK-DAG: [[rhs_elt:%[0-9]+]] = fir.load [[rhs_addr]] - ! CHECK: fir.store [[rhs_elt]] to [[tmp_addr]] - ! CHECK: } + ! CHECK: fir.do_loop %[[i:.*]] = + ! CHECK-DAG: %[[rhs_addr:.*]] = fir.coordinate_of %[[rhs]]#0, %[[i]] + ! CHECK-DAG: %[[rhs_elt:.*]] = fir.load %[[rhs_addr]] + ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[i]] + ! CHECK: fir.store %[[rhs_elt]] to %[[tmp_addr]] + ! CHECK-NEXT: } ! Copy of temp into lhs - ! CHECK: fir.do_loop [[i:%[[:alnum:]]+]] - ! CHECK-DAG: [[tmp_addr:%[0-9]+]] = fir.coordinate_of [[tmp]], [[i]] - ! CHECK-DAG: [[lhs_addr:%[0-9]+]] = fir.coordinate_of [[lhs]]#0, [[i]] - ! CHECK-DAG: [[tmp_elt:%[0-9]+]] = fir.load [[tmp_addr]] - ! CHECK: fir.store [[tmp_elt]] to [[lhs_addr]] - ! CHECK: } + ! CHECK: fir.do_loop %[[ii:.*]] = + ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[ii]] + ! CHECK-DAG: %[[tmp_elt:.*]] = fir.load %[[tmp_addr]] + ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[ii]] + ! CHECK: fir.store %[[tmp_elt]] to %[[lhs_addr]] + ! CHECK-NEXT: } ! Padding - ! CHECK: [[c32:%[[:alnum:]_]+]] = constant 32 : i8 - ! CHECK: [[blank:%[0-9]+]] = fir.convert [[c32]] : (i8) -> !fir.char<1> - ! CHECK: fir.do_loop [[i:%[[:alnum:]_]+]] - ! CHECK-DAG: [[lhs_addr:%[0-9]+]] = fir.coordinate_of [[lhs]]#0, [[i]] - ! CHECK: fir.store [[blank]] to [[lhs_addr]] - ! CHECK: } + ! CHECK: %[[c32:.*]] = constant 32 : i8 + ! CHECK: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> + ! CHECK: fir.do_loop %[[ij:.*]] = + ! CHECK: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[ij]] + ! CHECK: fir.store %[[blank]] to %[[lhs_addr]] + ! CHECK-NEXT: } end subroutine ! Test substring assignment From 838b219ecd69ab3ffd82a82fe14dca49c71a748e Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Wed, 22 Apr 2020 04:04:42 -0700 Subject: [PATCH 0012/1017] Move and rework pgmath description used in folding Share pgmath description in lowering and folding. Simplify intrinsic lowering. Also add more intrinsics lowering: - ICHAR, ACHAR and plug all pgmath. Fix libpgmath linking regression after D78215 Rename isNotInMemory to needToMaterialize. Fix StaticMultimapView usage for clang --- flang/include/flang/Lower/ConvertExpr.h | 10 +- flang/include/flang/Lower/Intrinsics.h | 74 -- flang/lib/Lower/Bridge.cpp | 12 +- flang/lib/Lower/Intrinsics.cpp | 852 ++++++++++++------------ flang/test/Lower/intrinsics.f90 | 27 + 5 files changed, 449 insertions(+), 526 deletions(-) delete mode 100644 flang/include/flang/Lower/Intrinsics.h diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h index 2341ea9be4365..e284dceb828c3 100644 --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -9,8 +9,6 @@ #ifndef FORTRAN_LOWER_CONVERT_EXPR_H #define FORTRAN_LOWER_CONVERT_EXPR_H -#include "Intrinsics.h" - /// [Coding style](https://llvm.org/docs/CodingStandards.html) namespace mlir { @@ -51,21 +49,19 @@ class SymMap; mlir::Value createSomeExpression(mlir::Location loc, AbstractConverter &converter, const evaluate::Expr &expr, - SymMap &symMap, - const IntrinsicLibrary &intrinsics); + SymMap &symMap); mlir::Value createI1LogicalExpression(mlir::Location loc, AbstractConverter &converter, const evaluate::Expr &expr, - SymMap &symMap, const IntrinsicLibrary &intrinsics); + SymMap &symMap); /// Create an address. /// Lowers `expr` to the FIR dialect of MLIR. The expression must be an entity /// and the address of the entity is returned. mlir::Value createSomeAddress(mlir::Location loc, AbstractConverter &converter, const evaluate::Expr &expr, - SymMap &symMap, - const IntrinsicLibrary &intrinsics); + SymMap &symMap); } // namespace lower } // namespace Fortran diff --git a/flang/include/flang/Lower/Intrinsics.h b/flang/include/flang/Lower/Intrinsics.h deleted file mode 100644 index fe9687d59db75..0000000000000 --- a/flang/include/flang/Lower/Intrinsics.h +++ /dev/null @@ -1,74 +0,0 @@ -//===-- Lower/Intrinsics.h -- lowering of intrinsics ------------*- C++ -*-===// -// -// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -// See https://llvm.org/LICENSE.txt for license information. -// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -// -//===----------------------------------------------------------------------===// -// -// Builder routines for constructing the FIR dialect of MLIR. As FIR is a -// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding -// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this -// module. -// -//===----------------------------------------------------------------------===// - -#ifndef FORTRAN_LOWER_INTRINSICS_H_ -#define FORTRAN_LOWER_INTRINSICS_H_ - -#include "mlir/Dialect/StandardOps/IR/Ops.h" -#include "llvm/ADT/StringRef.h" -#include - -namespace Fortran::lower { - -class FirOpBuilder; - -/// IntrinsicLibrary generates FIR+MLIR operations that implement Fortran -/// generic intrinsic function calls. It operates purely on FIR+MLIR types so -/// that it can be used at different lowering level if needed. -/// IntrinsicLibrary is not in charge of generating code for the argument -/// expressions/symbols. These must be generated before and the resulting -/// mlir::Values are inputs for the IntrinsicLibrary operation generation. -/// -/// The operations generated can be as simple as a single runtime library call -/// or they may fully implement the intrinsic without runtime help. This -/// depends on the IntrinsicLibrary::Implementation. -/// -/// IntrinsicLibrary should not be assumed cheap to build since they may need -/// to build a representation of the target runtime before they can be used. -/// Once built, they are stateless and cannot be modified. -/// - -class IntrinsicLibrary { -public: - /// Available runtime library versions. - enum class Version { PgmathFast, PgmathRelaxed, PgmathPrecise, LLVM }; - - /// Create an IntrinsicLibrary targeting the desired runtime library version. - IntrinsicLibrary(Version, mlir::MLIRContext &); - ~IntrinsicLibrary(); - /// Generate the FIR+MLIR operations for the generic intrinsic "name". - /// On failure, returns a nullptr, else the returned mlir::Value is - /// the returned Fortran intrinsic value. - mlir::Value genval(mlir::Location loc, Fortran::lower::FirOpBuilder &builder, - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args) const; - - // TODO: Expose interface to get specific intrinsic function address. - // TODO: Handle intrinsic subroutine. - // TODO: Intrinsics that do not require their arguments to be defined - // (e.g shape inquiries) might not fit in the current interface that - // requires mlir::Value to be provided. - // TODO: Error handling interface ? - // TODO: Implementation is incomplete. Many intrinsics to tbd. - -private: - /// Actual implementation is hidden. - class Implementation; - std::unique_ptr impl; -}; - -} // namespace Fortran::lower - -#endif // FORTRAN_LOWER_INTRINSICS_H_ diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index d1944ba1940c2..209e7ff5994df 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -12,7 +12,6 @@ #include "flang/Lower/ConvertType.h" #include "flang/Lower/FIRBuilder.h" #include "flang/Lower/IO.h" -#include "flang/Lower/Intrinsics.h" #include "flang/Lower/Mangler.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" @@ -235,9 +234,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { fir::NameUniquer &uniquer) : mlirContext{bridge.getMLIRContext()}, cooked{bridge.getCookedSource()}, module{bridge.getModule()}, defaults{bridge.getDefaultKinds()}, - intrinsics{Fortran::lower::IntrinsicLibrary( - Fortran::lower::IntrinsicLibrary::Version::LLVM, - bridge.getMLIRContext())}, uniquer{uniquer} {} virtual ~FirConverter() = default; @@ -355,17 +351,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Value createFIRAddr(mlir::Location loc, const Fortran::semantics::SomeExpr *expr) { - return createSomeAddress(loc, *this, *expr, localSymbols, intrinsics); + return createSomeAddress(loc, *this, *expr, localSymbols); } mlir::Value createFIRExpr(mlir::Location loc, const Fortran::semantics::SomeExpr *expr) { - return createSomeExpression(loc, *this, *expr, localSymbols, intrinsics); + return createSomeExpression(loc, *this, *expr, localSymbols); } mlir::Value createLogicalExprAsI1(mlir::Location loc, const Fortran::semantics::SomeExpr *expr) { - return createI1LogicalExpression(loc, *this, *expr, localSymbols, - intrinsics); + return createI1LogicalExpression(loc, *this, *expr, localSymbols); } /// Find the symbol in the local map or return null. @@ -2021,7 +2016,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::parser::CookedSource *cooked; mlir::ModuleOp &module; const Fortran::common::IntrinsicTypeDefaultKinds &defaults; - Fortran::lower::IntrinsicLibrary intrinsics; Fortran::lower::FirOpBuilder *builder = nullptr; fir::NameUniquer &uniquer; Fortran::lower::SymMap localSymbols; diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index 25ee5baf084d3..5dca899df4bd2 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -13,59 +13,30 @@ // //===----------------------------------------------------------------------===// -#include "flang/Lower/Intrinsics.h" +#include "RTBuilder.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/FIRBuilder.h" #include "flang/Lower/Runtime.h" +#include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorHandling.h" #include -#include // FIXME: must be removed #include -namespace Fortran::lower { - -/// MathRuntimeLibrary maps Fortran generic intrinsic names to runtime function -/// signatures. There is no guarantee that that runtime functions are available -/// for all intrinsic functions and possible types. -/// To be easy and fast to use, this class holds a map and uses -/// mlir::FunctionType to represent the runtime function type. This imply that -/// MathRuntimeLibrary cannot be constexpr built and requires an -/// mlir::MLIRContext to be built. Its constructor uses a constexpr table -/// description of the runtime. The runtime functions are not declared into the -/// mlir::module until there is a query that needs them. This is to avoid -/// polluting the FIR/LLVM IR dumps with unused functions. -class MathRuntimeLibrary { -public: - /// The map key are Fortran generic intrinsic names. - using Key = llvm::StringRef; - struct Hash { // Need custom hash for this kind of key - size_t operator()(const Key &k) const { return llvm::hash_value(k); } - }; - /// Runtime function description that is sufficient to build an - /// mlir::FuncOp and to compare function types. - struct RuntimeFunction { - RuntimeFunction(llvm::StringRef n, mlir::FunctionType t) - : symbol{n}, type{t} {} - llvm::StringRef symbol; - mlir::FunctionType type; - }; - using Map = std::unordered_multimap; +#define PGMATH_DECLARE +#include "../runtime/pgmath.h.inc" - MathRuntimeLibrary(IntrinsicLibrary::Version, mlir::MLIRContext &); +/// This file implements lowering of Fortran intrinsic procedures. +/// Intrinsics are lowered to a mix of FIR and MLIR operations as +/// well as call to runtime functions or LLVM intrinsics. - /// Probe the intrinsic library for a certain intrinsic and get/build the - /// related mlir::FuncOp if a runtime description is found. - /// Also add a unit attribute "fir.runtime" to the function so that later - /// it is possible to quickly know what function are intrinsics vs users. - llvm::Optional getFunction(Fortran::lower::FirOpBuilder &, - llvm::StringRef, - mlir::FunctionType) const; - -private: - mlir::FuncOp getFuncOp(Fortran::lower::FirOpBuilder &builder, - const RuntimeFunction &runtime) const; - Map library; -}; +/// Lowering of intrinsic procedure calls is based on a map that associates +/// Fortran intrinsic generic names to FIR generator functions. +/// All generator functions are member functions of the IntrinsicLibrary class +/// and have the same interface. +/// If no generator is given for an intrinsic name, a math runtime library +/// is searched for an implementation and, if a runtime function is found, +/// a call is generated for it. LLVM intrinsics are handled as a math +/// runtime library here. /// Enums used to templatize and share lowering of MIN and MAX. enum class Extremum { Min, Max }; @@ -110,55 +81,13 @@ enum class ExtremumBehavior { // possible to implement it without some target dependent runtime. }; -/// The implementation of IntrinsicLibrary is based on a map that associates -/// Fortran intrinsics generic names to the related FIR generator functions. -/// All generator functions are member functions of the Implementation class -/// and they all take the same context argument that contains the name and -/// arguments of the Fortran intrinsics call to lower among other things. -/// A same FIR generator function may be able to generate the FIR for several -/// intrinsics. For instance genRuntimeCall tries to find a runtime -/// functions that matches the Fortran intrinsic call and generate the -/// operations to call this functions if it was found. -/// IntrinsicLibrary holds a constant MathRuntimeLibrary that it uses to -/// find and place call to math runtime functions. This library is built -/// when the Implementation is built. Because of this, Implementation is -/// not cheap to build and it should be kept as long as possible. - -// TODO it is unclear how optional argument are handled // TODO error handling -> return a code or directly emit messages ? -class IntrinsicLibrary::Implementation { -public: - Implementation(Version v, mlir::MLIRContext &c) : runtime{v, c} {} - inline mlir::Value genval(mlir::Location loc, - Fortran::lower::FirOpBuilder &builder, - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args); +struct IntrinsicLibrary { -private: - static inline mlir::Value genval(mlir::Location loc, - Fortran::lower::FirOpBuilder &builder, - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args, - MathRuntimeLibrary &); - // Info needed by Generators is passed in Context struct to keep Generator - // signatures modification easy. - struct Context { - mlir::Location loc; - Fortran::lower::FirOpBuilder *builder = nullptr; - llvm::StringRef name; - llvm::ArrayRef arguments; - mlir::FunctionType funcType; - mlir::ModuleOp getModuleOp() { return builder->getModule(); } - mlir::MLIRContext *getMLIRContext() { return getModuleOp().getContext(); } - mlir::Type getResultType() { - assert(funcType.getNumResults() == 1); - return funcType.getResult(0); - } - }; - - /// Define the different FIR generators that can be mapped to intrinsic to - /// generate the related code. - using Generator = mlir::Value (*)(Context &, MathRuntimeLibrary &); + /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg + /// and expected result type \p resultType. + mlir::Value genIntrinsicCall(llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef arg); /// Search a runtime function that is associated to the generic intrinsic name /// and whose signature matches the intrinsic arguments and result types. @@ -167,183 +96,168 @@ class IntrinsicLibrary::Implementation { /// conversions will be inserted before and/or after the call. This is to /// mainly to allow 16 bits float support even-though little or no math /// runtime is currently available for it. - static mlir::Value genRuntimeCall(Context &, MathRuntimeLibrary &); - - /// All generators can be combined with genWrapperCall that will build a - /// function named "fir."+ + "." + and - /// generate the intrinsic implementation inside instead of at the intrinsic - /// call sites. This can be used to keep the FIR more readable. - template - static mlir::Value genWrapperCall(Context &c, MathRuntimeLibrary &r) { - return outlineInWrapper(g, c, r); - } - - /// The defaultGenerator is always attempted if no mapping was found for the - /// generic name provided. - static mlir::Value defaultGenerator(Context &c, MathRuntimeLibrary &r) { - return genWrapperCall<&I::genRuntimeCall>(c, r); - } + mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type, + llvm::ArrayRef); + mlir::Value genAbs(mlir::Type, llvm::ArrayRef); + mlir::Value genAimag(mlir::Type, llvm::ArrayRef); + mlir::Value genConjg(mlir::Type, llvm::ArrayRef); + mlir::Value genCeiling(mlir::Type, llvm::ArrayRef); + template + mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); + mlir::Value genIchar(mlir::Type, llvm::ArrayRef); + mlir::Value genLenTrim(mlir::Type, llvm::ArrayRef); + mlir::Value genMerge(mlir::Type, llvm::ArrayRef); + mlir::Value genMod(mlir::Type, llvm::ArrayRef); + mlir::Value genSign(mlir::Type, llvm::ArrayRef); /// Implement all conversion functions like DBLE, the first argument is /// the value to convert. There may be an additional KIND arguments that /// is ignored because this is already reflected in the result type. - static mlir::Value genConversion(Context &, MathRuntimeLibrary &); - - static mlir::Value genAbs(Context &, MathRuntimeLibrary &); - static mlir::Value genAimag(Context &, MathRuntimeLibrary &); - static mlir::Value genConjg(Context &, MathRuntimeLibrary &); - template - static mlir::Value genExtremum(Context &, MathRuntimeLibrary &); - static mlir::Value genIchar(Context &, MathRuntimeLibrary &); - static mlir::Value genLenTrim(Context &, MathRuntimeLibrary &); - static mlir::Value genMerge(Context &, MathRuntimeLibrary &); - static mlir::Value genMod(Context &, MathRuntimeLibrary &); - static mlir::Value genSign(Context &, MathRuntimeLibrary &); - - struct IntrinsicHanlder { - const char *name; - Generator generator{&I::defaultGenerator}; - }; - using I = Implementation; - /// Table that drives the fir generation depending on the intrinsic. - /// one to one mapping with Fortran arguments. If no mapping is - /// defined here for a generic intrinsic, the defaultGenerator will - /// be attempted. - static constexpr IntrinsicHanlder handlers[]{ - {"abs", &I::genAbs}, - {"aimag", &I::genAimag}, - {"conjg", &I::genConjg}, - {"dble", &I::genConversion}, - {"ichar", &I::genIchar}, - {"len_trim", &I::genLenTrim}, - {"max", &I::genExtremum}, - {"min", &I::genExtremum}, - {"merge", &I::genMerge}, - {"mod", &I::genMod}, - {"sign", &I::genSign}, - }; + mlir::Value genConversion(mlir::Type, llvm::ArrayRef); - // helpers - static mlir::Value outlineInWrapper(Generator, Context &c, - MathRuntimeLibrary &r); + /// Define the different FIR generators that can be mapped to intrinsic to + /// generate the related code. + using Generator = decltype(&IntrinsicLibrary::genAbs); + + /// All generators can be outlined. This will build a function named + /// "fir."+ + "." + and generate the + /// intrinsic implementation inside instead of at the intrinsic call sites. + /// This can be used to keep the FIR more readable. Only one function will + /// be generated for all the similar calls in a program. + /// If the Generator is nullptr, the wrapper uses genRuntimeCall. + mlir::Value outlineInWrapper(Generator, llvm::StringRef name, + mlir::Type resultType, + llvm::ArrayRef args); + + Fortran::lower::FirOpBuilder &builder; +}; - MathRuntimeLibrary runtime; +/// Table that drives the fir generation depending on the intrinsic. +/// one to one mapping with Fortran arguments. If no mapping is +/// defined here for a generic intrinsic, genRuntimeCall will be called +/// to look for a match in the runtime a emit a call. +struct IntrinsicHanlder { + const char *name; + IntrinsicLibrary::Generator generator; + /// Code heavy intrinsic can be outlined to make FIR + /// more readable. + bool outline = false; +}; +using I = IntrinsicLibrary; +static constexpr IntrinsicHanlder handlers[]{ + {"abs", &I::genAbs}, + {"achar", &I::genConversion}, + {"aimag", &I::genAimag}, + {"ceiling", &I::genCeiling}, + {"char", &I::genConversion}, + {"conjg", &I::genConjg}, + {"dble", &I::genConversion}, + {"ichar", &I::genIchar}, + {"len_trim", &I::genLenTrim}, + {"max", &I::genExtremum}, + {"min", &I::genExtremum}, + {"merge", &I::genMerge}, + {"mod", &I::genMod}, + {"sign", &I::genSign}, }; -// helpers +/// To make fir output more readable for debug, one can outline all intrinsic +/// implementation in wrappers (overrides the IntrinsicHanlder::outline flag). +static llvm::cl::opt outlineAllIntrinsics( + "outline-intrinsics", + llvm::cl::desc( + "Lower all intrinsic procedure implementation in their own functions"), + llvm::cl::init(false)); + +/// Generate a function name for function where intrinsic implementation +/// are outlined. It is not a legal Fortran name and could therefore +/// safely be matched later if needed. static std::string getIntrinsicWrapperName(const llvm::StringRef &intrinsic, mlir::FunctionType funTy); -static mlir::FunctionType getFunctionType(mlir::Type resultType, - llvm::ArrayRef arguments, - Fortran::lower::FirOpBuilder &); +/// Search runtime for the best runtime function given an intrinsic name +/// and interface. The interface may not be a perfect match in which case +/// the caller is responsible to insert argument and return value conversions. +static llvm::Optional +getRuntimeFunction(Fortran::lower::FirOpBuilder &builder, llvm::StringRef name, + mlir::FunctionType funcType); -/// Define a simple static runtime description that will be transformed into -/// RuntimeFunction when building the IntrinsicLibrary. -class MathsRuntimeStaticDescription : public RuntimeStaticDescription { -public: - constexpr MathsRuntimeStaticDescription(const char *n, const char *s, - MaybeTypeCode r, TypeCodeVector a) - : RuntimeStaticDescription{s, r, a}, name{n} {} - llvm::StringRef getName() const { return name; } +//===----------------------------------------------------------------------===// +// Math runtime description and matching utility +//===----------------------------------------------------------------------===// -private: - // Generic math function name - const char *name = nullptr; +/// Command line option to modify math runtime version used to implement +/// intrinsics. +enum MathRuntimeVersion { + fastVersion, + relaxedVersion, + preciseVersion, + llvmOnly }; - -/// Description of the runtime functions available on the target. -using RType = typename RuntimeStaticDescription::TypeCode; -using Args = typename RuntimeStaticDescription::TypeCodeVector; -static constexpr MathsRuntimeStaticDescription llvmRuntime[] = { - {"abs", "llvm.fabs.f32", RType::f32, Args::create()}, - {"abs", "llvm.fabs.f64", RType::f64, Args::create()}, - {"acos", "acosf", RType::f32, Args::create()}, - {"acos", "acos", RType::f64, Args::create()}, - {"atan", "atan2f", RType::f32, Args::create()}, - {"atan", "atan2", RType::f64, Args::create()}, - {"sqrt", "llvm.sqrt.f32", RType::f32, Args::create()}, - {"sqrt", "llvm.sqrt.f64", RType::f64, Args::create()}, - {"cos", "llvm.cos.f32", RType::f32, Args::create()}, - {"cos", "llvm.cos.f64", RType::f64, Args::create()}, - {"sin", "llvm.sin.f32", RType::f32, Args::create()}, - {"sin", "llvm.sin.f64", RType::f64, Args::create()}, +llvm::cl::opt mathRuntimeVersion( + "math_runtime", llvm::cl::desc("Select math runtime version:"), + llvm::cl::values( + clEnumValN(fastVersion, "fast", "use pgmath fast runtime"), + clEnumValN(relaxedVersion, "relaxed", "use pgmath relaxed runtime"), + clEnumValN(preciseVersion, "precise", "use pgmath precise runtime"), + clEnumValN(llvmOnly, "llvm", + "only use LLVM intrinsics (may be incomplete)")), + llvm::cl::init(fastVersion)); + +struct RuntimeFunction { + using Key = llvm::StringRef; + Key key; + llvm::StringRef symbol; + Fortran::lower::FuncTypeBuilderFunc typeGenerator; }; -static constexpr MathsRuntimeStaticDescription pgmathPreciseRuntime[] = { - {"acos", "__pc_acos_1", RType::c32, Args::create()}, - {"acos", "__pz_acos_1", RType::c64, Args::create()}, - {"hypot", "__mth_i_hypot", RType::f32, - Args::create()}, - {"hypot", "__mth_i_dhypot", RType::f64, - Args::create()}, - {"mod", "__ps_mod_1", RType::f32, Args::create()}, - {"mod", "__pd_mod_1", RType::f64, Args::create()}, - {"pow", "__pc_pow_1", RType::c32, Args::create()}, - {"pow", "__pc_powi_1", RType::c32, Args::create()}, - {"pow", "__pc_powk_1", RType::c32, Args::create()}, - {"pow", "__pd_pow_1", RType::f64, Args::create()}, - {"pow", "__pd_powi_1", RType::f64, Args::create()}, - {"pow", "__pd_powk_1", RType::f64, Args::create()}, - {"pow", "__ps_pow_1", RType::f32, Args::create()}, - {"pow", "__ps_powi_1", RType::f32, Args::create()}, - {"pow", "__ps_powk_1", RType::f32, Args::create()}, - {"pow", "__pz_pow_1", RType::c64, Args::create()}, - {"pow", "__pz_powi_1", RType::c64, Args::create()}, - {"pow", "__pz_powk_1", RType::c64, Args::create()}, - {"pow", "__mth_i_ipowi", RType::i32, - Args::create()}, - {"pow", "__mth_i_kpowi", RType::i64, - Args::create()}, - {"pow", "__mth_i_kpowk", RType::i64, - Args::create()}, +#define RUNTIME_STATIC_DESCRIPTION(name, func) \ + {#name, #func, \ + Fortran::lower::RuntimeTableKey::getTypeModel()}, +static constexpr RuntimeFunction pgmathFast[] = { +#define PGMATH_FAST +#define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func) +#include "../runtime/pgmath.h.inc" +}; +static constexpr RuntimeFunction pgmathRelaxed[] = { +#define PGMATH_RELAXED +#define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func) +#include "../runtime/pgmath.h.inc" +}; +static constexpr RuntimeFunction pgmathPrecise[] = { +#define PGMATH_PRECISE +#define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func) +#include "../runtime/pgmath.h.inc" }; -// TODO : Tables above should be generated in a clever ways and probably shared -// with lib/evaluate intrinsic folding. - -// Implementations - -// IntrinsicLibrary implementation - -IntrinsicLibrary::IntrinsicLibrary(IntrinsicLibrary::Version v, - mlir::MLIRContext &context) - : impl{new Implementation(v, context)} {} -IntrinsicLibrary::~IntrinsicLibrary() = default; - -mlir::Value IntrinsicLibrary::genval(mlir::Location loc, - Fortran::lower::FirOpBuilder &builder, - llvm::StringRef name, - mlir::Type resultType, - llvm::ArrayRef args) const { - assert(impl); - return impl->genval(loc, builder, name, resultType, args); +static mlir::FunctionType gen1ArgF32FuncType(mlir::MLIRContext *context) { + auto t = mlir::FloatType::getF32(context); + return mlir::FunctionType::get({t}, {t}, context); } - -// MathRuntimeLibrary implementation - -// Create the runtime description for the targeted library version. -// So far ignore the version an only load the dummy llvm lib and pgmath precise -MathRuntimeLibrary::MathRuntimeLibrary(IntrinsicLibrary::Version, - mlir::MLIRContext &mlirContext) { - for (const MathsRuntimeStaticDescription &func : llvmRuntime) { - RuntimeFunction impl{func.getSymbol(), - func.getMLIRFunctionType(&mlirContext)}; - library.insert({Key{func.getName()}, impl}); - } - for (const MathsRuntimeStaticDescription &func : pgmathPreciseRuntime) { - RuntimeFunction impl{func.getSymbol(), - func.getMLIRFunctionType(&mlirContext)}; - library.insert({Key{func.getName()}, impl}); - } +static mlir::FunctionType gen1ArgF64FuncType(mlir::MLIRContext *context) { + auto t = mlir::FloatType::getF64(context); + return mlir::FunctionType::get({t}, {t}, context); } -mlir::FuncOp -MathRuntimeLibrary::getFuncOp(Fortran::lower::FirOpBuilder &builder, - const RuntimeFunction &runtime) const { - auto function = builder.addNamedFunction(runtime.symbol, runtime.type); - function.setAttr("fir.runtime", builder.getUnitAttr()); - return function; -} +// TODO : Fill-up this table with more intrinsic. +// Note: These are also defined as operations in LLVM dialect. See if this +// can be use and has advantages. +static constexpr RuntimeFunction llvmIntrinsics[] = { + {"abs", "llvm.fabs.f32", gen1ArgF32FuncType}, + {"abs", "llvm.fabs.f64", gen1ArgF64FuncType}, + // ceil is used for CEILING but is different, it returns a real. + {"ceil", "llvm.ceil.f32", gen1ArgF32FuncType}, + {"ceil", "llvm.ceil.f64", gen1ArgF64FuncType}, + {"cos", "llvm.cos.f32", gen1ArgF32FuncType}, + {"cos", "llvm.cos.f64", gen1ArgF64FuncType}, + {"log", "llvm.log.f32", gen1ArgF32FuncType}, + {"log", "llvm.log.f64", gen1ArgF64FuncType}, + {"log10", "llvm.log10.f32", gen1ArgF32FuncType}, + {"log10", "llvm.log10.f64", gen1ArgF64FuncType}, + {"sin", "llvm.sin.f32", gen1ArgF32FuncType}, + {"sin", "llvm.sin.f64", gen1ArgF64FuncType}, + {"sqrt", "llvm.sqrt.f32", gen1ArgF32FuncType}, + {"sqrt", "llvm.sqrt.f64", gen1ArgF64FuncType}, +}; // This helper class computes a "distance" between two function types. // The distance measures how many narrowing conversions of actual arguments @@ -472,62 +386,79 @@ class FunctionDistance { bool infinite{false}; // When forbidden conversion or wrong argument number }; +static mlir::FuncOp getFuncOp(Fortran::lower::FirOpBuilder &builder, + const RuntimeFunction &runtime) { + auto function = builder.addNamedFunction( + runtime.symbol, runtime.typeGenerator(builder.getContext())); + function.setAttr("fir.runtime", builder.getUnitAttr()); + return function; +} + // Select runtime function that has the smallest distance to the intrinsic // function type and that will not imply narrowing arguments or extending the // result. +template llvm::Optional -MathRuntimeLibrary::getFunction(Fortran::lower::FirOpBuilder &builder, - llvm::StringRef name, - mlir::FunctionType funcType) const { - auto range = library.equal_range(name); - const RuntimeFunction *bestNearMatch = nullptr; - FunctionDistance bestMatchDistance{}; - for (auto iter{range.first}; iter != range.second; ++iter) { - const RuntimeFunction &impl = iter->second; - if (funcType == impl.type) { +searchFunctionInLibrary(Fortran::lower::FirOpBuilder &builder, + const RuntimeFunction (&lib)[N], llvm::StringRef name, + mlir::FunctionType funcType, + const RuntimeFunction **bestNearMatch, + FunctionDistance &bestMatchDistance) { + auto map = Fortran::lower::StaticMultimapView(lib); + auto range = map.equal_range(name); + for (auto iter{range.first}; iter != range.second && iter; ++iter) { + const auto &impl = *iter; + auto implType = impl.typeGenerator(builder.getContext()); + if (funcType == implType) { return getFuncOp(builder, impl); // exact match } else { - FunctionDistance distance(funcType, impl.type); + FunctionDistance distance(funcType, implType); if (distance.isSmallerThan(bestMatchDistance)) { - bestNearMatch = &impl; + *bestNearMatch = &impl; bestMatchDistance = std::move(distance); } } } - if (bestNearMatch != nullptr) { - assert(!bestMatchDistance.isLosingPrecision() && - "runtime selection loses precision"); - return getFuncOp(builder, *bestNearMatch); - } return {}; } -// IntrinsicLibrary::Implementation implementation +static llvm::Optional +getRuntimeFunction(Fortran::lower::FirOpBuilder &builder, llvm::StringRef name, + mlir::FunctionType funcType) { + const RuntimeFunction *bestNearMatch = nullptr; + FunctionDistance bestMatchDistance{}; + llvm::Optional match; + if (mathRuntimeVersion == fastVersion) { + match = searchFunctionInLibrary(builder, pgmathFast, name, funcType, + &bestNearMatch, bestMatchDistance); + } else if (mathRuntimeVersion == relaxedVersion) { + match = searchFunctionInLibrary(builder, pgmathRelaxed, name, funcType, + &bestNearMatch, bestMatchDistance); + } else if (mathRuntimeVersion == preciseVersion) { + match = searchFunctionInLibrary(builder, pgmathPrecise, name, funcType, + &bestNearMatch, bestMatchDistance); + } else { + assert(mathRuntimeVersion == llvmOnly && "unknown math runtime"); + } + if (match) + return match; -mlir::Value IntrinsicLibrary::Implementation::genval( - mlir::Location loc, Fortran::lower::FirOpBuilder &builder, - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args) { - return genval(loc, builder, name, resultType, args, runtime); -} + // Go through llvm intrinsics if not exact match in libpgmath or if + // mathRuntimeVersion == llvmOnly + if (auto exactMatch = + searchFunctionInLibrary(builder, llvmIntrinsics, name, funcType, + &bestNearMatch, bestMatchDistance)) + return exactMatch; -mlir::Value IntrinsicLibrary::Implementation::genval( - mlir::Location loc, Fortran::lower::FirOpBuilder &builder, - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args, MathRuntimeLibrary &runtime) { - Context context{loc, &builder, name, args, - getFunctionType(resultType, args, builder)}; - for (auto &handler : handlers) { - if (name == handler.name) { - assert(handler.generator != nullptr); - return handler.generator(context, runtime); - } + if (bestNearMatch != nullptr) { + assert(!bestMatchDistance.isLosingPrecision() && + "runtime selection loses precision"); + return getFuncOp(builder, *bestNearMatch); } - // Try the default generator if no special handler was defined for the - // intrinsic being called. - return defaultGenerator(context, runtime); + return {}; } +/// Helpers to get function type from arguments and result type. static mlir::FunctionType getFunctionType(mlir::Type resultType, llvm::ArrayRef arguments, Fortran::lower::FirOpBuilder &builder) { @@ -540,6 +471,7 @@ getFunctionType(mlir::Type resultType, llvm::ArrayRef arguments, builder.getModule().getContext()); } +/// Helper to encode type into string for intrinsic wrapper name. // TODO find nicer type to string infra or move this in a mangling utility // mlir as Type::dump(ostream) methods but it may adds ! static std::string typeToString(mlir::Type t) { @@ -576,246 +508,254 @@ static std::string getIntrinsicWrapperName(const llvm::StringRef &intrinsic, return name; } -mlir::Value IntrinsicLibrary::Implementation::outlineInWrapper( - Generator generator, Context &context, MathRuntimeLibrary &runtime) { - auto *builder = context.builder; - auto module = builder->getModule(); +//===----------------------------------------------------------------------===// +// IntrinsicLibrary +//===----------------------------------------------------------------------===// + +mlir::Value +IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef args) { + for (auto &handler : handlers) + if (name == handler.name) { + assert(handler.generator != nullptr); + return handler.outline || outlineAllIntrinsics + ? outlineInWrapper(handler.generator, name, resultType, args) + : std::invoke(handler.generator, *this, resultType, args); + } + // Try the runtime if no special handler was defined for the + // intrinsic being called. + return outlineInWrapper(nullptr, name, resultType, args); +} + +mlir::Value +IntrinsicLibrary::outlineInWrapper(Generator generator, llvm::StringRef name, + mlir::Type resultType, + llvm::ArrayRef args) { + auto module = builder.getModule(); auto *mlirContext = module.getContext(); - std::string wrapperName = - getIntrinsicWrapperName(context.name, context.funcType); - auto function = builder->getNamedFunction(wrapperName); + auto funcType = getFunctionType(resultType, args, builder); + std::string wrapperName = getIntrinsicWrapperName(name, funcType); + auto function = builder.getNamedFunction(wrapperName); if (!function) { // First time this wrapper is needed, build it. - function = builder->createFunction(wrapperName, context.funcType); - function.setAttr("fir.intrinsic", builder->getUnitAttr()); + function = builder.createFunction(wrapperName, funcType); + function.setAttr("fir.intrinsic", builder.getUnitAttr()); function.addEntryBlock(); // Create local context to emit code into the newly created function // This new function is not linked to a source file location, only // its calls will be. - Context localContext = context; auto localBuilder = std::make_unique(function); localBuilder->setInsertionPointToStart(&function.front()); - localContext.builder = &(*localBuilder); llvm::SmallVector localArguments; for (mlir::BlockArgument bArg : function.front().getArguments()) localArguments.push_back(bArg); - localContext.arguments = localArguments; - localContext.loc = mlir::UnknownLoc::get(mlirContext); - mlir::Value result = generator(localContext, runtime); - localBuilder->create(localContext.loc, result); + // Location of code inside wrapper of the wrapper is independent from + // the location of the intrinsic call. + auto localLoc = mlir::UnknownLoc::get(mlirContext); + localBuilder->setLocation(localLoc); + IntrinsicLibrary localLib{*localBuilder}; + mlir::Value result = + generator ? std::invoke(generator, localLib, resultType, localArguments) + : std::invoke(&IntrinsicLibrary::genRuntimeCall, localLib, + name, resultType, localArguments); + localBuilder->createHere(result); } else { // Wrapper was already built, ensure it has the sought type - assert(function.getType() == context.funcType); + assert(function.getType() == funcType); } - auto call = - builder->create(context.loc, function, context.arguments); + auto call = builder.createHere(function, args); return call.getResult(0); } -mlir::Value -IntrinsicLibrary::Implementation::genRuntimeCall(Context &context, - MathRuntimeLibrary &runtime) { +mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name, + mlir::Type resultType, + llvm::ArrayRef args) { // Look up runtime - mlir::FunctionType soughtFuncType = context.funcType; - if (auto funcOp = - runtime.getFunction(*context.builder, context.name, soughtFuncType)) { + mlir::FunctionType soughtFuncType = + getFunctionType(resultType, args, builder); + if (auto funcOp = getRuntimeFunction(builder, name, soughtFuncType)) { mlir::FunctionType actualFuncType = funcOp->getType(); if (actualFuncType.getNumResults() != soughtFuncType.getNumResults() || actualFuncType.getNumInputs() != soughtFuncType.getNumInputs() || - actualFuncType.getNumInputs() != context.arguments.size() || + actualFuncType.getNumInputs() != args.size() || actualFuncType.getNumResults() != 1) { - llvm_unreachable("Bad intrinsic match"); // TODO better error handling + llvm_unreachable("Bad intrinsic match"); } llvm::SmallVector convertedArguments; int i = 0; - for (mlir::Value arg : context.arguments) { + for (mlir::Value arg : args) { auto actualType = actualFuncType.getInput(i); if (soughtFuncType.getInput(i) != actualType) { - auto castedArg = context.builder->create( - context.loc, actualType, arg); + auto castedArg = builder.createHere(actualType, arg); convertedArguments.push_back(castedArg.getResult()); } else { convertedArguments.push_back(arg); } ++i; } - auto call = context.builder->create(context.loc, *funcOp, - convertedArguments); + auto call = builder.createHere(*funcOp, convertedArguments); mlir::Type soughtType = soughtFuncType.getResult(0); mlir::Value res = call.getResult(0); if (actualFuncType.getResult(0) != soughtType) { - auto castedRes = - context.builder->create(context.loc, soughtType, res); + auto castedRes = builder.createHere(soughtType, res); return castedRes.getResult(); } else { return res; } } else { // could not find runtime function - llvm::errs() << "missing intrinsic: " << context.name << "\n"; + llvm::errs() << "missing intrinsic: " << name << "\n"; llvm_unreachable("no runtime found for this intrinsics"); // TODO: better error handling ? - // - Try to have compile time check of runtime compltness ? + // - Try to have compile time check of runtime completeness ? } return {}; // gets rid of warnings } -mlir::Value -IntrinsicLibrary::Implementation::genConversion(Context &genCtxt, - MathRuntimeLibrary &) { +mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType, + llvm::ArrayRef args) { // There can be an optional kind in second argument. - assert(genCtxt.arguments.size() >= 1); - return genCtxt.builder->create( - genCtxt.loc, genCtxt.getResultType(), genCtxt.arguments[0]); + assert(args.size() >= 1); + return builder.createHere(resultType, args[0]); } // ABS -mlir::Value -IntrinsicLibrary::Implementation::genAbs(Context &genCtxt, - MathRuntimeLibrary &runtime) { - assert(genCtxt.arguments.size() == 1); - auto arg = genCtxt.arguments[0]; +mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1); + auto arg = args[0]; auto type = arg.getType(); if (fir::isa_real(type)) { // Runtime call to fp abs. An alternative would be to use mlir AbsFOp // but it does not support all fir floating point types. - return genRuntimeCall(genCtxt, runtime); + return genRuntimeCall("abs", resultType, args); } if (auto intType = type.dyn_cast()) { // At the time of this implementation there is no abs op in mlir. // So, implement abs here without branching. - auto shift = - genCtxt.builder->createIntegerConstant(intType, intType.getWidth() - 1); - auto mask = genCtxt.builder->create(genCtxt.loc, - arg, shift); - auto xored = genCtxt.builder->create(genCtxt.loc, arg, mask); - return genCtxt.builder->create(genCtxt.loc, xored, mask); + auto shift = builder.createIntegerConstant(intType, intType.getWidth() - 1); + auto mask = builder.createHere(arg, shift); + auto xored = builder.createHere(arg, mask); + return builder.createHere(xored, mask); } if (fir::isa_complex(type)) { // Use HYPOT to fulfill the no underflow/overflow requirement. - auto parts = genCtxt.builder->extractParts(arg); + auto parts = builder.extractParts(arg); llvm::SmallVector args = {parts.first, parts.second}; - return genval(genCtxt.loc, *genCtxt.builder, "hypot", - genCtxt.getResultType(), args, runtime); + return genIntrinsicCall("hypot", resultType, args); } llvm_unreachable("unexpected type in ABS argument"); } // AIMAG -mlir::Value IntrinsicLibrary::Implementation::genAimag(Context &genCtxt, - MathRuntimeLibrary &) { - assert(genCtxt.arguments.size() == 1); - return genCtxt.builder->extractComplexPart(genCtxt.arguments[0], - true /* isImagPart */); +mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1); + return builder.extractComplexPart(args[0], true /* isImagPart */); +} + +// CEILING +mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType, + llvm::ArrayRef args) { + // Optional KIND argument. + assert(args.size() >= 1); + auto arg = args[0]; + // Use ceil that is not an actual Fortran intrinsic but that is + // an llvm intrinsic that does the same, but return a floating + // point. + auto ceil = genIntrinsicCall("ceil", arg.getType(), {arg}); + return builder.createHere(resultType, ceil); } // CONJG -mlir::Value IntrinsicLibrary::Implementation::genConjg(Context &genCtxt, - MathRuntimeLibrary &) { - assert(genCtxt.arguments.size() == 1); - mlir::Type resType = genCtxt.getResultType(); - if (resType != genCtxt.arguments[0].getType()) +mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1); + if (resultType != args[0].getType()) llvm_unreachable("argument type mismatch"); - Fortran::lower::FirOpBuilder &builder = *genCtxt.builder; - builder.setLocation(genCtxt.loc); - mlir::Value cplx = genCtxt.arguments[0]; + mlir::Value cplx = args[0]; auto imag = builder.extractComplexPart(cplx, /*isImagPart=*/true); - auto negImag = builder.create(genCtxt.loc, imag); + auto negImag = builder.createHere(imag); return builder.insertComplexPart(cplx, negImag, /*isImagPart=*/true); } // ICHAR -mlir::Value IntrinsicLibrary::Implementation::genIchar(Context &genCtxt, - MathRuntimeLibrary &) { +mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, + llvm::ArrayRef args) { // There can be an optional kind in second argument. - assert(genCtxt.arguments.size() >= 1); - auto &builder = *genCtxt.builder; + assert(args.size() >= 1); - auto arg = genCtxt.arguments[0]; + auto arg = args[0]; auto dataAndLen = builder.createUnboxChar(arg); auto charType = fir::CharacterType::get( builder.getContext(), builder.getCharacterKind(arg.getType())); auto refType = fir::ReferenceType::get(charType); - auto charAddr = - builder.create(genCtxt.loc, refType, dataAndLen.first); - auto charVal = builder.create(genCtxt.loc, charType, charAddr); - return builder.create(genCtxt.loc, genCtxt.getResultType(), - charVal); + auto charAddr = builder.createHere(refType, dataAndLen.first); + auto charVal = builder.createHere(charType, charAddr); + return builder.createHere(resultType, charVal); } // LEN_TRIM -mlir::Value IntrinsicLibrary::Implementation::genLenTrim(Context &genCtxt, - MathRuntimeLibrary &) { +mlir::Value IntrinsicLibrary::genLenTrim(mlir::Type, + llvm::ArrayRef args) { // Optional KIND argument reflected in result type. - assert(genCtxt.arguments.size() >= 1); + assert(args.size() >= 1); // FIXME: LEN_TRIM needs actual runtime and to be define in CharRT.h llvm_unreachable("LEN_TRIM TODO"); // Fake implementation for debugging: - // return genCtxt.builder->createIntegerConstant(genCtxt.getResultType(), 0); + // return builder.createIntegerConstant(resultType, 0); } // MERGE -mlir::Value IntrinsicLibrary::Implementation::genMerge(Context &genCtxt, - MathRuntimeLibrary &) { - assert(genCtxt.arguments.size() == 3); - Fortran::lower::FirOpBuilder &builder = *genCtxt.builder; - - auto trueVal = genCtxt.arguments[0]; - auto falseVal = genCtxt.arguments[1]; - auto mask = genCtxt.arguments[2]; +mlir::Value IntrinsicLibrary::genMerge(mlir::Type, + llvm::ArrayRef args) { + assert(args.size() == 3); + auto i1Type = mlir::IntegerType::get(1, builder.getContext()); - auto msk = builder.create(genCtxt.loc, i1Type, mask); - return builder.create(genCtxt.loc, msk, trueVal, falseVal); + auto mask = builder.createHere(i1Type, args[2]); + return builder.createHere(mask, args[0], args[1]); } // MOD -mlir::Value -IntrinsicLibrary::Implementation::genMod(Context &genCtxt, - MathRuntimeLibrary &runtime) { - assert(genCtxt.arguments.size() == 2); - auto type = genCtxt.getResultType(); - if (type.isa()) { - return genCtxt.builder->create( - genCtxt.loc, genCtxt.arguments[0], genCtxt.arguments[1]); - } +mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + if (resultType.isa()) + return builder.createHere(args[0], args[1]); + // Use runtime. Note that mlir::RemFOp alos implement floating point // remainder, but it does not work with fir::Real type. - return genRuntimeCall(genCtxt, runtime); + return genRuntimeCall("mod", resultType, args); } // SIGN -mlir::Value -IntrinsicLibrary::Implementation::genSign(Context &genCtxt, - MathRuntimeLibrary &runtime) { - assert(genCtxt.arguments.size() == 2); - auto &builder = *genCtxt.builder; - auto type = genCtxt.getResultType(); - auto abs = genval(genCtxt.loc, *genCtxt.builder, "abs", type, - {genCtxt.arguments[0]}, runtime); - if (type.isa()) { - auto zero = builder.createIntegerConstant(type, 0); - auto neg = builder.create(genCtxt.loc, zero, abs); - auto cmp = builder.create( - genCtxt.loc, mlir::CmpIPredicate::slt, genCtxt.arguments[1], zero); - return builder.create(genCtxt.loc, cmp, neg, abs); +mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + auto abs = genAbs(resultType, {args[0]}); + if (resultType.isa()) { + auto zero = builder.createIntegerConstant(resultType, 0); + auto neg = builder.createHere(zero, abs); + auto cmp = builder.createHere(mlir::CmpIPredicate::slt, + args[1], zero); + return builder.createHere(cmp, neg, abs); } // TODO: Requirements when second argument is +0./0. - auto zeroAttr = builder.getZeroAttr(type); - auto zero = builder.create(genCtxt.loc, type, zeroAttr); - auto neg = builder.create(genCtxt.loc, abs); - auto cmp = builder.create(genCtxt.loc, mlir::CmpFPredicate::OLT, - genCtxt.arguments[1], zero); - return builder.create(genCtxt.loc, cmp, neg, abs); + auto zeroAttr = builder.getZeroAttr(resultType); + auto zero = builder.createHere(resultType, zeroAttr); + auto neg = builder.createHere(abs); + auto cmp = + builder.createHere(mlir::CmpFPredicate::OLT, args[1], zero); + return builder.createHere(cmp, neg, abs); } // Compare two FIR values and return boolean result as i1. template -static mlir::Value createExtremumCompare(mlir::Location loc, - Fortran::lower::FirOpBuilder &builder, +static mlir::Value createExtremumCompare(Fortran::lower::FirOpBuilder &builder, mlir::Value left, mlir::Value right) { static constexpr auto integerPredicate = extremum == Extremum::Max ? mlir::CmpIPredicate::sgt @@ -832,33 +772,33 @@ static mlir::Value createExtremumCompare(mlir::Location loc, // Return the number if one of the inputs is NaN and the other is // a number. auto leftIsResult = - builder.create(loc, orderedCmp, left, right); - auto rightIsNan = builder.create( - loc, mlir::CmpFPredicate::UNE, right, right); - result = builder.create(loc, leftIsResult, rightIsNan); + builder.createHere(orderedCmp, left, right); + auto rightIsNan = builder.createHere( + mlir::CmpFPredicate::UNE, right, right); + result = builder.createHere(leftIsResult, rightIsNan); } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) { // Always return NaNs if one the input is NaNs auto leftIsResult = - builder.create(loc, orderedCmp, left, right); - auto leftIsNan = builder.create( - loc, mlir::CmpFPredicate::UNE, left, left); - result = builder.create(loc, leftIsResult, leftIsNan); + builder.createHere(orderedCmp, left, right); + auto leftIsNan = + builder.createHere(mlir::CmpFPredicate::UNE, left, left); + result = builder.createHere(leftIsResult, leftIsNan); } else if constexpr (behavior == ExtremumBehavior::MinMaxss) { // If the left is a NaN, return the right whatever it is. - result = builder.create(loc, orderedCmp, left, right); + result = builder.createHere(orderedCmp, left, right); } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) { // If one of the operand is a NaN, return left whatever it is. static constexpr auto unorderedCmp = extremum == Extremum::Max ? mlir::CmpFPredicate::UGT : mlir::CmpFPredicate::ULT; - result = builder.create(loc, unorderedCmp, left, right); + result = builder.createHere(unorderedCmp, left, right); } else { - // TODO: ieeMinNum/ieeeMaxNum + // TODO: ieeeMinNum/ieeeMaxNum static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum, - "ieeeMinNum/ieeMaxNum behavior not implemented"); + "ieeeMinNum/ieeeMaxNum behavior not implemented"); } } else if (type.isa()) { - result = builder.create(loc, integerPredicate, left, right); + result = builder.createHere(integerPredicate, left, right); } else if (type.isa()) { // TODO: ! character min and max is tricky because the result // length is the length of the longest argument! @@ -870,19 +810,59 @@ static mlir::Value createExtremumCompare(mlir::Location loc, // MIN and MAX template -mlir::Value -IntrinsicLibrary::Implementation::genExtremum(Context &genCtxt, - MathRuntimeLibrary &) { - auto &builder = *genCtxt.builder; - auto loc = genCtxt.loc; - assert(genCtxt.arguments.size() >= 2); - mlir::Value result = genCtxt.arguments[0]; - for (auto arg : genCtxt.arguments.drop_front()) { - auto mask = - createExtremumCompare(loc, builder, result, arg); - result = builder.create(loc, mask, result, arg); +mlir::Value IntrinsicLibrary::genExtremum(mlir::Type, + llvm::ArrayRef args) { + assert(args.size() >= 1); + mlir::Value result = args[0]; + for (auto arg : args.drop_front()) { + auto mask = createExtremumCompare(builder, result, arg); + result = builder.createHere(mask, result, arg); } return result; } -} // namespace Fortran::lower +//===----------------------------------------------------------------------===// +// IntrinsicCallOpsBuilder +//===----------------------------------------------------------------------===// + +template +mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genIntrinsicCall( + llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef args) { + return IntrinsicLibrary{impl()}.genIntrinsicCall(name, resultType, args); +} +template mlir::Value + Fortran::lower::IntrinsicCallOpsBuilder:: + genIntrinsicCall(llvm::StringRef, mlir::Type, + llvm::ArrayRef); + +template +mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genMax( + llvm::ArrayRef args) { + assert(args.size() > 0 && "max requires at least one argument"); + return IntrinsicLibrary{impl()} + .genExtremum(args[0].getType(), + args); +} +template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder< + Fortran::lower::FirOpBuilder>::genMax(llvm::ArrayRef); + +template +mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genMin( + llvm::ArrayRef args) { + assert(args.size() > 0 && "min requires at least one argument"); + return IntrinsicLibrary{impl()} + .genExtremum(args[0].getType(), + args); +} +template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder< + Fortran::lower::FirOpBuilder>::genMin(llvm::ArrayRef); + +template +mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genPow(mlir::Type type, + mlir::Value x, + mlir::Value y) { + return IntrinsicLibrary{impl()}.genRuntimeCall("pow", type, {x, y}); +} +template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder< + Fortran::lower::FirOpBuilder>::genPow(mlir::Type, mlir::Value, mlir::Value); diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index cac5f9f96a225..ef13311d05a16 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -44,6 +44,16 @@ subroutine dble_test(a) print *, dble(a) end subroutine +! CONJG +! CHECK-LABEL: conjg_test +subroutine conjg_test(z1, z2) + complex :: z1, z2 + ! CHECK: fir.extract_value + ! CHECK: fir.negf + ! CHECK: fir.insert_value + z2 = conjg(z1) +end subroutine + ! ICHAR ! CHECK-LABEL: ichar_test subroutine ichar_test(c) @@ -52,6 +62,16 @@ subroutine ichar_test(c) print *, ichar(c) end subroutine +! LEN +! CHECK-LABEL: len_test +subroutine len_test(i, c) + integer :: i + character(*) :: c + ! CHECK: fir.boxchar_len + i = len(c) +end subroutine + + ! SIGN ! CHECK-LABEL: sign_testi subroutine sign_testi(a, b, c) @@ -75,3 +95,10 @@ subroutine sign_testr(a, b, c) c = sign(a, b) end subroutine +! SQRT +! CHECK-LABEL: sqrt_testr +subroutine sqrt_testr(a, b) + real :: a, b + ! CHECK: call {{.*}}sqrt + b = sqrt(a) +end subroutine From 5922d0fe596fafd9f458cde62ea1db1016e624f6 Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 22 Apr 2020 14:47:31 -0700 Subject: [PATCH 0013/1017] add ability to use ConvertOp to perform a type conversion from a complex of one precision to a complex of another. add a test. untabify Add a test and fix some bugs for F77 array lowering More work on LAPACK LAPACK: changes to get xerbla_array.f to compile clean. Remove the special case handling of LOGICAL and i1. --- flang/LAPACK-bugs.txt | 10 +- flang/include/flang/Lower/ConvertExpr.h | 5 - flang/include/flang/Lower/FIRBuilder.h | 4 + flang/lib/Lower/Bridge.cpp | 180 ++++++++++++++-------- flang/lib/Optimizer/CodeGen.cpp | 99 ++++++++---- flang/test/Fir/convert.fir | 13 ++ flang/test/Lower/array.f90 | 73 +++++++++ flang/test/Lower/character-assignment.f90 | 3 +- flang/tools/bbc/bbc.cpp | 5 +- 9 files changed, 284 insertions(+), 108 deletions(-) create mode 100644 flang/test/Fir/convert.fir create mode 100644 flang/test/Lower/array.f90 diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index e547316d18038..6b77fe1578295 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -13,15 +13,17 @@ ______________ Intrinsics lowering problems . bbc: Lower/Intrinsics.cpp:763: Assertion `false && "LEN_TRIM TODO"' failed. -[unassigned] + lapack/BLAS/SRC/zhemm.f:304:27: 'fir.convert' op invalid type conversion + . bbc: This looks like the intrinsic lowering is not converting between floats and complex quite right. - . unexpected character type - . lapack/BLAS/SRC/dznrm2.f":112:11): error: 'fir.convert' op invalid type conversion - FIXED _____ +unexpected character type [xerbla] + +error: 'fir.convert' related to assignments + error: 'fir.coordinate_of' op cannot find coordinate with unknown extents Lowering globals in general diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h index e284dceb828c3..453fbfdcc1f72 100644 --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -51,11 +51,6 @@ mlir::Value createSomeExpression(mlir::Location loc, const evaluate::Expr &expr, SymMap &symMap); -mlir::Value -createI1LogicalExpression(mlir::Location loc, AbstractConverter &converter, - const evaluate::Expr &expr, - SymMap &symMap); - /// Create an address. /// Lowers `expr` to the FIR dialect of MLIR. The expression must be an entity /// and the address of the entity is returned. diff --git a/flang/include/flang/Lower/FIRBuilder.h b/flang/include/flang/Lower/FIRBuilder.h index fe56fe68e4628..55dc775530fc4 100644 --- a/flang/include/flang/Lower/FIRBuilder.h +++ b/flang/include/flang/Lower/FIRBuilder.h @@ -89,6 +89,10 @@ class FirOpBuilder : public mlir::OpBuilder { llvm::ArrayRef shape, bool asTarget = false); + mlir::Value allocateLocal(mlir::Location loc, mlir::Type ty, + llvm::StringRef nm, + llvm::ArrayRef shape); + /// Create a temporary. A temp is allocated using `fir.alloca` and can be read /// and written using `fir.load` and `fir.store`, resp. The temporary can be /// given a name via a front-end `Symbol` or a `StringRef`. diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 209e7ff5994df..499800b6ede11 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -71,7 +71,7 @@ struct IncrementLoopInfo { : loopVariableSym{sym}, lowerExpr{lowerExpr}, upperExpr{upperExpr}, stepExpr{stepExpr}, loopVariableType{type} {} - bool isStructured() const { return headerBlock == nullptr; } + bool isStructured() const { return !headerBlock; } // Data members for both structured and unstructured loops. Fortran::semantics::Symbol *loopVariableSym; @@ -79,6 +79,7 @@ struct IncrementLoopInfo { const Fortran::parser::ScalarExpr &upperExpr; const std::optional &stepExpr; mlir::Type loopVariableType; + mlir::Value loopVariable{}; mlir::Value stepValue{}; // possible uses in multiple blocks @@ -137,6 +138,8 @@ struct SymbolIndexAnalyzer { SymbolIndexAnalyzer() = delete; SymbolIndexAnalyzer(const SymbolIndexAnalyzer &) = delete; + /// Run the analysis on the symbol. Used to determine the type of index to + /// save in the symbol map. void analyze() { isChar = symIsChar(sym); if (isChar) { @@ -173,6 +176,7 @@ struct SymbolIndexAnalyzer { } } + /// Get the shape of an analyzed symbol. const Fortran::semantics::ArraySpec &getSymShape() { return sym.get().shape(); } @@ -198,8 +202,10 @@ struct SymbolIndexAnalyzer { return isChar && std::holds_alternative(charLen); } + /// Symbol is neither a CHARACTER nor an array. bool isTrivial() const { return !(isChar || isArray); } + /// Return true iff all the lower bound values are the constant 1. bool lboundIsAllOnes() const { return staticSize && llvm::all_of(staticLBound, [](int64_t v) { return v == 1; }); @@ -234,7 +240,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { fir::NameUniquer &uniquer) : mlirContext{bridge.getMLIRContext()}, cooked{bridge.getCookedSource()}, module{bridge.getModule()}, defaults{bridge.getDefaultKinds()}, - uniquer{uniquer} {} + kindMap{bridge.getKindMap()}, uniquer{uniquer} {} virtual ~FirConverter() = default; /// Convert the PFT to FIR @@ -358,10 +364,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::semantics::SomeExpr *expr) { return createSomeExpression(loc, *this, *expr, localSymbols); } - mlir::Value createLogicalExprAsI1(mlir::Location loc, - const Fortran::semantics::SomeExpr *expr) { - return createI1LogicalExpression(loc, *this, *expr, localSymbols); - } /// Find the symbol in the local map or return null. mlir::Value lookupSymbol(const Fortran::semantics::Symbol &sym) { @@ -441,8 +443,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::lower::pft::Evaluation *falseTarget) { assert(trueTarget && "missing conditional branch true block"); assert(falseTarget && "missing conditional branch true block"); - mlir::Value cond = - createLogicalExprAsI1(toLocation(), Fortran::semantics::GetExpr(expr)); + mlir::Value cond = genExprValue(*Fortran::semantics::GetExpr(expr)); genFIRConditionalBranch(cond, trueTarget->block, falseTarget->block); } @@ -502,16 +503,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { // template - mlir::OpBuilder::InsertPoint - genWhereCondition(fir::WhereOp &where, const A *stmt, bool withElse = true) { - auto cond = createLogicalExprAsI1( - toLocation(), - Fortran::semantics::GetExpr( - std::get(stmt->t))); - where = builder->create(toLocation(), cond, withElse); + std::pair + genWhereCondition(const A *stmt, bool withElse = true) { + auto cond = genExprValue(*Fortran::semantics::GetExpr( + std::get(stmt->t))); + auto where = builder->create(toLocation(), cond, withElse); auto insPt = builder->saveInsertionPoint(); builder->setInsertionPointToStart(&where.whereRegion().front()); - return insPt; + return {insPt, where}; } mlir::Value genFIRLoopIndex(const Fortran::parser::ScalarExpr &x, @@ -551,11 +550,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // Generate fir.where. - fir::WhereOp where; - auto insPt = genWhereCondition(where, &stmt, /*withElse=*/false); + auto pair = genWhereCondition(&stmt, /*withElse=*/false); genFIR(*eval.lexicalSuccessor, /*unstructuredContext=*/false); eval.lexicalSuccessor->skip = true; - builder->restoreInsertionPoint(insPt); + builder->restoreInsertionPoint(pair.first); } void genFIR(Fortran::lower::pft::Evaluation &eval, @@ -863,11 +861,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { for (auto &e : *eval.evaluationList) { if (auto *s = e.getIf()) { // fir.where op - insPt = genWhereCondition(underWhere, s); + std::tie(insPt, underWhere) = genWhereCondition(s); } else if (auto *s = e.getIf()) { // otherwise block, then nested fir.where builder->setInsertionPointToStart(&underWhere.otherRegion().front()); - genWhereCondition(underWhere, s); + std::tie(std::ignore, underWhere) = genWhereCondition(s); } else if (e.isA()) { // otherwise block builder->setInsertionPointToStart(&underWhere.otherRegion().front()); @@ -1144,11 +1142,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { TODO(); } - // - // Statements that do not have control-flow semantics - // - + //===--------------------------------------------------------------------===// // IO statements (see io.h) + //===--------------------------------------------------------------------===// void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::BackspaceStmt &stmt) { @@ -1194,20 +1190,53 @@ class FirConverter : public Fortran::lower::AbstractConverter { eval.getOwningProcedure()->labelEvaluationMap); } + //===--------------------------------------------------------------------===// + // Memory allocation and deallocation + //===--------------------------------------------------------------------===// + void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::AllocateStmt &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ContinueStmt &) { - // do nothing - } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::DeallocateStmt &) { TODO(); } + /// Nullify pointer object list + /// + /// For each pointer object, reset the pointer to a disassociated status. + /// We do this by setting each pointer to null. + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::NullifyStmt &stmt) { + for (auto &po : stmt.v) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::Name &sym) { + auto ty = genType(*sym.symbol); + auto load = builder->create( + toLocation(), lookupSymbol(*sym.symbol)); + auto idxTy = mlir::IndexType::get(&mlirContext); + auto zero = builder->create( + toLocation(), idxTy, builder->getIntegerAttr(idxTy, 0)); + auto cast = + builder->create(toLocation(), ty, zero); + builder->create(toLocation(), cast, load); + }, + [&](const Fortran::parser::StructureComponent &) { TODO(); }, + }, + po.u); + } + } + + //===--------------------------------------------------------------------===// + + void genFIR(Fortran::lower::pft::Evaluation &, + const Fortran::parser::ContinueStmt &) { + // do nothing + } + // We don't have runtime library support for various features. When they are // encountered, we emit an error message and exit immediately. void noRuntimeSupport(llvm::StringRef stmt) { @@ -1238,30 +1267,31 @@ class FirConverter : public Fortran::lower::AbstractConverter { noRuntimeSupport("LOCK"); } - /// Nullify pointer object list - /// - /// For each pointer object, reset the pointer to a disassociated status. - /// We do this by setting each pointer to null. - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::NullifyStmt &stmt) { - for (auto &po : stmt.v) { - std::visit( - Fortran::common::visitors{ - [&](const Fortran::parser::Name &sym) { - auto ty = genType(*sym.symbol); - auto load = builder->create( - toLocation(), lookupSymbol(*sym.symbol)); - auto idxTy = mlir::IndexType::get(&mlirContext); - auto zero = builder->create( - toLocation(), idxTy, builder->getIntegerAttr(idxTy, 0)); - auto cast = - builder->create(toLocation(), ty, zero); - builder->create(toLocation(), cast, load); - }, - [&](const Fortran::parser::StructureComponent &) { TODO(); }, - }, - po.u); + /// The LHS and RHS on assignments are not always in agreement in terms of + /// type. In some cases, the disagreement is between COMPLEX and REAL types. + /// In that case, the assignment must insert/extract out of a COMPLEX value to + /// be correct and strongly typed. + mlir::Value convertOnAssign(mlir::Location loc, mlir::Type toTy, + mlir::Value val) { + assert(toTy && "store location must be typed"); + auto fromTy = val.getType(); + if (fromTy == toTy) + return val; + if (fir::isa_real(fromTy) && fir::isa_complex(toTy)) { + // imaginary part is zero + auto eleTy = builder->getComplexPartType(toTy); + auto cast = builder->create(loc, eleTy, val); + llvm::APFloat zero{ + kindMap.getFloatSemantics(toTy.cast().getFKind()), 0}; + auto imag = builder->createRealConstant(loc, eleTy, zero); + return builder->createComplex(loc, toTy, cast, imag); } + if (fir::isa_complex(fromTy) && fir::isa_real(toTy)) { + // drop the imaginary part + auto rp = builder->extractComplexPart(val, /*isImagPart=*/false); + return builder->create(loc, toTy, rp); + } + return builder->create(loc, toTy, val); } /// Shared for both assignments and pointer assignments. @@ -1282,9 +1312,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto lhsType = assignment.lhs.GetType(); assert(lhsType && "lhs cannot be typeless"); if (isNumericScalarCategory(lhsType->category())) { - builder->create(toLocation(), - genExprValue(assignment.rhs), - genExprValue(assignment.lhs)); + auto val = genExprValue(assignment.rhs); + auto addr = genExprValue(assignment.lhs); + auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); + auto cast = convertOnAssign(toLocation(), toTy, val); + builder->create(toLocation(), cast, addr); } else if (isCharacterCategory(lhsType->category())) { TODO(); } else { @@ -1308,8 +1340,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto addr = genExprAddr(assignment.lhs); auto val = genExprValue(assignment.rhs); auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); - assert(toTy && "store location must be typed"); - auto cast = builder->create(loc, toTy, val); + auto cast = convertOnAssign(loc, toTy, val); builder->create(loc, cast, addr); } else if (isCharacterCategory(lhsType->category())) { // Fortran 2018 10.2.1.3 p10 and p11 @@ -1636,9 +1667,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { for (unsigned i = 0, end = arrTy.getDimension(); i < end; ++i) if (typeShape[i] == fir::SequenceType::getUnknownExtent()) args.push_back(shape[i]); - return builder->create(loc, ty, nm, llvm::None, args); + return builder->allocateLocal(loc, ty, nm, args); } - return builder->create(loc, ty, nm, llvm::None, shape); + return builder->allocateLocal(loc, ty, nm, shape); } /// Instantiate a local variable. Precondition: Each variable will be visited @@ -1750,8 +1781,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { } else { // cast to the known constant parts from the declaration auto castTy = fir::ReferenceType::get(genType(sym)); - if (addr) - addr = builder->create(loc, castTy, addr); + if (addr) { + // XXX: special handling for boxchar; see proviso above + if (auto box = + dyn_cast_or_null(addr.getDefiningOp())) + addr = builder->create(loc, castTy, box.memref()); + else + addr = builder->create(loc, castTy, addr); + } } // construct constants and populate `bounds` for (const auto &i : llvm::zip(sia.staticLBound, sia.staticShape)) { @@ -1776,10 +1813,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { bounds.emplace_back(lb, idx); continue; } + if (low && spec->ubound().isAssumed()) { + // An assumed size array. The extent is not computed. + auto lb = genExprValue(Fortran::semantics::SomeExpr{*low}); + bounds.emplace_back(lb, mlir::Value{}); + } break; } - auto unzip = + auto unzipInto = [&](llvm::SmallVectorImpl &shape, llvm::ArrayRef bounds) { std::for_each(bounds.begin(), bounds.end(), [&](const auto &pair) { @@ -1797,7 +1839,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(!mustBeDummy); llvm::SmallVector shape; shape.push_back(len); - unzip(shape, bounds); + unzipInto(shape, bounds); auto local = createNewLocal(loc, sym, shape); localSymbols.addCharSymbolWithBounds(sym, local, len, bounds); return; @@ -1809,7 +1851,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // local array with computed bounds assert(!mustBeDummy); llvm::SmallVector shape; - unzip(shape, bounds); + unzipInto(shape, bounds); auto local = createNewLocal(loc, sym, shape); localSymbols.addSymbolWithBounds(sym, local, bounds); return; @@ -1822,7 +1864,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { return; } assert(!mustBeDummy); - auto local = createNewLocal(loc, sym); + auto charTy = genType(sym); + auto c = sia.getCharLenConst(); + mlir::Value local = c ? builder->createCharacterTemp(charTy, *c) + : builder->createCharacterTemp(charTy, len); addCharSymbol(sym, local, len); return; } @@ -2017,6 +2062,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::ModuleOp &module; const Fortran::common::IntrinsicTypeDefaultKinds &defaults; Fortran::lower::FirOpBuilder *builder = nullptr; + const fir::KindMapping &kindMap; fir::NameUniquer &uniquer; Fortran::lower::SymMap localSymbols; Fortran::parser::CharBlock currentPosition; @@ -2043,8 +2089,8 @@ void Fortran::lower::LoweringBridge::parseSourceFile(llvm::SourceMgr &srcMgr) { Fortran::lower::LoweringBridge::LoweringBridge( const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::parser::CookedSource *cooked) - : defaultKinds{defaultKinds}, cooked{cooked} { - context = std::make_unique(); + : defaultKinds{defaultKinds}, cooked{cooked}, + context{std::make_unique()}, kindMap{context.get()} { module = std::make_unique( mlir::ModuleOp::create(mlir::UnknownLoc::get(context.get()))); } diff --git a/flang/lib/Optimizer/CodeGen.cpp b/flang/lib/Optimizer/CodeGen.cpp index 170fd0a9e9fc0..23c897cfa03be 100644 --- a/flang/lib/Optimizer/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen.cpp @@ -1008,46 +1008,88 @@ struct ConvertOpConversion : public FIROpConversion { return success(); } auto loc = convert.getLoc(); - mlir::Value v; + auto convertFpToFp = [&](mlir::Value val, unsigned fromBits, + unsigned toBits, mlir::Type toTy) -> mlir::Value { + // FIXME: what if different reps (F16, BF16) are the same size? + assert(fromBits != toBits); + if (fromBits > toBits) + return rewriter.create(loc, toTy, val); + return rewriter.create(loc, toTy, val); + }; + if (fir::isa_complex(convert.value().getType()) && + fir::isa_complex(convert.res().getType())) { + // Special case: handle the conversion of a complex such that both the + // real and imaginary parts are converted together. + auto zero = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), + convert.getContext()); + auto one = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), + convert.getContext()); + auto rp = + rewriter.create(loc, fromTy_, op0, zero); + auto ip = + rewriter.create(loc, fromTy_, op0, one); + auto ty = convertType(getComplexEleTy(convert.value().getType())); + auto nt = convertType(getComplexEleTy(convert.res().getType())); + auto fromBits = unwrap(ty).getUnderlyingType()->getPrimitiveSizeInBits(); + auto toBits = unwrap(nt).getUnderlyingType()->getPrimitiveSizeInBits(); + auto rc = convertFpToFp(rp, fromBits, toBits, nt); + auto ic = convertFpToFp(ip, fromBits, toBits, nt); + auto un = rewriter.create(loc, toTy_); + auto i1 = + rewriter.create(loc, toTy_, un, rc, zero); + rewriter.replaceOpWithNewOp(convert, toTy_, i1, + ic, one); + return mlir::success(); + } if (fromLLVMTy->isFloatingPointTy()) { if (toLLVMTy->isFloatingPointTy()) { - std::size_t fromBits{fromLLVMTy->getPrimitiveSizeInBits()}; - std::size_t toBits{toLLVMTy->getPrimitiveSizeInBits()}; - // FIXME: what if different reps (F16, BF16) are the same size? - assert(fromBits != toBits); - if (fromBits > toBits) - v = rewriter.create(loc, toTy, op0); - else - v = rewriter.create(loc, toTy, op0); - } else if (toLLVMTy->isIntegerTy()) { - v = rewriter.create(loc, toTy, op0); + auto fromBits = fromLLVMTy->getPrimitiveSizeInBits(); + auto toBits = toLLVMTy->getPrimitiveSizeInBits(); + auto v = convertFpToFp(op0, fromBits, toBits, toTy); + rewriter.replaceOp(convert, v); + return mlir::success(); + } + if (toLLVMTy->isIntegerTy()) { + rewriter.replaceOpWithNewOp(convert, toTy, op0); + return mlir::success(); } } else if (fromLLVMTy->isIntegerTy()) { if (toLLVMTy->isIntegerTy()) { std::size_t fromBits{fromLLVMTy->getIntegerBitWidth()}; std::size_t toBits{toLLVMTy->getIntegerBitWidth()}; assert(fromBits != toBits); - if (fromBits > toBits) - v = rewriter.create(loc, toTy, op0); - else - v = rewriter.create(loc, toTy, op0); - } else if (toLLVMTy->isFloatingPointTy()) { - v = rewriter.create(loc, toTy, op0); - } else if (toLLVMTy->isPointerTy()) { - v = rewriter.create(loc, toTy, op0); + if (fromBits > toBits) { + rewriter.replaceOpWithNewOp(convert, toTy, op0); + return mlir::success(); + } + rewriter.replaceOpWithNewOp(convert, toTy, op0); + return mlir::success(); + } + if (toLLVMTy->isFloatingPointTy()) { + rewriter.replaceOpWithNewOp(convert, toTy, op0); + return mlir::success(); + } + if (toLLVMTy->isPointerTy()) { + rewriter.replaceOpWithNewOp(convert, toTy, op0); + return mlir::success(); } } else if (fromLLVMTy->isPointerTy()) { if (toLLVMTy->isIntegerTy()) { - v = rewriter.create(loc, toTy, op0); - } else if (toLLVMTy->isPointerTy()) { - v = rewriter.create(loc, toTy, op0); + rewriter.replaceOpWithNewOp(convert, toTy, op0); + return mlir::success(); + } + if (toLLVMTy->isPointerTy()) { + rewriter.replaceOpWithNewOp(convert, toTy, op0); + return mlir::success(); } } - if (v) - rewriter.replaceOp(convert, v); - else - emitError(loc) << "cannot convert " << fromTy_ << " to " << toTy_; - return success(); + return emitError(loc) << "cannot convert " << fromTy_ << " to " << toTy_; + } + + static mlir::Type getComplexEleTy(mlir::Type complex) { + if (auto cc = complex.dyn_cast()) + return cc.getElementType(); + return complex.cast().getElementType(); } }; @@ -1226,7 +1268,8 @@ struct ExtractValueOpConversion mlir::LogicalResult doRewrite(fir::ExtractValueOp extractVal, mlir::Type ty, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - assert(fir::allConstants(operands.drop_front(1))); + if (!fir::allConstants(operands.drop_front(1))) + llvm_unreachable("fir.extract_value incorrectly formed"); // since all indices are constants use LLVM's extractvalue instruction SmallVector attrs; for (std::size_t i = 1, end{operands.size()}; i < end; ++i) diff --git a/flang/test/Fir/convert.fir b/flang/test/Fir/convert.fir new file mode 100644 index 0000000000000..ad480133c6ad7 --- /dev/null +++ b/flang/test/Fir/convert.fir @@ -0,0 +1,13 @@ +// RUN: tco %s | FileCheck %s + +// CHECK-LABEL: define { double, double } @c({ float, float } +func @c(%x : !fir.complex<4>) -> !fir.complex<8> { +// CHECK: %[[R:.*]] = extractvalue { float, float } %{{.*}}, 0 +// CHECK: %[[I:.*]] = extractvalue { float, float } %{{.*}}, 1 +// CHECK: %[[CR:.*]] = fpext float %[[R]] to double +// CHECK: %[[CI:.*]] = fpext float %[[I]] to double +// CHECK: %[[X:.*]] = insertvalue { double, double } undef, double %[[CR]], 0 +// CHECK: insertvalue { double, double } %[[X]], double %[[CI]], 1 + %1 = fir.convert %x : (!fir.complex<4>) -> !fir.complex<8> + return %1 : !fir.complex<8> +} diff --git a/flang/test/Lower/array.f90 b/flang/test/Lower/array.f90 new file mode 100644 index 0000000000000..c3a0e80ec5853 --- /dev/null +++ b/flang/test/Lower/array.f90 @@ -0,0 +1,73 @@ +! RUN: bbc -o - %s | FileCheck %s + +subroutine s(i,j,k,ii,jj,kk,a1,a2,a3,a4,a5,a6,a7) + integer i, j, k, ii, jj, kk + + ! extents are compile-time constant + real a1(10,20) + integer a2(30,*) + real a3(2:40,3:50) + integer a4(4:60, 5:*) + + ! extents computed at run-time + real a5(i:j) + integer a6(6:i,j:*) + real a7(i:70,7:j,k:80) + + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK-DAG: fir.load %arg3 : + ! CHECK-DAG: %[[i1:.*]] = subi %{{.*}}, %[[one:c1.*]] : + ! CHECK-DAG: fir.load %arg4 : + ! CHECK-DAG: %[[j1:.*]] = subi %{{.*}}, %[[one]] : + ! CHECK: fir.coordinate_of %arg6, %[[i1]], %[[j1]] : + ! CHECK-LABEL: EndIoStatement + print *, a1(ii,jj) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK-LABEL: EndIoStatement + print *, a2(ii,jj) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK-DAG: fir.load %arg3 : + ! CHECK-DAG: %[[i2:.*]] = subi %{{.*}}, %c2{{.*}} : + ! CHECK-DAG: fir.load %arg4 : + ! CHECK-DAG: %[[j2:.*]] = subi %{{.*}}, %c3{{.*}} : + ! CHECK: fir.coordinate_of %arg8, %[[i2]], %[[j2]] : + ! CHECK-LABEL: EndIoStatement + print *, a3(ii,jj) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK-LABEL: EndIoStatement + print *, a4(ii,jj) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK: %[[a5:.*]] = fir.convert %arg10 : {{.*}} -> !fir.ref + ! CHECK: fir.load %arg5 : + ! CHECK: %[[x5:.*]] = subi %{{.*}}, %{{.*}} : + ! CHECK: fir.coordinate_of %[[a5]], %[[x5]] : + ! CHECK-LABEL: EndIoStatement + print *, a5(kk) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK: %[[a6:.*]] = fir.convert %arg11 : {{.*}} -> !fir.ref + ! CHECK: fir.load %arg3 : + ! CHECK-DAG: %[[x6:.*]] = subi %{{.*}}, %{{.*}} : + ! CHECK-DAG: fir.load %arg4 : + ! CHECK: %[[y6:.*]] = subi %{{.*}}, %{{.*}} : + ! CHECK: %[[z6:.*]] = muli %{{.}}, %[[y6]] : + ! CHECK: %[[w6:.*]] = addi %[[z6]], %[[x6]] : + ! CHECK: fir.coordinate_of %[[a6]], %[[w6]] : + ! CHECK-LABEL: EndIoStatement + print *, a6(ii, jj) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK: %[[a7:.*]] = fir.convert %arg12 : {{.*}} -> !fir.ref + ! CHECK: fir.load %arg5 : + ! CHECK-DAG: %[[x7:.*]] = subi %{{.*}}, %{{.*}} : + ! CHECK-DAG: fir.load %arg4 : + ! CHECK: %[[y7:.*]] = subi %{{.*}}, %{{.*}} : + ! CHECK: %[[z7:.*]] = muli %[[u7:.*]], %[[y7]] : + ! CHECK: %[[w7:.*]] = addi %[[z7]], %[[x7]] : + ! CHECK-DAG: %[[v7:.*]] = muli %[[u7]], %{{.*}} : + ! CHECK-DAG: fir.load %arg3 : + ! CHECK: %[[r7:.*]] = subi %{{.*}}, %{{.*}} : + ! CHECK: %[[s7:.*]] = muli %[[v7]], %[[r7]] : + ! CHECK: %[[t7:.*]] = addi %[[s7]], %[[w7]] : + ! CHECK: fir.coordinate_of %[[a7]], %[[t7]] : + ! CHECK-LABEL: EndIoStatement + print *, a7(kk, jj, ii) +end subroutine s diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index 0ff9520dab080..568db7a317be3 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -15,9 +15,10 @@ subroutine assign1(lhs, rhs) ! CHECK: %[[cmp_len:[0-9]+]] = cmpi "slt", %[[lhs:.*]]#1, %[[rhs:.*]]#1 ! CHECK-NEXT: %[[min_len:[0-9]+]] = select %[[cmp_len]], %[[lhs]]#1, %[[rhs]]#1 + ! CHECK-NEXT: %[[minIdxLen:.*]] = fir.convert %[[min_len]] ! Allocate temp in case rhs and lhs may overlap - ! CHECK: %[[tmp:.*]] = fir.alloca !fir.char<1>, %[[min_len]] + ! CHECK: %[[tmp:.*]] = fir.alloca !fir.char<1>, %[[minIdxLen]] ! Copy of rhs into temp ! CHECK: fir.do_loop %[[i:.*]] = diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 3140abd74af51..cbf18497dede9 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -177,7 +177,6 @@ static void convertFortranSourceToMLIR( fir::NameUniquer nameUniquer; auto burnside = Fortran::lower::LoweringBridge::create( semanticsContext.defaultKinds(), &parsing.cooked()); - fir::KindMapping kindMap{&burnside.getMLIRContext()}; burnside.lower(parseTree, nameUniquer, semanticsContext); mlir::ModuleOp mlirModule = burnside.getModule(); std::error_code ec; @@ -199,9 +198,9 @@ static void convertFortranSourceToMLIR( mlir::PassManager pm(mlirModule.getContext()); mlir::applyPassManagerCLOptions(pm); pm.addPass(fir::createLowerToLoopPass()); - pm.addPass(fir::createFIRToStdPass(kindMap)); + pm.addPass(fir::createFIRToStdPass(burnside.getKindMap())); pm.addPass(mlir::createLowerToCFGPass()); - //pm.addPass(fir::createMemToRegPass()); + // pm.addPass(fir::createMemToRegPass()); pm.addPass(fir::createCSEPass()); pm.addPass(mlir::createCanonicalizerPass()); From 7d95bebea84c030d591870f17c778a2a36f7f476 Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Mon, 27 Apr 2020 11:41:51 -0700 Subject: [PATCH 0014/1017] Implement subroutine calls with alternate returns. (#26) Implement subroutine calls with alternate returns. --- flang/lib/Lower/Bridge.cpp | 140 ++++++++++++++++++++++--------------- 1 file changed, 85 insertions(+), 55 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 499800b6ede11..0d96ed474b822 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -468,34 +468,36 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->create(toLocation(), retval); } + /// Argument \p funit is a subroutine that has alternate return specifiers. + /// Return the variable that contains the result value of a call to \p funit. + const mlir::Value + getAltReturnResult(const Fortran::lower::pft::FunctionLikeUnit &funit) { + const auto &symbol = funit.getSubprogramSymbol(); + assert(Fortran::semantics::HasAlternateReturns(symbol) && + "subroutine does not have alternate returns"); + const auto returnValue = lookupSymbol(symbol); + assert(returnValue && "missing alternate return value"); + return returnValue; + } + void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit, const Fortran::semantics::Symbol &symbol) { - // Make sure we end the current block with a terminator. if (auto *finalBlock = funit.finalBlock) { + // The current block must end with a terminator. if (blockIsUnterminated()) builder->create(toLocation(), finalBlock); // Set insertion point to final block. builder->setInsertionPoint(finalBlock, finalBlock->end()); } - if (Fortran::semantics::IsFunction(symbol)) { - // FUNCTION genReturnSymbol(symbol); - return; - } - - // SUBROUTINE - if (Fortran::semantics::HasAlternateReturns(symbol)) { - // lower to a the constant expression (or zero); the return value will - // drive a SelectOp in the calling context to branch to the alternate - // return LABEL block - TODO(); - mlir::Value intExpr{}; - builder->create(toLocation(), intExpr); - return; + } else if (Fortran::semantics::HasAlternateReturns(symbol)) { + mlir::Value retval = + builder->create(toLocation(), getAltReturnResult(funit)); + builder->create(toLocation(), retval); + } else { + genExitRoutine(); } - - genExitRoutine(); } // @@ -532,12 +534,27 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::parser::CallStmt &stmt) { setCurrentPosition(stmt.v.source); assert(stmt.typedCall && "Call was not analyzed"); - // The actual lowering is forwarded to expression lowering - // where the code is shared with function reference. Fortran::semantics::SomeExpr expr{*stmt.typedCall}; + // Call statement lowering shares code with function call lowering. auto res = createFIRExpr(toLocation(), &expr); - if (res) - TODO(); // Alternate returns + if (!res) + return; // "Normal" subroutine call. + // Call with alternate return specifiers. + // The call returns an index that selects an alternate return branch target. + llvm::SmallVector indexList; + llvm::SmallVector blockList; + int64_t index = 0; + for (const auto &arg : + std::get>(stmt.v.t)) { + const auto &actual = std::get(arg.t); + if (const auto *altReturn = + std::get_if(&actual.u)) { + indexList.push_back(++index); + blockList.push_back(blockOfLabel(eval, altReturn->v)); + } + } + blockList.push_back(eval.lexicalSuccessor->block); // default = fallthrough + builder->create(toLocation(), res, indexList, blockList); } void genFIR(Fortran::lower::pft::Evaluation &eval, @@ -569,9 +586,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::parser::ComputedGotoStmt &stmt) { mlir::Value selectExpr = genExprValue(*Fortran::semantics::GetExpr( std::get(stmt.t))); - constexpr int vSize = 10; - llvm::SmallVector indexList; - llvm::SmallVector blockList; + llvm::SmallVector indexList; + llvm::SmallVector blockList; int64_t index = 0; for (auto &label : std::get>(stmt.t)) { indexList.push_back(++index); @@ -656,9 +672,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { return; } auto labelSet = iter->second; - constexpr int vSize = 10; - llvm::SmallVector indexList; - llvm::SmallVector blockList; + llvm::SmallVector indexList; + llvm::SmallVector blockList; auto addLabel = [&](Fortran::parser::Label label) { indexList.push_back(label); blockList.push_back(blockOfLabel(eval, label)); @@ -1009,10 +1024,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { const auto selectExpr = genExprValue( *Fortran::semantics::GetExpr(std::get(stmt.t))); const auto selectType = selectExpr.getType(); - constexpr int vSize = 10; - llvm::SmallVector attrList; - llvm::SmallVector valueList; - llvm::SmallVector blockList; + llvm::SmallVector attrList; + llvm::SmallVector valueList; + llvm::SmallVector blockList; auto *defaultBlock = eval.parentConstruct->constructExit->block; using CaseValue = Fortran::parser::Scalar; auto addValue = [&](const CaseValue &caseValue) { @@ -1470,26 +1484,28 @@ class FirConverter : public Fortran::lower::AbstractConverter { // gen expression, if any; share code with END of procedure void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::ReturnStmt &stmt) { - const auto *funit = eval.getOwningProcedure(); - assert(funit && "not inside main program or a procedure"); + auto *funit = eval.getOwningProcedure(); + assert(funit && "not inside main program, function or subroutine"); if (funit->isMainProgram()) { genExitRoutine(); - } else { - if (stmt.v) { - // Alternate return - TODO(); - } - // an ordinary RETURN should be lowered as a GOTO to the last block of the - // SUBROUTINE - auto *subr = eval.getOwningProcedure(); - assert(subr && "RETURN not in a PROCEDURE"); - if (!subr->finalBlock) { - auto insPt = builder->saveInsertionPoint(); - subr->finalBlock = builder->createBlock(&builder->getRegion()); - builder->restoreInsertionPoint(insPt); - } - builder->create(toLocation(), subr->finalBlock); + return; + } + if (stmt.v) { + // Alternate return statement -- assign alternate return index. + auto expr = Fortran::semantics::GetExpr(*stmt.v); + assert(expr && "missing alternate return expression"); + auto altReturnIndex = builder->createHere( + builder->getIndexType(), genExprValue(*expr)); + builder->create(toLocation(), altReturnIndex, + getAltReturnResult(*funit)); + } + // Branch to the last block of the SUBROUTINE, which has the actual return. + if (!funit->finalBlock) { + const auto insPt = builder->saveInsertionPoint(); + funit->finalBlock = builder->createBlock(&builder->getRegion()); + builder->restoreInsertionPoint(insPt); } + builder->create(toLocation(), funit->finalBlock); } void genFIR(Fortran::lower::pft::Evaluation &eval, @@ -1894,7 +1910,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { std::string name = funit.isMainProgram() ? uniquer.doProgramEntry().str() : mangleName(funit.getSubprogramSymbol()); - // FIXME: do NOT use unknown for the anonymous PROGRAM case. We probably // should just stash the location in the funit regardless. mlir::Location loc = toLocation(funit.getStartingSourceLoc()); @@ -1906,6 +1921,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(builder && "FirOpBuilder did not instantiate"); func.addEntryBlock(); builder->setInsertionPointToStart(&func.front()); + bool hasAlternateReturns = false; if (useOldInitializerCode) { Fortran::lower::SymMap dummyAssociations; @@ -1919,7 +1935,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (std::get<0>(v)) { dummyAssociations.addSymbol(*std::get<0>(v), std::get<1>(v)); } else { - TODO(); // handle alternate return + TODO(); // [alt return; code under useOldInitializerCode is dead] } } @@ -1944,12 +1960,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (funit.symbol && !funit.isMainProgram()) { const auto &details = funit.symbol->get(); - for (const auto &v : - llvm::zip(details.dummyArgs(), entryBlock->getArguments())) { - if (std::get<0>(v)) { - addSymbol(*std::get<0>(v), std::get<1>(v)); + auto blockIter = entryBlock->getArguments().begin(); + for (const auto &dummy : details.dummyArgs()) { + if (dummy) { + addSymbol(*dummy, *blockIter++); } else { - TODO(); // handle alternate return + hasAlternateReturns = true; } } } @@ -1962,6 +1978,20 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Reinstate entry block as the current insertion point. builder->setInsertionPointToEnd(&func.front()); + + if (hasAlternateReturns) { + // Create a local temp to hold the alternate return index. + // Give it an integer index type and the subroutine name (for dumps). + // Attach it to the subroutine symbol in the localSymbols map. + // Initialize it to zero, the "fallthrough" alternate return value. + const auto &symbol = funit.getSubprogramSymbol(); + const auto altResult = builder->createTemporary( + toLocation(), builder->getIndexType(), symbol.name().ToString()); + addSymbol(symbol, altResult); + const auto zero = + builder->createIntegerConstant(builder->getIndexType(), 0); + builder->create(toLocation(), zero, altResult); + } } /// Create empty blocks for the current function. From 7f53e47ad753c81896bde646e481603d5e4b2cbc Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 27 Apr 2020 12:12:18 -0700 Subject: [PATCH 0015/1017] Improve character literal names. Add a mechanism to avoid future collisions. move safe conversion to builder. rework FirOpBuilder for KindMapping. fixes all the internal conversion problems when lowering intrinsics as exposed by BLAS. fixes logical conversions add back a change lost in merge Start converting the speculative conversion of logical to bool to use lazy type coercion. Fix bugs that fall out of that conversion. fix compilation failure. function was merged twice. small cleanup on comments, missing cast remove stray change Wrap a CHARACTER literal in a box. Add a static flag on the link line to avoid the linker failing when using the local tools setup. alternative fix. this one works on the Mac as well. Move the lib files around so they align with the include directory. Rework the cmake files and use the new styles there. Moving some code around. Renaming files to be more reflective of what they do currently. Refactoring comingled code into separate files. --- flang/LAPACK-bugs.txt | 5 +- flang/include/flang/Lower/FIRBuilder.h | 4 - flang/lib/Lower/Bridge.cpp | 53 +++----- flang/lib/Lower/Intrinsics.cpp | 16 +-- flang/lib/Optimizer/Analysis/CMakeLists.txt | 13 ++ .../IteratedDominanceFrontier.cpp | 0 flang/lib/Optimizer/CodeGen/CMakeLists.txt | 13 ++ flang/lib/Optimizer/{ => CodeGen}/CodeGen.cpp | 5 +- flang/lib/Optimizer/Transforms/CMakeLists.txt | 20 +-- .../ControlFlowConverter.cpp} | 118 ++++-------------- .../Optimizer/Transforms/RaiseToAffine.cpp | 80 ++++++++++++ .../lib/Optimizer/Transforms/RewriteLoop.cpp | 70 +---------- flang/test/Examples/hello.f90 | 4 +- flang/test/Lower/character-assignment.f90 | 2 +- flang/tools/bbc/CMakeLists.txt | 3 +- flang/tools/bbc/bbc.cpp | 3 +- 16 files changed, 186 insertions(+), 223 deletions(-) create mode 100644 flang/lib/Optimizer/Analysis/CMakeLists.txt rename flang/lib/Optimizer/{ => Analysis}/IteratedDominanceFrontier.cpp (100%) create mode 100644 flang/lib/Optimizer/CodeGen/CMakeLists.txt rename flang/lib/Optimizer/{ => CodeGen}/CodeGen.cpp (99%) rename flang/lib/Optimizer/{StdConverter.cpp => Transforms/ControlFlowConverter.cpp} (63%) create mode 100644 flang/lib/Optimizer/Transforms/RaiseToAffine.cpp diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index 6b77fe1578295..002e174149db5 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -13,15 +13,14 @@ ______________ Intrinsics lowering problems . bbc: Lower/Intrinsics.cpp:763: Assertion `false && "LEN_TRIM TODO"' failed. - lapack/BLAS/SRC/zhemm.f:304:27: 'fir.convert' op invalid type conversion - . bbc: This looks like the intrinsic lowering is not converting between floats and complex quite right. - FIXED _____ unexpected character type [xerbla] +intrinsics: 'fir.convert' op invalid type conversion + error: 'fir.convert' related to assignments error: 'fir.coordinate_of' op cannot find coordinate with unknown extents diff --git a/flang/include/flang/Lower/FIRBuilder.h b/flang/include/flang/Lower/FIRBuilder.h index 55dc775530fc4..fe56fe68e4628 100644 --- a/flang/include/flang/Lower/FIRBuilder.h +++ b/flang/include/flang/Lower/FIRBuilder.h @@ -89,10 +89,6 @@ class FirOpBuilder : public mlir::OpBuilder { llvm::ArrayRef shape, bool asTarget = false); - mlir::Value allocateLocal(mlir::Location loc, mlir::Type ty, - llvm::StringRef nm, - llvm::ArrayRef shape); - /// Create a temporary. A temp is allocated using `fir.alloca` and can be read /// and written using `fir.load` and `fir.store`, resp. The temporary can be /// given a name via a front-end `Symbol` or a `StringRef`. diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 0d96ed474b822..9dc6887479b25 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -329,7 +329,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { return Fortran::lower::mangle::mangleName(uniquer, symbol); } - std::string uniqueCGIdent(llvm::StringRef name) override final { + std::string uniqueCGIdent(llvm::StringRef prefix, + llvm::StringRef name) override final { // For "long" identifiers use a hash value if (name.size() > nameLengthHashSize) { llvm::MD5 hash; @@ -338,12 +339,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { hash.final(result); llvm::SmallString<32> str; llvm::MD5::stringifyResult(result, str); - std::string hashName = "h."; - hashName.append(str.c_str()); + std::string hashName = prefix.str(); + hashName.append(".").append(str.c_str()); return uniquer.doGenerated(hashName); } // "Short" identifiers use a reversible hex string - return uniquer.doGenerated(llvm::toHex(name)); + std::string nm = prefix.str(); + return uniquer.doGenerated(nm.append(".").append(llvm::toHex(name))); } private: @@ -434,8 +436,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIRConditionalBranch(mlir::Value &cond, mlir::Block *trueTarget, mlir::Block *falseTarget) { - builder->create(toLocation(), cond, trueTarget, - llvm::None, falseTarget, llvm::None); + auto loc = toLocation(); + auto bcc = builder->create(loc, builder->getI1Type(), cond); + builder->create(loc, bcc, trueTarget, llvm::None, + falseTarget, llvm::None); } void genFIRConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr, @@ -509,7 +513,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { genWhereCondition(const A *stmt, bool withElse = true) { auto cond = genExprValue(*Fortran::semantics::GetExpr( std::get(stmt->t))); - auto where = builder->create(toLocation(), cond, withElse); + auto bcc = builder->create(toLocation(), + builder->getI1Type(), cond); + auto where = builder->create(toLocation(), bcc, withElse); auto insPt = builder->saveInsertionPoint(); builder->setInsertionPointToStart(&where.whereRegion().front()); return {insPt, where}; @@ -1281,33 +1287,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { noRuntimeSupport("LOCK"); } - /// The LHS and RHS on assignments are not always in agreement in terms of - /// type. In some cases, the disagreement is between COMPLEX and REAL types. - /// In that case, the assignment must insert/extract out of a COMPLEX value to - /// be correct and strongly typed. - mlir::Value convertOnAssign(mlir::Location loc, mlir::Type toTy, - mlir::Value val) { - assert(toTy && "store location must be typed"); - auto fromTy = val.getType(); - if (fromTy == toTy) - return val; - if (fir::isa_real(fromTy) && fir::isa_complex(toTy)) { - // imaginary part is zero - auto eleTy = builder->getComplexPartType(toTy); - auto cast = builder->create(loc, eleTy, val); - llvm::APFloat zero{ - kindMap.getFloatSemantics(toTy.cast().getFKind()), 0}; - auto imag = builder->createRealConstant(loc, eleTy, zero); - return builder->createComplex(loc, toTy, cast, imag); - } - if (fir::isa_complex(fromTy) && fir::isa_real(toTy)) { - // drop the imaginary part - auto rp = builder->extractComplexPart(val, /*isImagPart=*/false); - return builder->create(loc, toTy, rp); - } - return builder->create(loc, toTy, val); - } - /// Shared for both assignments and pointer assignments. void genFIR(const Fortran::evaluate::Assignment &assignment) { std::visit( @@ -1329,7 +1308,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto val = genExprValue(assignment.rhs); auto addr = genExprValue(assignment.lhs); auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); - auto cast = convertOnAssign(toLocation(), toTy, val); + auto cast = builder->convertOnAssign(toLocation(), toTy, val); builder->create(toLocation(), cast, addr); } else if (isCharacterCategory(lhsType->category())) { TODO(); @@ -1354,7 +1333,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto addr = genExprAddr(assignment.lhs); auto val = genExprValue(assignment.rhs); auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); - auto cast = convertOnAssign(loc, toTy, val); + auto cast = builder->convertOnAssign(loc, toTy, val); builder->create(loc, cast, addr); } else if (isCharacterCategory(lhsType->category())) { // Fortran 2018 10.2.1.3 p10 and p11 @@ -1917,7 +1896,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::lower::FirOpBuilder::getNamedFunction(module, name); if (!func) func = createNewFunction(loc, name, funit.symbol); - builder = new Fortran::lower::FirOpBuilder(func); + builder = new Fortran::lower::FirOpBuilder(func, kindMap); assert(builder && "FirOpBuilder did not instantiate"); func.addEntryBlock(); builder->setInsertionPointToStart(&func.front()); diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index 5dca899df4bd2..368763d8432c1 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -545,8 +545,8 @@ IntrinsicLibrary::outlineInWrapper(Generator generator, llvm::StringRef name, // Create local context to emit code into the newly created function // This new function is not linked to a source file location, only // its calls will be. - auto localBuilder = - std::make_unique(function); + auto localBuilder = std::make_unique( + function, builder.getKindMap()); localBuilder->setInsertionPointToStart(&function.front()); llvm::SmallVector localArguments; for (mlir::BlockArgument bArg : function.front().getArguments()) @@ -589,8 +589,9 @@ mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name, for (mlir::Value arg : args) { auto actualType = actualFuncType.getInput(i); if (soughtFuncType.getInput(i) != actualType) { - auto castedArg = builder.createHere(actualType, arg); - convertedArguments.push_back(castedArg.getResult()); + auto castedArg = + builder.convertOnAssign(builder.getLoc(), actualType, arg); + convertedArguments.push_back(castedArg); } else { convertedArguments.push_back(arg); } @@ -600,8 +601,9 @@ mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name, mlir::Type soughtType = soughtFuncType.getResult(0); mlir::Value res = call.getResult(0); if (actualFuncType.getResult(0) != soughtType) { - auto castedRes = builder.createHere(soughtType, res); - return castedRes.getResult(); + auto castedRes = + builder.convertOnAssign(builder.getLoc(), soughtType, res); + return castedRes; } else { return res; } @@ -619,7 +621,7 @@ mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType, llvm::ArrayRef args) { // There can be an optional kind in second argument. assert(args.size() >= 1); - return builder.createHere(resultType, args[0]); + return builder.convertOnAssign(builder.getLoc(), resultType, args[0]); } // ABS diff --git a/flang/lib/Optimizer/Analysis/CMakeLists.txt b/flang/lib/Optimizer/Analysis/CMakeLists.txt new file mode 100644 index 0000000000000..2382c48adaf0e --- /dev/null +++ b/flang/lib/Optimizer/Analysis/CMakeLists.txt @@ -0,0 +1,13 @@ +get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) + +add_flang_library(FIRAnalysis + IteratedDominanceFrontier.cpp + + DEPENDS + FIROpsIncGen + ${dialect_libs} + + LINK_LIBS + FIRDialect + FIRSupport +) diff --git a/flang/lib/Optimizer/IteratedDominanceFrontier.cpp b/flang/lib/Optimizer/Analysis/IteratedDominanceFrontier.cpp similarity index 100% rename from flang/lib/Optimizer/IteratedDominanceFrontier.cpp rename to flang/lib/Optimizer/Analysis/IteratedDominanceFrontier.cpp diff --git a/flang/lib/Optimizer/CodeGen/CMakeLists.txt b/flang/lib/Optimizer/CodeGen/CMakeLists.txt new file mode 100644 index 0000000000000..409018e6e81c8 --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/CMakeLists.txt @@ -0,0 +1,13 @@ +get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) + +add_flang_library(FIRCodeGen + CodeGen.cpp + + DEPENDS + FIROpsIncGen + ${dialect_libs} + + LINK_LIBS + FIRDialect + FIRSupport +) diff --git a/flang/lib/Optimizer/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp similarity index 99% rename from flang/lib/Optimizer/CodeGen.cpp rename to flang/lib/Optimizer/CodeGen/CodeGen.cpp index 23c897cfa03be..d44cd76d0018c 100644 --- a/flang/lib/Optimizer/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -1790,7 +1790,8 @@ struct LoadOpConversion : public FIROpConversion { } }; -// FIXME: how do we want to enforce this in LLVM-IR? +// FIXME: how do we want to enforce this in LLVM-IR? Can we manipulate the fast +// math flags? struct NoReassocOpConversion : public FIROpConversion { using FIROpConversion::FIROpConversion; @@ -1798,7 +1799,7 @@ struct NoReassocOpConversion : public FIROpConversion { matchAndRewrite(fir::NoReassocOp noreassoc, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { noreassoc.replaceAllUsesWith(operands[0]); - rewriter.replaceOp(noreassoc, {}); + rewriter.eraseOp(noreassoc); return success(); } }; diff --git a/flang/lib/Optimizer/Transforms/CMakeLists.txt b/flang/lib/Optimizer/Transforms/CMakeLists.txt index 97bfbd98b2c13..4d301784f8dfc 100644 --- a/flang/lib/Optimizer/Transforms/CMakeLists.txt +++ b/flang/lib/Optimizer/Transforms/CMakeLists.txt @@ -1,14 +1,18 @@ -add_llvm_library(FIRTransforms +get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) + +add_flang_library(FIRTransforms + ControlFlowConverter.cpp CSE.cpp MemToReg.cpp + RaiseToAffine.cpp RewriteLoop.cpp -) - -add_dependencies(FIRTransforms FIROpsIncGen) -target_link_libraries(FIRTransforms FIROptimizer) + DEPENDS + FIROpsIncGen + ${dialect_libs} -install (TARGETS FIRTransforms - ARCHIVE DESTINATION lib - LIBRARY DESTINATION lib + LINK_LIBS + FIRAnalysis + FIRDialect + FIRSupport ) diff --git a/flang/lib/Optimizer/StdConverter.cpp b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp similarity index 63% rename from flang/lib/Optimizer/StdConverter.cpp rename to flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp index b478c691617d6..47bdbc9028449 100644 --- a/flang/lib/Optimizer/StdConverter.cpp +++ b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp @@ -1,16 +1,23 @@ -//===-- StdConverter.cpp --------------------------------------------------===// +//===-- ControlFlowConverter.cpp - convert high-level control flow --------===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Convert affine dialect operations to loop/standard dialect operations. +// Also convert the fir.select_type Op to more primitive operations. +// +// TODO: this needs either a deeper understanding of how types will be +// represented by F18 or at least a couple of runtime calls to be completed. +// +//===----------------------------------------------------------------------===// #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Optimizer/Dialect/FIRType.h" -#include "flang/Optimizer/Support/KindMapping.h" #include "flang/Optimizer/Transforms/Passes.h" #include "mlir/Conversion/AffineToStandard/AffineToStandard.h" #include "mlir/Dialect/StandardOps/IR/Ops.h" @@ -19,79 +26,25 @@ #include "mlir/Transforms/DialectConversion.h" #include "llvm/ADT/ArrayRef.h" -// This module performs the conversion of some FIR operations. -// Convert some FIR types to standard dialect? - -static llvm::cl::opt disableFirToStd( - "disable-fir-to-std", - llvm::cl::desc("disable conversion of fir.select_type and affine dialect " - "to the standard dialect pass"), +static llvm::cl::opt disableControlFlowLowering( + "disable-control-flow-lowering", + llvm::cl::desc("disable the pass to convert fir.select_type and affine " + "dialect operations to more primitive operations"), llvm::cl::init(false), llvm::cl::Hidden); -namespace fir { -namespace { - using SmallVecResult = llvm::SmallVector; using OperandTy = llvm::ArrayRef; using AttributeTy = llvm::ArrayRef; +using namespace fir; -/// FIR to standard type converter -/// This converts a subset of FIR types to standard types -class FIRToStdTypeConverter : public mlir::TypeConverter { -public: - using TypeConverter::TypeConverter; - - explicit FIRToStdTypeConverter(KindMapping &map) : kindMap{map} { - addConversion([&](CplxType type) { - return mlir::ComplexType::get(toFloatType(type.getFKind())); - }); - addConversion([&](RealType type) { return toFloatType(type.getFKind()); }); - addConversion([&](IntType type) { return toIntegerType(type.getFKind()); }); - } - -private: - mlir::Type toFloatType(KindTy kind) { - auto *ctx = kindMap.getContext(); - switch (kindMap.getRealTypeID(kind)) { - case llvm::Type::TypeID::HalfTyID: - return mlir::FloatType::getF16(ctx); -#if 0 - // TODO: there is no BF16 type in LLVM yet, so add this when one becomes - // available - case llvm::Type::TypeID:: FIXME TyID: - return mlir::FloatType::getBF16(ctx); -#endif - case llvm::Type::TypeID::FloatTyID: - return mlir::FloatType::getF32(ctx); - case llvm::Type::TypeID::DoubleTyID: - return mlir::FloatType::getF64(ctx); - case llvm::Type::TypeID::X86_FP80TyID: // MLIR does not support yet - [[fallthrough]]; - case llvm::Type::TypeID::FP128TyID: // MLIR does not support yet - [[fallthrough]]; - default: - return RealType::get(ctx, kind); - } - } - - mlir::Type toIntegerType(KindTy kind) { - return mlir::IntegerType::get(kindMap.getIntegerBitsize(kind), - kindMap.getContext()); - } - - // clang++ erroneously complains this variable is unused (see CMakeLists.txt) - KindMapping &kindMap; -}; +namespace { /// FIR conversion pattern template template class FIROpConversion : public mlir::ConversionPattern { public: - explicit FIROpConversion( - mlir::MLIRContext *ctx /*, FIRToStdTypeConverter &lowering*/) - : ConversionPattern(FromOp::getOperationName(), 1, - ctx) /*, lowering(lowering)*/ - {} + explicit FIROpConversion(mlir::MLIRContext *ctx) + : ConversionPattern(FromOp::getOperationName(), 1, ctx) {} static Block *createBlock(mlir::ConversionPatternRewriter &rewriter, Block *insertBefore) { @@ -99,12 +52,6 @@ class FIROpConversion : public mlir::ConversionPattern { return rewriter.createBlock(insertBefore->getParent(), mlir::Region::iterator(insertBefore)); } - -protected: - // mlir::Type convertType(mlir::Type ty) const { return - // lowering.convertType(ty); } - - // FIRToStdTypeConverter &lowering; }; /// SelectTypeOp converted to an if-then-else chain @@ -188,45 +135,30 @@ struct SelectTypeOpConversion : public FIROpConversion { }; /// Convert affine dialect, fir.select_type to standard dialect -class FIRToStdLoweringPass - : public mlir::PassWrapper { +class ControlFlowLoweringPass + : public mlir::PassWrapper { public: - explicit FIRToStdLoweringPass(const KindMapping &kindMap) - : kindMap{kindMap} {} + explicit ControlFlowLoweringPass() {} void runOnFunction() override { - if (disableFirToStd) + if (disableControlFlowLowering) return; - // FIRToStdTypeConverter tyConv{kindMap}; mlir::OwningRewritePatternList patterns; - // patterns.insert(context, tyConv); patterns.insert(&getContext()); mlir::populateAffineToStdConversionPatterns(patterns, &getContext()); - // mlir::populateFuncOpTypeConversionPattern(patterns, context, tyConv); mlir::ConversionTarget target(getContext()); - target.addLegalDialect(); - // target.addDynamicallyLegalOp([&](mlir::FuncOp op) { - // return tyConv.isSignatureLegal(op.getType()); - //}); - target.addIllegalOp(); + target.addIllegalOp(); if (mlir::failed( mlir::applyPartialConversion(getFunction(), target, patterns))) signalPassFailure(); } - - mlir::ModuleOp getModule() { - return getFunction().getParentOfType(); - } - -private: - const KindMapping &kindMap; }; } // namespace -std::unique_ptr createFIRToStdPass(const KindMapping &kindMap) { - return std::make_unique(kindMap); +std::unique_ptr fir::createControlFlowLoweringPass() { + return std::make_unique(); } -} // namespace fir diff --git a/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp b/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp new file mode 100644 index 0000000000000..24513d6143af1 --- /dev/null +++ b/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp @@ -0,0 +1,80 @@ +//===-- RaiseToAffine.cpp -------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Dialect/Affine/IR/AffineOps.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Transforms/DialectConversion.h" +#include "llvm/Support/CommandLine.h" + +/// disable FIR to affine dialect conversion +static llvm::cl::opt + disableAffinePromo("disable-affine-promotion", + llvm::cl::desc("disable FIR to Affine pass"), + llvm::cl::init(false)); + +using namespace fir; + +namespace { + +template +class OpRewrite : public mlir::RewritePattern { +public: + explicit OpRewrite(mlir::MLIRContext *ctx) + : RewritePattern(FROM::getOperationName(), 1, ctx) {} +}; + +/// Convert `fir.loop` to `affine.for` +class AffineLoopConv : public OpRewrite { +public: + using OpRewrite::OpRewrite; +}; + +/// Convert `fir.where` to `affine.if` +class AffineWhereConv : public OpRewrite { +public: + using OpRewrite::OpRewrite; +}; + +/// Promote fir.loop and fir.where to affine.for and affine.if, in the cases +/// where such a promotion is possible. +class AffineDialectPromotion + : public mlir::PassWrapper { +public: + void runOnFunction() override { + if (disableAffinePromo) + return; + + auto *context = &getContext(); + mlir::OwningRewritePatternList patterns; + patterns.insert(context); + mlir::ConversionTarget target = *context; + target.addLegalDialect(); + // target.addDynamicallyLegalOp(); + + // apply the patterns + if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, + std::move(patterns)))) { + mlir::emitError(mlir::UnknownLoc::get(context), + "error in converting to affine dialect\n"); + signalPassFailure(); + } + } +}; + +} // namespace + +/// Convert FIR loop constructs to the Affine dialect +std::unique_ptr fir::createPromoteToAffinePass() { + return std::make_unique(); +} diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 4c316c4338bb4..8b06e13fcd26e 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -10,18 +10,10 @@ #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Transforms/Passes.h" #include "mlir/Dialect/Affine/IR/AffineOps.h" -#include "mlir/Dialect/LoopOps/LoopOps.h" #include "mlir/Dialect/StandardOps/IR/Ops.h" #include "mlir/Pass/Pass.h" #include "mlir/Transforms/DialectConversion.h" #include "llvm/Support/CommandLine.h" -#include - -/// disable FIR to affine dialect conversion -static llvm::cl::opt - disableAffinePromo("disable-affine-promotion", - llvm::cl::desc("disable FIR to Affine pass"), - llvm::cl::init(false)); /// disable FIR to loop dialect conversion static llvm::cl::opt @@ -29,55 +21,9 @@ static llvm::cl::opt llvm::cl::desc("disable FIR to Loop pass"), llvm::cl::init(false)); -namespace fir { -namespace { - -template -class OpRewrite : public mlir::RewritePattern { -public: - explicit OpRewrite(mlir::MLIRContext *ctx) - : RewritePattern(FROM::getOperationName(), 1, ctx) {} -}; - -/// Convert `fir.loop` to `affine.for` -class AffineLoopConv : public OpRewrite { -public: - using OpRewrite::OpRewrite; -}; - -/// Convert `fir.where` to `affine.if` -class AffineWhereConv : public OpRewrite { -public: - using OpRewrite::OpRewrite; -}; - -/// Promote fir.loop and fir.where to affine.for and affine.if, in the cases -/// where such a promotion is possible. -class AffineDialectPromotion - : public mlir::PassWrapper { -public: - void runOnFunction() override { - if (disableAffinePromo) - return; - - auto *context = &getContext(); - mlir::OwningRewritePatternList patterns; - patterns.insert(context); - mlir::ConversionTarget target = *context; - target.addLegalDialect(); - // target.addDynamicallyLegalOp(); +using namespace fir; - // apply the patterns - if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, - std::move(patterns)))) { - mlir::emitError(mlir::UnknownLoc::get(context), - "error in converting to affine dialect\n"); - signalPassFailure(); - } - } -}; +namespace { // Conversion to the MLIR loop dialect // @@ -86,7 +32,7 @@ class AffineDialectPromotion // includes a pass to lower `loop.for` operations to a CFG. /// Convert `fir.loop` to `loop.for` -class LoopLoopConv : public mlir::OpRewritePattern { +class LoopLoopConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -108,7 +54,7 @@ class LoopLoopConv : public mlir::OpRewritePattern { }; /// Convert `fir.where` to `loop.if` -class LoopWhereConv : public mlir::OpRewritePattern { +class LoopWhereConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -132,7 +78,7 @@ class LoopWhereConv : public mlir::OpRewritePattern { }; /// Replace FirEndOp with TerminatorOp -class LoopResultConv : public mlir::OpRewritePattern { +class LoopResultConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -257,12 +203,6 @@ class LoopDialectConversion } }; } // namespace -} // namespace fir - -/// Convert FIR loop constructs to the Affine dialect -std::unique_ptr fir::createPromoteToAffinePass() { - return std::make_unique(); -} /// Convert `fir.loop` and `fir.where` to `loop.for` and `loop.if`. This /// conversion enables the `createLowerToCFGPass` to transform these to CFG diff --git a/flang/test/Examples/hello.f90 b/flang/test/Examples/hello.f90 index 62dff1f1ff232..85341f36eb685 100644 --- a/flang/test/Examples/hello.f90 +++ b/flang/test/Examples/hello.f90 @@ -3,8 +3,10 @@ ! libstdc++.a. To work around the latter, the source of Common/enum-set.h was ! hacked to exclude references to llvm ADTs. ! Note: On linux, the Fortran runtime wants to include libm as well. +! Note: Add pic to the compilation as gcc will use shared libraries by +! default when they are available. -! RUN: bbc %s -o - | tco | llc --filetype=obj -o %t.o +! RUN: bbc %s -o - | tco | llc --relocation-model=pic --filetype=obj -o %t.o ! RUN: %CC -I%S/../.. %S/main.c -c -o %t.main.o ! RUN: %CC %t.o %t.main.o -L%L -lFortranRuntime -lFortranDecimal -lstdc++ -lm ! RUN: ./a.out | FileCheck %s diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index 568db7a317be3..3a86cebce4658 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -107,7 +107,7 @@ subroutine assign_constant(lhs) ! CHECK: } end subroutine -! CHECK-LABEL: fir.global @_QQ48656C6C6F20576F726C64 +! CHECK-LABEL: fir.global @_QQcl.48656C6C6F20576F726C64 ! CHECK: %[[lit:.*]] = fir.string_lit "Hello World"(11) : !fir.char<1> ! CHECK: fir.has_value %[[lit]] : !fir.array<11x!fir.char<1>> ! CHECK: } diff --git a/flang/tools/bbc/CMakeLists.txt b/flang/tools/bbc/CMakeLists.txt index 0398a2cac76ab..fe42de6a239d4 100644 --- a/flang/tools/bbc/CMakeLists.txt +++ b/flang/tools/bbc/CMakeLists.txt @@ -2,8 +2,9 @@ set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-parameter") get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) set(LIBS + FIRAnalysis + FIRCodeGen FIRDialect - FIROptimizer FIRTransforms ${dialect_libs} MLIRLLVMIR diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index cbf18497dede9..5ba52a7a6b69b 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -197,8 +197,9 @@ static void convertFortranSourceToMLIR( // Otherwise run the default passes. mlir::PassManager pm(mlirModule.getContext()); mlir::applyPassManagerCLOptions(pm); + pm.addPass(fir::createPromoteToAffinePass()); pm.addPass(fir::createLowerToLoopPass()); - pm.addPass(fir::createFIRToStdPass(burnside.getKindMap())); + pm.addPass(fir::createControlFlowLoweringPass()); pm.addPass(mlir::createLowerToCFGPass()); // pm.addPass(fir::createMemToRegPass()); pm.addPass(fir::createCSEPass()); From 6698085d835e929fa259b407a905ba3cd01ee5f6 Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Fri, 1 May 2020 11:31:06 -0700 Subject: [PATCH 0016/1017] alternate return test (#42) * alternate return test --- flang/test/Lower/altret.f90 | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 flang/test/Lower/altret.f90 diff --git a/flang/test/Lower/altret.f90 b/flang/test/Lower/altret.f90 new file mode 100644 index 0000000000000..d7c396d0ba506 --- /dev/null +++ b/flang/test/Lower/altret.f90 @@ -0,0 +1,32 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +! CHECK-LABEL: func @_QPk +function k(n1, n2) + ! CHECK-NOT: ^bb + ! CHECK: [[selector:%[0-9]+]] = fir.call @_QPs + ! CHECK-NEXT: fir.select [[selector]] : index [1, ^[[block1:bb[0-9]+]], 2, ^[[block2:bb[0-9]+]], unit, ^[[blockunit:bb[0-9]+]] + call s(n1, *5, n2, *7) + ! CHECK: ^[[blockunit]]: // pred: ^bb0 + k = 0; return; + ! CHECK: ^[[block1]]: // pred: ^bb0 +5 k = -1; return; + ! CHECK: ^[[block2]]: // pred: ^bb0 +7 k = 1; return +end + +! CHECK-LABEL: func @_QPs +subroutine s(n1, *, n2, *) + ! CHECK: [[retval:%[0-9]+]] = fir.alloca index {name = "s"} + ! CHECK-COUNT-3: fir.store {{.*}} to [[retval]] : !fir.ref + if (n1 < n2) return 1 + if (n1 > n2) return 2 + ! CHECK: {{.*}} = fir.load [[retval]] : !fir.ref + ! CHECK-NEXT: return {{.*}} : index + return +end + +! CHECK-LABEL: func @_QQmain + print*, k(10,20) + print*, k(15,15) + print*, k(20,10) +end From 21d2f6c8eeff8d73501829442f34d47030869a52 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 1 May 2020 16:18:16 -0700 Subject: [PATCH 0017/1017] This is a temporary hack to workaround the way we are currently lowering calls. More work is needed here. review suggestions Remove the positive step check. Fortran has decrementing loops. fix typo update the LAPACK issues list Dominance.h moved fix breakage in tests --- flang/LAPACK-bugs.txt | 46 ++++--------------- .../Analysis/IteratedDominanceFrontier.cpp | 2 +- flang/lib/Optimizer/Dialect/FIROps.cpp | 6 +++ flang/lib/Optimizer/Transforms/CSE.cpp | 2 +- flang/lib/Optimizer/Transforms/MemToReg.cpp | 2 +- 5 files changed, 18 insertions(+), 40 deletions(-) diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index 002e174149db5..6ae331d5a6dbd 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -2,6 +2,8 @@ NEED ATTENTION ______________ [Eric] + . ConvertExpr.cpp:193 - function type mismatch + . Bridge.cpp:1322 - array assignment [Varun] @@ -13,42 +15,12 @@ ______________ Intrinsics lowering problems . bbc: Lower/Intrinsics.cpp:763: Assertion `false && "LEN_TRIM TODO"' failed. - -FIXED -_____ +[unassigned] -unexpected character type [xerbla] - -intrinsics: 'fir.convert' op invalid type conversion - -error: 'fir.convert' related to assignments - -error: 'fir.coordinate_of' op cannot find coordinate with unknown extents - -Lowering globals in general - -Handle adjusted arrays of CHARACTER with adjusted LEN - -CHARACTER comparison calls: UNREACHABLE executed at Lower/ConvertExpr.cpp:405! - -UNREACHABLE executed at Lower/ConvertExpr.cpp:798! intrinsic subroutine - -UNREACHABLE executed at Lower/Bridge.cpp:1243! adjustable array - -error: branch has N operands for successor #M, but target block has K - -UNREACHABLE executed at Lower/IO.cpp:764! FORMAT - -UNREACHABLE executed at Lower/ConvertExpr.cpp:848! temps on call? - -Block.cpp:200: mlir::Operation *mlir::Block::getTerminator(): Assertion `!empty() && !back().isKnownNonTerminator()' failed. - -error: 'std.return' op must be the last operation in the parent block - -bbc: Lower/Intrinsics.cpp:504: Assertion `arg != nullptr' failed. - . optional argument in ichar -bbc: Lower/Intrinsics.cpp:628: Assertion `false && "no runtime found for this intrinsics"' failed. - . sign, mod, dble, ichar intrinsic lowering missing -bbc: Lower/Intrinsics.cpp:474: Assertion `!bestMatchDistance.isLoosingPrecision() && "runtime selection looses precision"' failed. - . missing complex abs + . ConvertExpr.cpp:266 - character comparison + . ConvertExpr.cpp:458! - concat CHARs + . ConvertExpr.cpp:711! - Ev::Triplet + . Intrinsics.cpp:613! - nint + . error: unreachable blocks were not converted + . error: 'llvm.mlir.global' op initializer region type '!llvm.i1' does not match global type '!llvm.i32' diff --git a/flang/lib/Optimizer/Analysis/IteratedDominanceFrontier.cpp b/flang/lib/Optimizer/Analysis/IteratedDominanceFrontier.cpp index 9fee2b7314b2d..4a2d6ac9dc3c3 100644 --- a/flang/lib/Optimizer/Analysis/IteratedDominanceFrontier.cpp +++ b/flang/lib/Optimizer/Analysis/IteratedDominanceFrontier.cpp @@ -11,7 +11,7 @@ //===----------------------------------------------------------------------===// #include "flang/Optimizer/Analysis/IteratedDominanceFrontier.h" -#include "mlir/Analysis/Dominance.h" +#include "mlir/IR/Dominance.h" #include "llvm/ADT/DenseMap.h" #include "llvm/ADT/SmallPtrSet.h" #include "llvm/ADT/SmallVector.h" diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp index 38390d8011347..2900e4357f509 100644 --- a/flang/lib/Optimizer/Dialect/FIROps.cpp +++ b/flang/lib/Optimizer/Dialect/FIROps.cpp @@ -23,6 +23,9 @@ #include "llvm/ADT/StringSwitch.h" #include "llvm/ADT/TypeSwitch.h" +namespace { +#include "flang/Optimizer/Transforms/RewritePatterns.inc" +} using namespace fir; /// Return true if a sequence type is of some incomplete size or a record type @@ -399,6 +402,9 @@ mlir::ParseResult fir::parseCmpcOp(mlir::OpAsmParser &parser, void fir::ConvertOp::getCanonicalizationPatterns( OwningRewritePatternList &results, MLIRContext *context) { + results.insert( + context); } mlir::OpFoldResult fir::ConvertOp::fold(llvm::ArrayRef opnds) { diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp index 9c78b03cb360b..0a66e768bc7c5 100644 --- a/flang/lib/Optimizer/Transforms/CSE.cpp +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -14,9 +14,9 @@ #include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Optimizer/Transforms/Passes.h" -#include "mlir/Analysis/Dominance.h" #include "mlir/IR/Attributes.h" #include "mlir/IR/Builders.h" +#include "mlir/IR/Dominance.h" #include "mlir/IR/Function.h" #include "mlir/Interfaces/SideEffects.h" #include "mlir/Pass/Pass.h" diff --git a/flang/lib/Optimizer/Transforms/MemToReg.cpp b/flang/lib/Optimizer/Transforms/MemToReg.cpp index 9020c5a6c690a..264c96c69ba45 100644 --- a/flang/lib/Optimizer/Transforms/MemToReg.cpp +++ b/flang/lib/Optimizer/Transforms/MemToReg.cpp @@ -10,8 +10,8 @@ #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Transforms/Passes.h" -#include "mlir/Analysis/Dominance.h" #include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/IR/Dominance.h" #include "mlir/Pass/Pass.h" #include "llvm/ADT/ArrayRef.h" #include "llvm/ADT/SmallVector.h" From f482f4afb7fc9888da3d3b941c05749e029e48ca Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 5 May 2020 06:14:26 -0700 Subject: [PATCH 0018/1017] Fix power lowering regression and add tests LEN_TRIM inline implementation + make character length index type - Use fir::iter_while operation to provide a scalar implementation of LEN_TRIM that is inlined. It is just a loop that goes from the right most character to the first one and stop as soon as a character is not a blank. - Change getLengthType to return the indexType. It makes loop manipulation of character easier. A few functions that expected i64 for the length are modified to support whatever integer type getLengthType is returning. Conflicts: flang/lib/Lower/FIRBuilder.cpp Conflicts: flang/LAPACK-bugs.txt --- flang/LAPACK-bugs.txt | 4 +- flang/lib/Lower/Intrinsics.cpp | 33 +++++---- flang/test/Lower/character-assignment.f90 | 9 ++- flang/test/Lower/intrinsics.f90 | 27 +++++++- flang/test/Lower/pow.f90 | 81 +++++++++++++++++++++++ 5 files changed, 127 insertions(+), 27 deletions(-) create mode 100644 flang/test/Lower/pow.f90 diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index 6ae331d5a6dbd..89e6c53ede83e 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -12,8 +12,6 @@ ______________ [Jean] - Intrinsics lowering problems - . bbc: Lower/Intrinsics.cpp:763: Assertion `false && "LEN_TRIM TODO"' failed. [unassigned] @@ -24,3 +22,5 @@ ______________ . error: unreachable blocks were not converted . error: 'llvm.mlir.global' op initializer region type '!llvm.i1' does not match global type '!llvm.i32' +bbc: Missing LEN_TRIM lowering + diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index 368763d8432c1..56b8ec8038110 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -194,7 +194,7 @@ enum MathRuntimeVersion { llvmOnly }; llvm::cl::opt mathRuntimeVersion( - "math_runtime", llvm::cl::desc("Select math runtime version:"), + "math-runtime", llvm::cl::desc("Select math runtime version:"), llvm::cl::values( clEnumValN(fastVersion, "fast", "use pgmath fast runtime"), clEnumValN(relaxedVersion, "relaxed", "use pgmath relaxed runtime"), @@ -278,17 +278,20 @@ class FunctionDistance { if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) { infinite = true; } else { - for (decltype(nInputs) i{0}; i < nInputs; ++i) + for (decltype(nInputs) i{0}; i < nInputs && !infinite; ++i) addArgumentDistance(from.getInput(i), to.getInput(i)); - for (decltype(nResults) i{0}; i < nResults; ++i) + for (decltype(nResults) i{0}; i < nResults && !infinite; ++i) addResultDistance(to.getResult(i), from.getResult(i)); } } + /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be + /// false if both d1 and d2 are infinite. This implies that + /// d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1) bool isSmallerThan(const FunctionDistance &d) const { - return d.infinite || - (!infinite && std::lexicographical_compare( - conversions.begin(), conversions.end(), - d.conversions.begin(), d.conversions.end())); + return !infinite && + (d.infinite || std::lexicographical_compare( + conversions.begin(), conversions.end(), + d.conversions.begin(), d.conversions.end())); } bool isLosingPrecision() const { return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0; @@ -589,8 +592,7 @@ mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name, for (mlir::Value arg : args) { auto actualType = actualFuncType.getInput(i); if (soughtFuncType.getInput(i) != actualType) { - auto castedArg = - builder.convertOnAssign(builder.getLoc(), actualType, arg); + auto castedArg = builder.createHere(actualType, arg); convertedArguments.push_back(castedArg); } else { convertedArguments.push_back(arg); @@ -601,8 +603,7 @@ mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name, mlir::Type soughtType = soughtFuncType.getResult(0); mlir::Value res = call.getResult(0); if (actualFuncType.getResult(0) != soughtType) { - auto castedRes = - builder.convertOnAssign(builder.getLoc(), soughtType, res); + auto castedRes = builder.createHere(soughtType, res); return castedRes; } else { return res; @@ -702,14 +703,12 @@ mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, } // LEN_TRIM -mlir::Value IntrinsicLibrary::genLenTrim(mlir::Type, +mlir::Value IntrinsicLibrary::genLenTrim(mlir::Type resultType, llvm::ArrayRef args) { // Optional KIND argument reflected in result type. assert(args.size() >= 1); - // FIXME: LEN_TRIM needs actual runtime and to be define in CharRT.h - llvm_unreachable("LEN_TRIM TODO"); - // Fake implementation for debugging: - // return builder.createIntegerConstant(resultType, 0); + auto len = builder.createLenTrim(args[0]); + return builder.createHere(resultType, len); } // MERGE @@ -799,7 +798,7 @@ static mlir::Value createExtremumCompare(Fortran::lower::FirOpBuilder &builder, static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum, "ieeeMinNum/ieeeMaxNum behavior not implemented"); } - } else if (type.isa()) { + } else if (type.isa() || type.isa()) { result = builder.createHere(integerPredicate, left, right); } else if (type.isa()) { // TODO: ! character min and max is tricky because the result diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index 3a86cebce4658..a68b7aadd0e7b 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -15,10 +15,9 @@ subroutine assign1(lhs, rhs) ! CHECK: %[[cmp_len:[0-9]+]] = cmpi "slt", %[[lhs:.*]]#1, %[[rhs:.*]]#1 ! CHECK-NEXT: %[[min_len:[0-9]+]] = select %[[cmp_len]], %[[lhs]]#1, %[[rhs]]#1 - ! CHECK-NEXT: %[[minIdxLen:.*]] = fir.convert %[[min_len]] ! Allocate temp in case rhs and lhs may overlap - ! CHECK: %[[tmp:.*]] = fir.alloca !fir.char<1>, %[[minIdxLen]] + ! CHECK: %[[tmp:.*]] = fir.alloca !fir.char<1>, %[[min_len]] ! Copy of rhs into temp ! CHECK: fir.do_loop %[[i:.*]] = @@ -63,13 +62,13 @@ subroutine assign_substring1(str, rhs, lb, ub) ! Compute substring length - ! CHECK-DAG: %[[diff:.*]] = subi %[[ub]], %[[lb]] - ! CHECK-DAG: %[[c1:.*]] = constant 1 + ! CHECK-DAG: %[[ubi:.*]] = fir.convert %[[ub]] : (i64) -> index + ! CHECK-DAG: %[[diff:.*]] = subi %[[ubi]], %[[lbi]] ! CHECK-DAG: %[[pre_lhs_len:.*]] = addi %[[diff]], %[[c1]] ! CHECK-DAG: %[[c0:.*]] = constant 0 ! CHECK-DAG: %[[cmp_len:.*]] = cmpi "slt", %[[pre_lhs_len]], %[[c0]] - ! CHECK-DAG: %[[lhs_len:.*]] = select %[[cmp_len]], %[[c0]], %[[pre_lhs_len]] + ! CHECK-DAG: %[[lhs_len:.*]] = select %[[cmp_len]], %[[c0]], %[[pre_lhs_len]] ! CHECK: %[[lhs_box:.*]] = fir.emboxchar %[[lhs_addr]], %[[lhs_len]] ! The rest of the assignment is just as the one above, only test that the diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index ef13311d05a16..41f28dc1b380d 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -1,4 +1,4 @@ -! RUN: bbc %s -o - | FileCheck %s +! RUN: bbc -emit-fir %s -o - | FileCheck %s ! ABS ! CHECK-LABEL: abs_testi @@ -48,9 +48,9 @@ subroutine dble_test(a) ! CHECK-LABEL: conjg_test subroutine conjg_test(z1, z2) complex :: z1, z2 - ! CHECK: fir.extract_value + ! CHECK: fir.extract_value ! CHECK: fir.negf - ! CHECK: fir.insert_value + ! CHECK: fir.insert_value z2 = conjg(z1) end subroutine @@ -71,6 +71,27 @@ subroutine len_test(i, c) i = len(c) end subroutine +! LEN_TRIM +!CHECK-LABEL: len_trim_test +integer function len_trim_test(c) + character(*) :: c + ltrim = len_trim(c) + ! CHECK-DAG: %[[c0:.*]] = constant 0 : index + ! CHECK-DAG: %[[c1:.*]] = constant 1 : index + ! CHECK-DAG: %[[cm1:.*]] = constant -1 : index + ! CHECK-DAG: %[[lastChar:.*]] = subi {{.*}}, %[[c1]] + ! CHECK: %[[iterateResult:.*]], %[[lastIndex:.*]] = fir.iterate_while (%[[index:.*]] = %[[lastChar]] to %[[c0]] step %[[cm1]]) and ({{.*}}) iter_args({{.*}}) { + ! CHECK: %[[addr:.*]] = fir.coordinate_of {{.*}}, %[[index]] + ! CHECK: %[[char:.*]] = fir.load %[[addr]] + ! CHECK: %[[code:.*]] = fir.convert %[[char]] + ! CHECK: %[[bool:.*]] = cmpi "eq" + !CHECK fir.result %[[bool]], %[[index]] + ! CHECK } + ! CHECK-DAG: %[[len:.*]] = addi %[[lastIndex]], %[[c1]] + ! CHECK: select %[[iterateResult]], %[[c0]], %[[len]] +end function + + ! SIGN ! CHECK-LABEL: sign_testi diff --git a/flang/test/Lower/pow.f90 b/flang/test/Lower/pow.f90 new file mode 100644 index 0000000000000..6c562b63efdf6 --- /dev/null +++ b/flang/test/Lower/pow.f90 @@ -0,0 +1,81 @@ +! RUN: bbc -emit-fir %s -o - -math-runtime=fast | FileCheck %s + +! Test power operation lowering + +! CHECK-LABEL: pow_r4_i4 +subroutine pow_r4_i4(x, y, z) + real :: x, z + integer :: y + z = x ** y + ! CHECK: call @__fs_powi_1 +end subroutine + +! CHECK-LABEL: pow_r4_i8 +subroutine pow_r4_i8(x, y, z) + real :: x, z + integer(8) :: y + z = x ** y + ! CHECK: call @__fs_powk_1 +end subroutine + +! CHECK-LABEL: pow_r8_i4 +subroutine pow_r8_i4(x, y, z) + real(8) :: x, z + integer :: y + z = x ** y + ! CHECK: call @__fd_powi_1 +end subroutine + +! CHECK-LABEL: pow_r8_i8 +subroutine pow_r8_i8(x, y, z) + real(8) :: x, z + integer(8) :: y + z = x ** y + ! CHECK: call @__fd_powk_1 +end subroutine + +! CHECK-LABEL: pow_i4_i4 +subroutine pow_i4_i4(x, y, z) + integer(4) :: x, y, z + z = x ** y + ! CHECK: call @__mth_i_ipowi +end subroutine + +! CHECK-LABEL: pow_i8_i8 +subroutine pow_i8_i8(x, y, z) + integer(8) :: x, y, z + z = x ** y + ! CHECK: call @__mth_i_kpowk +end subroutine + +! CHECK-LABEL: pow_c4_i4 +subroutine pow_c4_i4(x, y, z) + complex :: x, z + integer :: y + z = x ** y + ! CHECK: call @__fc_powi_1 +end subroutine + +! CHECK-LABEL: pow_c4_i8 +subroutine pow_c4_i8(x, y, z) + complex :: x, z + integer(8) :: y + z = x ** y + ! CHECK: call @__fc_powk_1 +end subroutine + +! CHECK-LABEL: pow_c8_i4 +subroutine pow_c8_i4(x, y, z) + complex(8) :: x, z + integer :: y + z = x ** y + ! CHECK: call @__fz_powi_1 +end subroutine + +! CHECK-LABEL: pow_c8_i8 +subroutine pow_c8_i8(x, y, z) + complex(8) :: x, z + integer(8) :: y + z = x ** y + ! CHECK: call @__fz_powk_1 +end subroutine From c670c94c4e87a0e8781d1289cb1b36191e06f3a5 Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 6 May 2020 11:54:05 -0700 Subject: [PATCH 0019/1017] update the list To improve build times, lop off the f18 tool's dependence on Lowering. Moved the functionality to bbc, added some option support, and am able to run 3 of the 4 tests. Marked the last as expected fail. Conflicts: flang/tools/f18/CMakeLists.txt Remove raw_ostream references from Decimal --- flang/LAPACK-bugs.txt | 11 ++++++++--- flang/lib/Decimal/binary-to-decimal.cpp | 3 +++ flang/test/Lower/pre-fir-tree01.f90 | 2 +- flang/test/Lower/pre-fir-tree02.f90 | 2 +- flang/test/Lower/pre-fir-tree03.f90 | 2 +- flang/test/Lower/pre-fir-tree04.f90 | 2 +- flang/tools/bbc/bbc.cpp | 21 +++++++++++++++++++++ flang/tools/f18/CMakeLists.txt | 2 +- flang/tools/f18/f18.cpp | 12 ------------ 9 files changed, 37 insertions(+), 20 deletions(-) diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index 89e6c53ede83e..4248857d9d663 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -7,20 +7,25 @@ ______________ [Varun] - DATA statement + . DATA statement loc("lapack/BLAS/SRC/srotmg.f":116:7): error: DATA statement is not handled. + . error: 'llvm.mlir.global' op initializer region type '!llvm.i1' does not match global type '!llvm.i32' [Jean] + . have lowering call the runtime STOP function (instead of the dummy standin) + . Intrinsics.cpp:613! - nint + [unassigned] . ConvertExpr.cpp:266 - character comparison . ConvertExpr.cpp:458! - concat CHARs . ConvertExpr.cpp:711! - Ev::Triplet - . Intrinsics.cpp:613! - nint . error: unreachable blocks were not converted - . error: 'llvm.mlir.global' op initializer region type '!llvm.i1' does not match global type '!llvm.i32' + +FIXED +_____ bbc: Missing LEN_TRIM lowering diff --git a/flang/lib/Decimal/binary-to-decimal.cpp b/flang/lib/Decimal/binary-to-decimal.cpp index e124135607762..0c6a4d1fa2b40 100644 --- a/flang/lib/Decimal/binary-to-decimal.cpp +++ b/flang/lib/Decimal/binary-to-decimal.cpp @@ -405,6 +405,7 @@ ConversionToDecimalResult ConvertLongDoubleToDecimal(char *buffer, #endif } +#if 0 template template STREAM &BigRadixFloatingPointNumber::Dump(STREAM &o) const { @@ -422,4 +423,6 @@ STREAM &BigRadixFloatingPointNumber::Dump(STREAM &o) const { } return o; } +#endif + } // namespace Fortran::decimal diff --git a/flang/test/Lower/pre-fir-tree01.f90 b/flang/test/Lower/pre-fir-tree01.f90 index 707dbc1a86b5b..c48611441499f 100644 --- a/flang/test/Lower/pre-fir-tree01.f90 +++ b/flang/test/Lower/pre-fir-tree01.f90 @@ -1,4 +1,4 @@ -! RUN: %flang_fc1 -fsyntax-only -fdebug-pre-fir-tree %s | FileCheck %s +! RUN: bbc -pft-test -o %t %s | FileCheck %s ! Test structure of the Pre-FIR tree diff --git a/flang/test/Lower/pre-fir-tree02.f90 b/flang/test/Lower/pre-fir-tree02.f90 index 6f64b60b23ef5..6dfaf858faaae 100644 --- a/flang/test/Lower/pre-fir-tree02.f90 +++ b/flang/test/Lower/pre-fir-tree02.f90 @@ -1,4 +1,4 @@ -! RUN: %flang_fc1 -fsyntax-only -fdebug-pre-fir-tree %s | FileCheck %s +! RUN: bbc -pft-test -o %t %s | FileCheck %s ! Test Pre-FIR Tree captures all the intended nodes from the parse-tree ! Coarray and OpenMP related nodes are tested in other files. diff --git a/flang/test/Lower/pre-fir-tree03.f90 b/flang/test/Lower/pre-fir-tree03.f90 index 19cf098320920..297ce4a2e0d20 100644 --- a/flang/test/Lower/pre-fir-tree03.f90 +++ b/flang/test/Lower/pre-fir-tree03.f90 @@ -1,4 +1,4 @@ -! RUN: %flang_fc1 -fsyntax-only -fdebug-pre-fir-tree -fopenmp %s | FileCheck %s +! RUN: bbc -pft-test -fopenmp -o %t %s | FileCheck %s ! Test Pre-FIR Tree captures OpenMP related constructs diff --git a/flang/test/Lower/pre-fir-tree04.f90 b/flang/test/Lower/pre-fir-tree04.f90 index 55b0cb12a2278..3cebb317a2df2 100644 --- a/flang/test/Lower/pre-fir-tree04.f90 +++ b/flang/test/Lower/pre-fir-tree04.f90 @@ -1,4 +1,4 @@ -! RUN: %flang_fc1 -fsyntax-only -fdebug-pre-fir-tree %s | FileCheck %s +! RUN: bbc -I %moddir -pft-test -o %t %s | FileCheck %s ! Test Pre-FIR Tree captures all the coarray related statements diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 5ba52a7a6b69b..00a4e336ff68f 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -15,6 +15,7 @@ #include "flang/Common/default-kinds.h" #include "flang/Lower/Bridge.h" #include "flang/Lower/ConvertExpr.h" +#include "flang/Lower/PFTBuilder.h" #include "flang/Optimizer/CodeGen/CodeGen.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Support/InternalNames.h" @@ -97,6 +98,10 @@ static llvm::cl::opt dumpSymbols("dump-symbols", llvm::cl::desc("dump the symbol table"), llvm::cl::init(false)); +static llvm::cl::opt pftDumpTest("pft-test", llvm::cl::desc("parse the input, create a PFT, dump it, and exit"), llvm::cl::init(false)); + +static llvm::cl::opt enableOpenMP("fopenmp", llvm::cl::desc("enable openmp"), llvm::cl::init(false)); + //===----------------------------------------------------------------------===// namespace { @@ -130,6 +135,12 @@ static void convertFortranSourceToMLIR( } } + // enable parsing of OpenMP + if (enableOpenMP) { + options.features.Enable(Fortran::common::LanguageFeature::OpenMP); + options.predefinitions.emplace_back("_OPENMP", "201511"); + } + // prep for prescan and parse options.searchDirectories = includeDirs; Fortran::parser::Parsing parsing{semanticsContext.allSources()}; @@ -172,6 +183,16 @@ static void convertFortranSourceToMLIR( } if (dumpSymbols) semantics.DumpSymbols(llvm::outs()); + + if (pftDumpTest) { + if (auto ast{Fortran::lower::createPFT(parseTree, semanticsContext)}) { + Fortran::lower::dumpPFT(llvm::outs(), *ast); + } else { + llvm::errs() << "Pre FIR Tree is NULL.\n"; + exitStatus = EXIT_FAILURE; + } + return; + } // MLIR+FIR fir::NameUniquer nameUniquer; diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt index e7ecd957ad79e..0233739170f4f 100644 --- a/flang/tools/f18/CMakeLists.txt +++ b/flang/tools/f18/CMakeLists.txt @@ -17,7 +17,7 @@ target_link_libraries(f18 FortranParser FortranEvaluate FortranSemantics - FortranLower + LLVMSupport ) set(MODULES diff --git a/flang/tools/f18/f18.cpp b/flang/tools/f18/f18.cpp index f77dd7e9cbf3d..f45b4ceaf56b7 100644 --- a/flang/tools/f18/f18.cpp +++ b/flang/tools/f18/f18.cpp @@ -11,7 +11,6 @@ #include "flang/Common/Fortran-features.h" #include "flang/Common/default-kinds.h" #include "flang/Evaluate/expression.h" -#include "flang/Lower/PFTBuilder.h" #include "flang/Parser/characters.h" #include "flang/Parser/dump-parse-tree.h" #include "flang/Parser/message.h" @@ -99,7 +98,6 @@ struct DriverOptions { bool dumpUnparse{false}; bool dumpUnparseWithSymbols{false}; bool dumpParseTree{false}; - bool dumpPreFirTree{false}; bool dumpSymbols{false}; bool debugNoSemantics{false}; bool debugModuleWriter{false}; @@ -325,14 +323,6 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options, nullptr /* action before each statement */, &asFortran); return {}; } - if (driver.dumpPreFirTree) { - if (auto ast{Fortran::lower::createPFT(parseTree, semanticsContext)}) { - Fortran::lower::dumpPFT(llvm::outs(), *ast); - } else { - llvm::errs() << "Pre FIR Tree is NULL.\n"; - exitStatus = EXIT_FAILURE; - } - } if (driver.syntaxOnly) { return {}; } @@ -552,8 +542,6 @@ int main(int argc, char *const argv[]) { } else if (arg == "-fdebug-dump-parse-tree") { driver.dumpParseTree = true; driver.syntaxOnly = true; - } else if (arg == "-fdebug-pre-fir-tree") { - driver.dumpPreFirTree = true; } else if (arg == "-fdebug-dump-symbols") { driver.dumpSymbols = true; driver.syntaxOnly = true; From 4b8a1081f3861c6f960ee8ea3c325fd735390e49 Mon Sep 17 00:00:00 2001 From: Varun Jayathirtha Date: Fri, 24 Apr 2020 14:23:03 -0700 Subject: [PATCH 0020/1017] Instantiate global single dimensional array values. Add global array initializers test --- flang/lib/Lower/Bridge.cpp | 20 ++++++++------------ flang/test/Lower/global-init.f90 | 11 ++++++++++- 2 files changed, 18 insertions(+), 13 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 9dc6887479b25..00e9f2d69bd14 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1621,19 +1621,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (const auto *details = sym.detailsIf()) { if (details->init()) { - if (details->IsArray()) { - TODO(); - return; - } else if (!sym.GetType()->AsIntrinsic()) { + if (!sym.GetType()->AsIntrinsic()) { TODO(); // Derived type / polymorphic - return; - } else - global = builder->createGlobal( - toLocation(), genType(sym), globalName, isConst, - [&](Fortran::lower::FirOpBuilder &builder) { - auto initVal = genExprValue(details->init().value()); - builder.create(toLocation(), initVal); - }); + } + global = builder->createGlobal( + toLocation(), genType(sym), globalName, isConst, + [&](Fortran::lower::FirOpBuilder &builder) { + auto initVal = genExprValue(details->init().value()); + builder.create(toLocation(), initVal); + }); } else { global = builder->createGlobal(toLocation(), genType(sym), globalName); } diff --git a/flang/test/Lower/global-init.f90 b/flang/test/Lower/global-init.f90 index 6f13e72e777b8..812a0a080d7c4 100755 --- a/flang/test/Lower/global-init.f90 +++ b/flang/test/Lower/global-init.f90 @@ -5,7 +5,6 @@ program bar ! CHECK: fir.global @[[name1]] integer, save :: my_data = 1 print *, my_data -call foo contains subroutine foo() ! CHECK: fir.address_of(@[[name2:.*foo.*my_data]]) @@ -20,4 +19,14 @@ subroutine foo2() my_data = 4 print *, my_data end subroutine +subroutine foo3() +! CHECK: fir.address_of(@[[name4:.*foo3.*idata]]){{.*}}fir.array<5xi32> +! CHECK: fir.address_of(@[[name5:.*foo3.*rdata]]){{.*}}fir.array<3xf16> +! CHECK: fir.global @[[name4]]{{.*}}fir.array<5xi32> +! CHECK: fir.global @[[name5]]{{.*}}fir.array<3xf16> + integer*4, dimension(5), save :: idata = (/ (i*i, i=1,5) /) + real*2, dimension(7:9), save :: rdata = (/100., 99., 98./) + print *, rdata(9) + print *, idata(3) +end subroutine end program From eab7534d4fbd89072b71f30e2917851807dbdde0 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 7 May 2020 12:42:44 -0700 Subject: [PATCH 0021/1017] add the missing directory path to test 4 move towards making conversions more formal in the bridge Removes some old aliases. Use the long names. rename function --- flang/lib/Lower/Bridge.cpp | 54 ++++++++++++++++---------------- flang/lib/Lower/CharRT.cpp | 8 ++--- flang/lib/Lower/Intrinsics.cpp | 7 ++--- flang/test/Lower/global-init.f90 | 0 flang/test/lit.cfg.py | 1 + 5 files changed, 34 insertions(+), 36 deletions(-) mode change 100755 => 100644 flang/test/Lower/global-init.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 00e9f2d69bd14..723a674846b20 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -408,14 +408,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { } bool isNumericScalarCategory(Fortran::common::TypeCategory cat) { - return cat == Fortran::lower::IntegerCat || - cat == Fortran::lower::RealCat || - cat == Fortran::lower::ComplexCat || - cat == Fortran::lower::LogicalCat; + return cat == Fortran::common::TypeCategory::Integer || + cat == Fortran::common::TypeCategory::Real || + cat == Fortran::common::TypeCategory::Complex || + cat == Fortran::common::TypeCategory::Logical; } bool isCharacterCategory(Fortran::common::TypeCategory cat) { - return cat == Fortran::lower::CharacterCat; + return cat == Fortran::common::TypeCategory::Character; } mlir::Block *blockOfLabel(Fortran::lower::pft::Evaluation &eval, @@ -437,7 +437,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIRConditionalBranch(mlir::Value &cond, mlir::Block *trueTarget, mlir::Block *falseTarget) { auto loc = toLocation(); - auto bcc = builder->create(loc, builder->getI1Type(), cond); + auto bcc = builder->createConvert(loc, builder->getI1Type(), cond); builder->create(loc, bcc, trueTarget, llvm::None, falseTarget, llvm::None); } @@ -513,8 +513,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { genWhereCondition(const A *stmt, bool withElse = true) { auto cond = genExprValue(*Fortran::semantics::GetExpr( std::get(stmt->t))); - auto bcc = builder->create(toLocation(), - builder->getI1Type(), cond); + auto bcc = builder->createConvert(toLocation(), builder->getI1Type(), cond); auto where = builder->create(toLocation(), bcc, withElse); auto insPt = builder->saveInsertionPoint(); builder->setInsertionPointToStart(&where.whereRegion().front()); @@ -524,7 +523,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Value genFIRLoopIndex(const Fortran::parser::ScalarExpr &x, mlir::Type t) { mlir::Value v = genExprValue(*Fortran::semantics::GetExpr(x)); - return builder->create(toLocation(), t, v); + return builder->createConvert(toLocation(), t, v); } mlir::FuncOp getFunc(llvm::StringRef name, mlir::FunctionType ty) { @@ -818,8 +817,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->setInsertionPointToStart(info.doLoop.getBody()); // Always store iteration ssa-value to the LCV to avoid missing any // aliasing of the LCV. - auto lcv = builder->create( - location, info.loopVariableType, info.doLoop.getInductionVar()); + auto lcv = builder->createConvert(location, info.loopVariableType, + info.doLoop.getInductionVar()); builder->create(location, lcv, info.loopVariable); return; } @@ -1038,10 +1037,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto addValue = [&](const CaseValue &caseValue) { const auto *expr = Fortran::semantics::GetExpr(caseValue.thing); const auto v = Fortran::evaluate::ToInt64(*expr); - valueList.push_back( - v ? builder->createIntegerConstant(selectType, *v) - : builder->create(toLocation(), selectType, - genExprValue(*expr))); + valueList.push_back(v ? builder->createIntegerConstant(selectType, *v) + : builder->createConvert(toLocation(), selectType, + genExprValue(*expr))); }; for (Fortran::lower::pft::Evaluation *e = eval.controlSuccessor; e; e = e->controlSuccessor) { @@ -1240,8 +1238,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto idxTy = mlir::IndexType::get(&mlirContext); auto zero = builder->create( toLocation(), idxTy, builder->getIntegerAttr(idxTy, 0)); - auto cast = - builder->create(toLocation(), ty, zero); + auto cast = builder->createConvert(toLocation(), ty, zero); builder->create(toLocation(), cast, load); }, [&](const Fortran::parser::StructureComponent &) { TODO(); }, @@ -1308,12 +1305,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto val = genExprValue(assignment.rhs); auto addr = genExprValue(assignment.lhs); auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); - auto cast = builder->convertOnAssign(toLocation(), toTy, val); + auto cast = + builder->convertWithSemantics(toLocation(), toTy, val); builder->create(toLocation(), cast, addr); } else if (isCharacterCategory(lhsType->category())) { TODO(); } else { - assert(lhsType->category() == Fortran::lower::DerivedCat); + assert(lhsType->category() == + Fortran::common::TypeCategory::Derived); TODO(); } } else if (assignment.lhs.Rank() > 0) { @@ -1333,7 +1332,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto addr = genExprAddr(assignment.lhs); auto val = genExprValue(assignment.rhs); auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); - auto cast = builder->convertOnAssign(loc, toTy, val); + auto cast = builder->convertWithSemantics(loc, toTy, val); builder->create(loc, cast, addr); } else if (isCharacterCategory(lhsType->category())) { // Fortran 2018 10.2.1.3 p10 and p11 @@ -1342,7 +1341,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto rhs{genExprValue(assignment.rhs)}; builder->createAssign(lhs, rhs); } else { - assert(lhsType->category() == Fortran::lower::DerivedCat); + assert(lhsType->category() == + Fortran::common::TypeCategory::Derived); // Fortran 2018 10.2.1.3 p12 and p13 TODO(); } @@ -1473,8 +1473,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Alternate return statement -- assign alternate return index. auto expr = Fortran::semantics::GetExpr(*stmt.v); assert(expr && "missing alternate return expression"); - auto altReturnIndex = builder->createHere( - builder->getIndexType(), genExprValue(*expr)); + auto altReturnIndex = builder->createConvert( + toLocation(), builder->getIndexType(), genExprValue(*expr)); builder->create(toLocation(), altReturnIndex, getAltReturnResult(*funit)); } @@ -1744,7 +1744,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // object shape is constant auto castTy = fir::ReferenceType::get(genType(sym)); if (addr) - addr = builder->create(loc, castTy, addr); + addr = builder->createConvert(loc, castTy, addr); if (sia.lboundIsAllOnes()) { // if lower bounds are all ones, build simple shaped object llvm::SmallVector shape; @@ -1776,9 +1776,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { // XXX: special handling for boxchar; see proviso above if (auto box = dyn_cast_or_null(addr.getDefiningOp())) - addr = builder->create(loc, castTy, box.memref()); + addr = builder->createConvert(loc, castTy, box.memref()); else - addr = builder->create(loc, castTy, addr); + addr = builder->createConvert(loc, castTy, addr); } } // construct constants and populate `bounds` @@ -1800,7 +1800,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto diff = builder->create(loc, ty, ub, lb); auto one = builder->createIntegerConstant(ty, 1); auto sz = builder->create(loc, ty, diff, one); - auto idx = builder->create(loc, idxTy, sz); + auto idx = builder->createConvert(loc, idxTy, sz); bounds.emplace_back(lb, idx); continue; } diff --git a/flang/lib/Lower/CharRT.cpp b/flang/lib/Lower/CharRT.cpp index 0b8475754ebfc..c6b1c976cf28b 100644 --- a/flang/lib/Lower/CharRT.cpp +++ b/flang/lib/Lower/CharRT.cpp @@ -107,10 +107,10 @@ Fortran::lower::genRawCharCompare(Fortran::lower::AbstractConverter &converter, llvm_unreachable("runtime does not support CHARACTER KIND"); } auto fTy = beginFunc.getType(); - auto lptr = builder.create(loc, fTy.getInput(0), lhsBuff); - auto llen = builder.create(loc, fTy.getInput(2), lhsLen); - auto rptr = builder.create(loc, fTy.getInput(1), rhsBuff); - auto rlen = builder.create(loc, fTy.getInput(3), rhsLen); + auto lptr = builder.createConvert(loc, fTy.getInput(0), lhsBuff); + auto llen = builder.createConvert(loc, fTy.getInput(2), lhsLen); + auto rptr = builder.createConvert(loc, fTy.getInput(1), rhsBuff); + auto rlen = builder.createConvert(loc, fTy.getInput(3), rhsLen); llvm::SmallVector args = {lptr, rptr, llen, rlen}; auto tri = builder.create(loc, beginFunc, args).getResult(0); auto zero = builder.createIntegerConstant(tri.getType(), 0); diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index 56b8ec8038110..7b198341b5e83 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -610,10 +610,7 @@ mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name, } } else { // could not find runtime function - llvm::errs() << "missing intrinsic: " << name << "\n"; - llvm_unreachable("no runtime found for this intrinsics"); - // TODO: better error handling ? - // - Try to have compile time check of runtime completeness ? + llvm::report_fatal_error("missing intrinsic: " + llvm::Twine(name) + "\n"); } return {}; // gets rid of warnings } @@ -622,7 +619,7 @@ mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType, llvm::ArrayRef args) { // There can be an optional kind in second argument. assert(args.size() >= 1); - return builder.convertOnAssign(builder.getLoc(), resultType, args[0]); + return builder.convertWithSemantics(builder.getLoc(), resultType, args[0]); } // ABS diff --git a/flang/test/Lower/global-init.f90 b/flang/test/Lower/global-init.f90 old mode 100755 new mode 100644 diff --git a/flang/test/lit.cfg.py b/flang/test/lit.cfg.py index 3e22db86de218..f9aafed1e832f 100644 --- a/flang/test/lit.cfg.py +++ b/flang/test/lit.cfg.py @@ -75,6 +75,7 @@ config.substitutions.append(('%B', config.flang_obj_root)) config.substitutions.append(("%L", config.flang_lib_dir)) +config.substitutions.append(("%moddir", config.flang_intrinsic_modules_dir)) if len(config.macos_sysroot) > 0: config.substitutions.append(("%CXX", config.cplusplus_executable + " -isysroot " + config.macos_sysroot)) config.substitutions.append(("%CC", config.c_executable + " -isysroot " + config.macos_sysroot)) From 71b49d48a8866dfaf93f44de4945101d77657469 Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Fri, 8 May 2020 11:21:14 -0700 Subject: [PATCH 0022/1017] I/O condition specifier branching (#53) * I/O condition specifier branching * review update --- flang/lib/Lower/Bridge.cpp | 93 ++++++++++++++++--- .../test/Lower/{io-stmt.f90 => io-stmt01.f90} | 0 flang/test/Lower/io-stmt02.f90 | 25 +++++ 3 files changed, 103 insertions(+), 15 deletions(-) rename flang/test/Lower/{io-stmt.f90 => io-stmt01.f90} (100%) create mode 100644 flang/test/Lower/io-stmt02.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 723a674846b20..2c70ba8b98be8 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -7,6 +7,7 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/Bridge.h" +#include "../../runtime/iostat.h" #include "SymbolMap.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertType.h" @@ -578,10 +579,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->restoreInsertionPoint(pair.first); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::WaitStmt &stmt) { - genWaitStatement(*this, stmt); - } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::WhereStmt &) { TODO(); @@ -1166,27 +1163,35 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::BackspaceStmt &stmt) { - genBackspaceStatement(*this, stmt); + auto iostat = genBackspaceStatement(*this, stmt); + genIoConditionBranches(eval, stmt.v, iostat); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::CloseStmt &stmt) { - genCloseStatement(*this, stmt); + auto iostat = genCloseStatement(*this, stmt); + genIoConditionBranches(eval, stmt.v, iostat); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::EndfileStmt &stmt) { - genEndfileStatement(*this, stmt); + auto iostat = genEndfileStatement(*this, stmt); + genIoConditionBranches(eval, stmt.v, iostat); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::FlushStmt &stmt) { - genFlushStatement(*this, stmt); + auto iostat = genFlushStatement(*this, stmt); + genIoConditionBranches(eval, stmt.v, iostat); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::InquireStmt &stmt) { - genInquireStatement(*this, stmt); + auto iostat = genInquireStatement(*this, stmt); + genIoConditionBranches( + eval, std::get>(stmt.u), + iostat); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenStmt &stmt) { - genOpenStatement(*this, stmt); + auto iostat = genOpenStatement(*this, stmt); + genIoConditionBranches(eval, stmt.v, iostat); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::PrintStmt &stmt) { @@ -1195,17 +1200,75 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::ReadStmt &stmt) { - genReadStatement(*this, stmt, - eval.getOwningProcedure()->labelEvaluationMap); + auto iostat = genReadStatement( + *this, stmt, eval.getOwningProcedure()->labelEvaluationMap); + genIoConditionBranches(eval, stmt.controls, iostat); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::RewindStmt &stmt) { - genRewindStatement(*this, stmt); + auto iostat = genRewindStatement(*this, stmt); + genIoConditionBranches(eval, stmt.v, iostat); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WaitStmt &stmt) { + auto iostat = genWaitStatement(*this, stmt); + genIoConditionBranches(eval, stmt.v, iostat); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::WriteStmt &stmt) { - genWriteStatement(*this, stmt, - eval.getOwningProcedure()->labelEvaluationMap); + auto iostat = genWriteStatement( + *this, stmt, eval.getOwningProcedure()->labelEvaluationMap); + genIoConditionBranches(eval, stmt.controls, iostat); + } + + template + void genIoConditionBranches(Fortran::lower::pft::Evaluation &eval, + const A &specList, mlir::Value iostat) { + if (!iostat) + return; + + mlir::Block *endBlock{}; + mlir::Block *eorBlock{}; + mlir::Block *errBlock{}; + for (const auto &spec : specList) { + std::visit(Fortran::common::visitors{ + [&](const Fortran::parser::EndLabel &label) { + endBlock = blockOfLabel(eval, label.v); + }, + [&](const Fortran::parser::EorLabel &label) { + eorBlock = blockOfLabel(eval, label.v); + }, + [&](const Fortran::parser::ErrLabel &label) { + errBlock = blockOfLabel(eval, label.v); + }, + [](const auto &) {}}, + spec.u); + } + if (!endBlock && !eorBlock && !errBlock) + return; + + auto indexType = builder->getIndexType(); + auto selector = builder->createHere(indexType, iostat); + llvm::SmallVector indexList; + llvm::SmallVector blockList; + if (eorBlock) { + indexList.push_back(Fortran::runtime::io::IostatEor); + blockList.push_back(eorBlock); + } + if (endBlock) { + indexList.push_back(Fortran::runtime::io::IostatEnd); + blockList.push_back(endBlock); + } + if (errBlock) { + indexList.push_back(0); + blockList.push_back(eval.lexicalSuccessor->block); + // ERR label statement is the default successor. + blockList.push_back(errBlock); + } else { + // Fallthrough successor statement is the default successor. + blockList.push_back(eval.lexicalSuccessor->block); + } + builder->createHere(selector, indexList, blockList); } //===--------------------------------------------------------------------===// diff --git a/flang/test/Lower/io-stmt.f90 b/flang/test/Lower/io-stmt01.f90 similarity index 100% rename from flang/test/Lower/io-stmt.f90 rename to flang/test/Lower/io-stmt01.f90 diff --git a/flang/test/Lower/io-stmt02.f90 b/flang/test/Lower/io-stmt02.f90 new file mode 100644 index 0000000000000..431c756eb3c18 --- /dev/null +++ b/flang/test/Lower/io-stmt02.f90 @@ -0,0 +1,25 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + + character*10 :: exx + character*20 :: c + character*30 :: m + integer*2 :: s + exx = 'AA' + c = 'BBBB' + m = 'CCCCCC' + s = -13 + ! CHECK: call {{.*}}BeginExternalFormattedInput + ! CHECK: call {{.*}}EnableHandlers + ! CHECK: call {{.*}}SetAdvance + ! CHECK: call {{.*}}InputAscii + ! CHECK: call {{.*}}GetIoMsg + ! CHECK: call {{.*}}EndIoStatement + ! CHECK: fir.select %{{.*}} : index [-2, ^bb4, -1, ^bb3, 0, ^bb1, unit, ^bb2] + read(*, '(A)', ADVANCE='NO', ERR=10, END=20, EOR=30, IOSTAT=s, IOMSG=m) c + ! CHECK-LABEL: ^bb1: + exx = 'Zip'; goto 90 +10 exx = 'Err'; goto 90 +20 exx = 'End'; goto 90 +30 exx = 'Eor'; goto 90 +90 print*, exx, c, m, s +end From eea5ed38394ba09e21b7c9eb3ce2c68a96b382a1 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 8 May 2020 12:52:59 -0700 Subject: [PATCH 0023/1017] fix bug with external names Fix IsDescriptor for dummy with explicit non constant shapes add option to bbc cleanup on bbc need to flip from column-major to row-major when converting to LLVM. use TypeSwitch; fix failing test --- flang/LAPACK-bugs.txt | 19 ++++++++--- flang/lib/Evaluate/type.cpp | 9 ++++++ flang/lib/Lower/Mangler.cpp | 5 --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 36 ++++++++++++++++++++- flang/lib/Optimizer/Dialect/FIRType.cpp | 9 +++--- flang/tools/bbc/bbc.cpp | 43 +++++++++++++------------ 6 files changed, 86 insertions(+), 35 deletions(-) diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index 4248857d9d663..a2ef6db853001 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -2,7 +2,6 @@ NEED ATTENTION ______________ [Eric] - . ConvertExpr.cpp:193 - function type mismatch . Bridge.cpp:1322 - array assignment [Varun] @@ -16,16 +15,26 @@ ______________ . have lowering call the runtime STOP function (instead of the dummy standin) . Intrinsics.cpp:613! - nint +[Val] + + . lapack/SRC/sgtsv.f - error: unreachable blocks were not converted + . lapack/SRC/dsyevd_2stage.f - operation with block successors must terminate its parent block + . lapack/SRC/cgbsvx.f - type mismatch for bb argument #_ of successor #_ [unassigned] - . ConvertExpr.cpp:266 - character comparison - . ConvertExpr.cpp:458! - concat CHARs - . ConvertExpr.cpp:711! - Ev::Triplet - . error: unreachable blocks were not converted + . lapack/SRC/sgbcon.f - ConvertExpr.cpp:266 - character comparison + . lapack/SRC/sgesvd.f - ConvertExpr.cpp:458! - concat CHARs + . lapack/SRC/sbdsvdx.f - ConvertExpr.cpp:711! - Ev::Triplet + . lapack/INSTALL/second_INT_ETIME.f - 'etime' is not a known intrinsic procedure + . lapack/SRC/chla_transtype.f - type of return operand 0 ('!fir.array<1x!fir.char<1>>') doesn't match function result type ('!fir.char<1>') + . lapack/INSTALL/dsecnd_INT_ETIME.f - Failed in semantics + . lapack/INSTALL/second_INT_ETIME.f - Failed in semantics FIXED _____ bbc: Missing LEN_TRIM lowering + . ConvertExpr.cpp:193 - function type mismatch + . 'std.call' op incorrect number of operands for callee diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp index 0d2004d12438b..8aabe5d6d44ec 100644 --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -37,6 +37,14 @@ static bool IsDescriptor(const ObjectEntityDetails &details) { if (IsDescriptor(details.type())) { return true; } + // TODO: Automatic (adjustable) arrays - are they descriptors? + if (details.isDummy()) { + return details.IsAssumedShape() || details.IsDeferredShape() || + details.IsAssumedRank(); + } + return !details.shape().empty() && !details.shape().IsConstantShape(); +#if 0 + // FIXME: use this? for (const ShapeSpec &shapeSpec : details.shape()) { const auto &lb{shapeSpec.lbound().GetExplicit()}; const auto &ub{shapeSpec.ubound().GetExplicit()}; @@ -45,6 +53,7 @@ static bool IsDescriptor(const ObjectEntityDetails &details) { } } return false; +#endif } static bool IsDescriptor(const ProcEntityDetails &details) { diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp index d8a203890acaf..b590fc9324413 100644 --- a/flang/lib/Lower/Mangler.cpp +++ b/flang/lib/Lower/Mangler.cpp @@ -108,11 +108,6 @@ Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer, return uniquer.doConstant(modNames, optHost, symbolName); return uniquer.doVariable(modNames, optHost, symbolName); }, - [&](const Fortran::semantics::ObjectEntityDetails &) { - auto modNames = moduleNames(ultimateSymbol); - return uniquer.doVariable(modNames, hostName(ultimateSymbol), - toStringRef(symbolName)); - }, [](const auto &) -> std::string { assert(false); return {}; diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index d44cd76d0018c..0c0dd168d7992 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -23,6 +23,7 @@ #include "mlir/Target/LLVMIR.h" #include "mlir/Transforms/DialectConversion.h" #include "llvm/ADT/ArrayRef.h" +#include "llvm/ADT/TypeSwitch.h" #include "llvm/Config/abi-breaking.h" #include "llvm/IR/IRBuilder.h" #include "llvm/IR/Module.h" @@ -1089,7 +1090,7 @@ struct ConvertOpConversion : public FIROpConversion { static mlir::Type getComplexEleTy(mlir::Type complex) { if (auto cc = complex.dyn_cast()) return cc.getElementType(); - return complex.cast().getElementType(); + return complex.cast().getEleTy(); } }; @@ -1257,6 +1258,37 @@ struct ValueOpCommon { llvm_unreachable("must be a constant op"); return {}; } + + // Translate the arguments pertaining to any multidimensional array to + // row-major order for LLVM-IR. + static void toRowMajor(llvm::SmallVectorImpl &attrs, + mlir::Type ty) { + const auto end = attrs.size(); + for (std::remove_const_t i = 0; i < end; ++i) { + if (auto seq = ty.dyn_cast()) { + const auto dim = seq.getDimension(); + if (dim > 1) { + std::reverse(attrs.begin() + i, attrs.begin() + i + dim); + i += dim - 1; + } + ty = seq.getEleTy(); + continue; + } + if (auto eleTy = + llvm::TypeSwitch(ty) + .Case([&](auto match) { + return match.getType( + attrs[i].cast().getUInt()); + }) + .Case( + [](auto match) { return match.getEleTy(); }) + .Default([](mlir::Type) { return mlir::Type{}; })) { + ty = eleTy; + continue; + } + llvm_unreachable("index into invalid type"); + } + } }; /// Extract a subobject value from an ssa-value of aggregate type @@ -1274,6 +1306,7 @@ struct ExtractValueOpConversion SmallVector attrs; for (std::size_t i = 1, end{operands.size()}; i < end; ++i) attrs.push_back(getValue(operands[i])); + toRowMajor(attrs, extractVal.adt().getType()); auto position = mlir::ArrayAttr::get(attrs, extractVal.getContext()); rewriter.replaceOpWithNewOp( extractVal, ty, operands[0], position); @@ -1296,6 +1329,7 @@ struct InsertValueOpConversion SmallVector attrs; for (std::size_t i = 2, end{operands.size()}; i < end; ++i) attrs.push_back(getValue(operands[i])); + toRowMajor(attrs, insertVal.adt().getType()); auto position = mlir::ArrayAttr::get(attrs, insertVal.getContext()); rewriter.replaceOpWithNewOp( insertVal, ty, operands[0], operands[1], position); diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp index beab54e4f1f88..e17daae31c7b2 100644 --- a/flang/lib/Optimizer/Dialect/FIRType.cpp +++ b/flang/lib/Optimizer/Dialect/FIRType.cpp @@ -432,9 +432,10 @@ void fir::HeapType::print(mlir::DialectAsmPrinter &printer) const { printer << getMnemonic() << "<" << getEleTy() << '>'; } -mlir::LogicalResult -fir::HeapType::verify(llvm::function_ref emitError, - mlir::Type eleTy) { +mlir::LogicalResult - + fir::HeapType::verify( + llvm::function_ref emitError, + -mlir::Type eleTy) { if (canBePointerOrHeapElementType(eleTy)) return emitError() << "cannot build a heap pointer to type: " << eleTy << '\n'; @@ -859,7 +860,7 @@ mlir::LogicalResult fir::VectorType::verify( llvm::function_ref emitError, uint64_t len, mlir::Type eleTy) { if (!(fir::isa_real(eleTy) || fir::isa_integer(eleTy))) - return emitError() << "cannot build a vector of type " << eleTy << '\n'; + return emitError << "cannot build a vector of type " << eleTy << '\n'; return mlir::success(); } diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 00a4e336ff68f..3dfb29553d004 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -98,21 +98,21 @@ static llvm::cl::opt dumpSymbols("dump-symbols", llvm::cl::desc("dump the symbol table"), llvm::cl::init(false)); -static llvm::cl::opt pftDumpTest("pft-test", llvm::cl::desc("parse the input, create a PFT, dump it, and exit"), llvm::cl::init(false)); +static llvm::cl::opt pftDumpTest( + "pft-test", + llvm::cl::desc("parse the input, create a PFT, dump it, and exit"), + llvm::cl::init(false)); -static llvm::cl::opt enableOpenMP("fopenmp", llvm::cl::desc("enable openmp"), llvm::cl::init(false)); +static llvm::cl::opt enableOpenMP("fopenmp", + llvm::cl::desc("enable openmp"), + llvm::cl::init(false)); -//===----------------------------------------------------------------------===// - -namespace { +static llvm::cl::opt dumpModuleOnFailure("dump-module-on-failure", + llvm::cl::init(false)); -// TODO: vestigal struct that should be deleted -struct DriverOptions { - Fortran::parser::Encoding encoding{Fortran::parser::Encoding::UTF_8}; - std::string prefix; -}; +//===----------------------------------------------------------------------===// -} // namespace +using ProgramName = std::string; static int exitStatus{EXIT_SUCCESS}; @@ -125,7 +125,8 @@ static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) { // Convert Fortran input to MLIR (target is FIR dialect) static void convertFortranSourceToMLIR( - std::string path, Fortran::parser::Options options, DriverOptions &driver, + std::string path, Fortran::parser::Options options, + const ProgramName &programPrefix, Fortran::semantics::SemanticsContext &semanticsContext) { if (!(fixedForm || freeForm)) { auto dot = path.rfind("."); @@ -147,7 +148,7 @@ static void convertFortranSourceToMLIR( parsing.Prescan(path, options); if (!parsing.messages().empty() && (warnIsError || parsing.messages().AnyFatalError())) { - llvm::errs() << driver.prefix << "could not scan " << path << '\n'; + llvm::errs() << programPrefix << "could not scan " << path << '\n'; parsing.messages().Emit(llvm::errs(), parsing.cooked()); exitStatus = EXIT_FAILURE; return; @@ -165,7 +166,7 @@ static void convertFortranSourceToMLIR( if ((!parsing.messages().empty() && (warnIsError || parsing.messages().AnyFatalError())) || !parsing.parseTree().has_value()) { - llvm::errs() << driver.prefix << "could not parse " << path << '\n'; + llvm::errs() << programPrefix << "could not parse " << path << '\n'; exitStatus = EXIT_FAILURE; return; } @@ -177,13 +178,13 @@ static void convertFortranSourceToMLIR( semantics.Perform(); semantics.EmitMessages(llvm::errs()); if (semantics.AnyFatalError()) { - llvm::errs() << driver.prefix << "semantic errors in " << path << '\n'; + llvm::errs() << programPrefix << "semantic errors in " << path << '\n'; exitStatus = EXIT_FAILURE; return; } if (dumpSymbols) semantics.DumpSymbols(llvm::outs()); - + if (pftDumpTest) { if (auto ast{Fortran::lower::createPFT(parseTree, semanticsContext)}) { Fortran::lower::dumpPFT(llvm::outs(), *ast); @@ -251,7 +252,8 @@ static void convertFortranSourceToMLIR( } // Something went wrong. Try to dump the MLIR module. llvm::errs() << "oops, pass manager reported failure\n"; - mlirModule.dump(); + if (dumpModuleOnFailure) + mlirModule.dump(); } int main(int argc, char **argv) { @@ -263,8 +265,8 @@ int main(int argc, char **argv) { mlir::PassPipelineCLParser passPipe("", "Compiler passes to run"); llvm::cl::ParseCommandLineOptions(argc, argv, "Burnside Bridge Compiler\n"); - DriverOptions driver; - driver.prefix = argv[0] + ": "s; + ProgramName programPrefix; + programPrefix = argv[0] + ": "s; if (includeDirs.size() == 0) includeDirs.push_back("."); @@ -290,6 +292,7 @@ int main(int argc, char **argv) { .set_warnOnNonstandardUsage(warnStdViolation) .set_warningsAreErrors(warnIsError); - convertFortranSourceToMLIR(inputFilename, options, driver, semanticsContext); + convertFortranSourceToMLIR(inputFilename, options, programPrefix, + semanticsContext); return exitStatus; } From 39ee0c413512c8e91b111e9c700ca6b11c2f61b5 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 7 May 2020 07:02:06 -0700 Subject: [PATCH 0024/1017] Lower FLOOR and NINT. Add tests for CEILING/FLOOR/NINT Use LLVM intrinsic lround/floor to lower NINT/FLOOR. STOP and ERROR STOP lowering Update lapack issue list Remove lower::RuntimeEntryCode enum --- flang/LAPACK-bugs.txt | 11 ++- flang/lib/Lower/Bridge.cpp | 44 ++++++++++-- flang/lib/Lower/Intrinsics.cpp | 77 ++++++++++++++++----- flang/lib/Lower/Runtime.cpp | 115 ++++++++------------------------ flang/test/Lower/intrinsics.f90 | 55 ++++++++++++++- flang/test/Lower/stop.f90 | 51 ++++++++++++++ 6 files changed, 238 insertions(+), 115 deletions(-) create mode 100644 flang/test/Lower/stop.f90 diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index a2ef6db853001..b245ce51802d2 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -11,9 +11,8 @@ ______________ . error: 'llvm.mlir.global' op initializer region type '!llvm.i1' does not match global type '!llvm.i32' [Jean] - - . have lowering call the runtime STOP function (instead of the dummy standin) - . Intrinsics.cpp:613! - nint + . ConvertExpr.cpp:266 - character comparison + . ConvertExpr.cpp:458! - concat CHARs [Val] @@ -23,8 +22,6 @@ ______________ [unassigned] - . lapack/SRC/sgbcon.f - ConvertExpr.cpp:266 - character comparison - . lapack/SRC/sgesvd.f - ConvertExpr.cpp:458! - concat CHARs . lapack/SRC/sbdsvdx.f - ConvertExpr.cpp:711! - Ev::Triplet . lapack/INSTALL/second_INT_ETIME.f - 'etime' is not a known intrinsic procedure . lapack/SRC/chla_transtype.f - type of return operand 0 ('!fir.array<1x!fir.char<1>>') doesn't match function result type ('!fir.char<1>') @@ -34,7 +31,9 @@ ______________ FIXED _____ -bbc: Missing LEN_TRIM lowering + . Missing LEN_TRIM lowering + . Missing NINT lowering + . STOP runtime mismatch . ConvertExpr.cpp:193 - function type mismatch . 'std.call' op incorrect number of operands for callee diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 2c70ba8b98be8..660317de453f4 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1508,8 +1508,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // call FAIL IMAGE in runtime void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::FailImageStmt &stmt) { - auto callee = genRuntimeFunction( - Fortran::lower::RuntimeEntryCode::FailImageStatement, *builder); + auto callee = genFailImageStatementRuntime(*builder); llvm::SmallVector operands; // FAIL IMAGE has no args builder->create(toLocation(), callee, operands); } @@ -1517,9 +1516,46 @@ class FirConverter : public Fortran::lower::AbstractConverter { // call STOP, ERROR STOP in runtime void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::StopStmt &stmt) { - auto callee = genRuntimeFunction( - Fortran::lower::RuntimeEntryCode::StopStatement, *builder); + auto callee = genStopStatementRuntime(*builder); + auto calleeType = callee.getType(); llvm::SmallVector operands; + assert(calleeType.getNumInputs() == 3 && + "expected 3 arguments in STOP runtime"); + // First operand is stop code (zero if absent) + if (const auto &code = + std::get>(stmt.t)) { + auto expr = Fortran::semantics::GetExpr(*code); + assert(expr && "failed getting typed expression"); + operands.push_back(genExprValue(*expr)); + } else { + operands.push_back( + builder->createIntegerConstant(calleeType.getInput(0), 0)); + } + // Second operand indicates ERROR STOP + bool isError = std::get(stmt.t) == + Fortran::parser::StopStmt::Kind::ErrorStop; + operands.push_back( + builder->createIntegerConstant(calleeType.getInput(1), isError)); + + // Third operand indicates QUIET (default to false). + if (const auto &quiet = + std::get>( + stmt.t)) { + auto expr = Fortran::semantics::GetExpr(*quiet); + assert(expr && "failed getting typed expression"); + operands.push_back(genExprValue(*expr)); + } else { + operands.push_back( + builder->createIntegerConstant(calleeType.getInput(2), 0)); + } + + // Cast operands in case they have different integer/logical types + // compare to runtime. + auto i = 0; + for (auto &op : operands) { + auto type = calleeType.getInput(i++); + op = builder->createConvert(toLocation(), type, op); + } builder->create(toLocation(), callee, operands); } diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index 7b198341b5e83..7b36c50a25de6 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -105,10 +105,12 @@ struct IntrinsicLibrary { mlir::Value genCeiling(mlir::Type, llvm::ArrayRef); template mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); + mlir::Value genFloor(mlir::Type, llvm::ArrayRef); mlir::Value genIchar(mlir::Type, llvm::ArrayRef); mlir::Value genLenTrim(mlir::Type, llvm::ArrayRef); mlir::Value genMerge(mlir::Type, llvm::ArrayRef); mlir::Value genMod(mlir::Type, llvm::ArrayRef); + mlir::Value genNint(mlir::Type, llvm::ArrayRef); mlir::Value genSign(mlir::Type, llvm::ArrayRef); /// Implement all conversion functions like DBLE, the first argument is /// the value to convert. There may be an additional KIND arguments that @@ -152,12 +154,14 @@ static constexpr IntrinsicHanlder handlers[]{ {"char", &I::genConversion}, {"conjg", &I::genConjg}, {"dble", &I::genConversion}, + {"floor", &I::genFloor}, {"ichar", &I::genIchar}, {"len_trim", &I::genLenTrim}, {"max", &I::genExtremum}, {"min", &I::genExtremum}, {"merge", &I::genMerge}, {"mod", &I::genMod}, + {"nint", &I::genNint}, {"sign", &I::genSign}, }; @@ -229,34 +233,54 @@ static constexpr RuntimeFunction pgmathPrecise[] = { #include "../runtime/pgmath.h.inc" }; -static mlir::FunctionType gen1ArgF32FuncType(mlir::MLIRContext *context) { +static mlir::FunctionType genF32F32FuncType(mlir::MLIRContext *context) { auto t = mlir::FloatType::getF32(context); return mlir::FunctionType::get({t}, {t}, context); } -static mlir::FunctionType gen1ArgF64FuncType(mlir::MLIRContext *context) { +static mlir::FunctionType genF64F64FuncType(mlir::MLIRContext *context) { auto t = mlir::FloatType::getF64(context); return mlir::FunctionType::get({t}, {t}, context); } +template +static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) { + auto t = mlir::FloatType::getF64(context); + auto r = mlir::IntegerType::get(Bits, context); + return mlir::FunctionType::get({t}, {r}, context); +} +template +static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) { + auto t = mlir::FloatType::getF32(context); + auto r = mlir::IntegerType::get(Bits, context); + return mlir::FunctionType::get({t}, {r}, context); +} + // TODO : Fill-up this table with more intrinsic. // Note: These are also defined as operations in LLVM dialect. See if this // can be use and has advantages. static constexpr RuntimeFunction llvmIntrinsics[] = { - {"abs", "llvm.fabs.f32", gen1ArgF32FuncType}, - {"abs", "llvm.fabs.f64", gen1ArgF64FuncType}, + {"abs", "llvm.fabs.f32", genF32F32FuncType}, + {"abs", "llvm.fabs.f64", genF64F64FuncType}, // ceil is used for CEILING but is different, it returns a real. - {"ceil", "llvm.ceil.f32", gen1ArgF32FuncType}, - {"ceil", "llvm.ceil.f64", gen1ArgF64FuncType}, - {"cos", "llvm.cos.f32", gen1ArgF32FuncType}, - {"cos", "llvm.cos.f64", gen1ArgF64FuncType}, - {"log", "llvm.log.f32", gen1ArgF32FuncType}, - {"log", "llvm.log.f64", gen1ArgF64FuncType}, - {"log10", "llvm.log10.f32", gen1ArgF32FuncType}, - {"log10", "llvm.log10.f64", gen1ArgF64FuncType}, - {"sin", "llvm.sin.f32", gen1ArgF32FuncType}, - {"sin", "llvm.sin.f64", gen1ArgF64FuncType}, - {"sqrt", "llvm.sqrt.f32", gen1ArgF32FuncType}, - {"sqrt", "llvm.sqrt.f64", gen1ArgF64FuncType}, + {"ceil", "llvm.ceil.f32", genF32F32FuncType}, + {"ceil", "llvm.ceil.f64", genF64F64FuncType}, + {"cos", "llvm.cos.f32", genF32F32FuncType}, + {"cos", "llvm.cos.f64", genF64F64FuncType}, + // llvm.floor is used for FLOOR, but returns real. + {"floor", "llvm.floor.f32", genF32F32FuncType}, + {"floor", "llvm.floor.f64", genF64F64FuncType}, + {"log", "llvm.log.f32", genF32F32FuncType}, + {"log", "llvm.log.f64", genF64F64FuncType}, + {"log10", "llvm.log10.f32", genF32F32FuncType}, + {"log10", "llvm.log10.f64", genF64F64FuncType}, + {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>}, + {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>}, + {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>}, + {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>}, + {"sin", "llvm.sin.f32", genF32F32FuncType}, + {"sin", "llvm.sin.f64", genF64F64FuncType}, + {"sqrt", "llvm.sqrt.f32", genF32F32FuncType}, + {"sqrt", "llvm.sqrt.f64", genF64F64FuncType}, }; // This helper class computes a "distance" between two function types. @@ -666,7 +690,7 @@ mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType, // Use ceil that is not an actual Fortran intrinsic but that is // an llvm intrinsic that does the same, but return a floating // point. - auto ceil = genIntrinsicCall("ceil", arg.getType(), {arg}); + auto ceil = genRuntimeCall("ceil", arg.getType(), {arg}); return builder.createHere(resultType, ceil); } @@ -683,6 +707,17 @@ mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType, return builder.insertComplexPart(cplx, negImag, /*isImagPart=*/true); } +// FLOOR +mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType, + llvm::ArrayRef args) { + // Optional KIND argument. + assert(args.size() >= 1); + auto arg = args[0]; + // Use LLVM floor that returns real. + auto floor = genRuntimeCall("floor", arg.getType(), {arg}); + return builder.createHere(resultType, floor); +} + // ICHAR mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, llvm::ArrayRef args) { @@ -730,6 +765,14 @@ mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType, return genRuntimeCall("mod", resultType, args); } +// MOD +mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() >= 1); + // Skip optional kind argument to search the runtime + return genRuntimeCall("nint", resultType, {args[0]}); +} + // SIGN mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index c407106ca1cb8..504e90be56b79 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -7,102 +7,43 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/Runtime.h" +#include "RTBuilder.h" #include "flang/Lower/FIRBuilder.h" -#include "mlir/IR/StandardTypes.h" -#include "mlir/IR/Types.h" #include "llvm/ADT/SmallVector.h" -#include "llvm/Support/ErrorHandling.h" -namespace Fortran::lower { +#include "../runtime/stop.h" -mlir::Type RuntimeStaticDescription::getMLIRType(TypeCode t, - mlir::MLIRContext *context) { - switch (t) { - case TypeCode::i32: - return mlir::IntegerType::get(32, context); - case TypeCode::i64: - return mlir::IntegerType::get(64, context); - case TypeCode::f32: - return mlir::FloatType::getF32(context); - case TypeCode::f64: - return mlir::FloatType::getF64(context); - // TODO need to access mapping between fe/target - case TypeCode::c32: - return fir::CplxType::get(context, 4); - case TypeCode::c64: - return fir::CplxType::get(context, 8); - case TypeCode::boolean: - return mlir::IntegerType::get(8, context); - case TypeCode::charPtr: - return fir::ReferenceType::get(fir::CharacterType::get(context, 1)); - // ! IOCookie is experimental only so far - case TypeCode::IOCookie: - return fir::ReferenceType::get(mlir::IntegerType::get(64, context)); - } - llvm_unreachable("bug"); - return {}; -} +using Fortran::lower::operator""_rt_ident; -mlir::FunctionType RuntimeStaticDescription::getMLIRFunctionType( - mlir::MLIRContext *context) const { - llvm::SmallVector argMLIRTypes; - for (const TypeCode &t : argumentTypeCodes) { - argMLIRTypes.push_back(getMLIRType(t, context)); - } - if (resultTypeCode.has_value()) { - mlir::Type resMLIRType{getMLIRType(*resultTypeCode, context)}; - return mlir::FunctionType::get(argMLIRTypes, resMLIRType, context); - } - return mlir::FunctionType::get(argMLIRTypes, {}, context); -} +#define MakeRuntimeEntry(X) mkKey(RTNAME(X)) -mlir::FuncOp RuntimeStaticDescription::getFuncOp( - Fortran::lower::FirOpBuilder &builder) const { - auto module = builder.getModule(); - auto funTy = getMLIRFunctionType(module.getContext()); - auto function = builder.addNamedFunction(symbol, funTy); - function.setAttr("fir.runtime", builder.getUnitAttr()); - if (funTy != function.getType()) - llvm_unreachable("runtime function type mismatch"); - return function; +template +static mlir::FuncOp genRuntimeFunction(Fortran::lower::FirOpBuilder &builder) { + auto func = builder.getNamedFunction(RuntimeEntry::name); + if (func) + return func; + auto funTy = RuntimeEntry::getTypeModel()(builder.getContext()); + func = builder.createFunction(RuntimeEntry::name, funTy); + func.setAttr("fir.runtime", builder.getUnitAttr()); + return func; } -class RuntimeEntryDescription : public RuntimeStaticDescription { -public: - using Key = RuntimeEntryCode; - constexpr RuntimeEntryDescription(Key k, const char *s, MaybeTypeCode r, - TypeCodeVector a) - : RuntimeStaticDescription{s, r, a}, key{k} {} - Key key; -}; - -static constexpr RuntimeEntryDescription runtimeTable[]{ - {RuntimeEntryCode::StopStatement, "StopStatement", - RuntimeStaticDescription::voidTy, - RuntimeStaticDescription::TypeCodeVector::create< - RuntimeStaticDescription::TypeCode::i32, - RuntimeStaticDescription::TypeCode::boolean, - RuntimeStaticDescription::TypeCode::boolean>()}, - {RuntimeEntryCode::StopStatementText, "StopStatementText", - RuntimeStaticDescription::voidTy, - RuntimeStaticDescription::TypeCodeVector::create< - RuntimeStaticDescription::TypeCode::charPtr, - RuntimeStaticDescription::TypeCode::i32, - RuntimeStaticDescription::TypeCode::boolean, - RuntimeStaticDescription::TypeCode::boolean>()}, - {RuntimeEntryCode::FailImageStatement, "StopStatementText", - RuntimeStaticDescription::voidTy, - RuntimeStaticDescription::TypeCodeVector::create<>()}, -}; +mlir::FuncOp +Fortran::lower::genStopStatementRuntime(Fortran::lower::FirOpBuilder &builder) { + return genRuntimeFunction(builder); +} -static constexpr StaticMultimapView runtimeMap{ - runtimeTable}; +mlir::FuncOp Fortran::lower::genStopStatementTextRuntime( + Fortran::lower::FirOpBuilder &builder) { + return genRuntimeFunction(builder); +} -mlir::FuncOp genRuntimeFunction(RuntimeEntryCode code, - Fortran::lower::FirOpBuilder &builder) { - auto description = runtimeMap.find(code); - assert(description != runtimeMap.end()); - return description->getFuncOp(builder); +mlir::FuncOp Fortran::lower::genFailImageStatementRuntime( + Fortran::lower::FirOpBuilder &builder) { + return genRuntimeFunction(builder); } -} // namespace Fortran::lower +mlir::FuncOp Fortran::lower::genProgramEndStatementRuntime( + Fortran::lower::FirOpBuilder &builder) { + return genRuntimeFunction(builder); +} diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index 41f28dc1b380d..b074e23073cd9 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -44,6 +44,25 @@ subroutine dble_test(a) print *, dble(a) end subroutine +! CEILING +! CHECK-LABEL: ceiling_test1 +subroutine ceiling_test1(i, a) + integer :: i + real :: a + i = ceiling(a) + ! CHECK: %[[f:.*]] = call @llvm.ceil.f32 + ! CHECK: fir.convert %[[f]] : (f32) -> i32 +end subroutine +! CHECK-LABEL: ceiling_test2 +subroutine ceiling_test2(i, a) + integer(8) :: i + real :: a + i = ceiling(a, 8) + ! CHECK: %[[f:.*]] = call @llvm.ceil.f32 + ! CHECK: fir.convert %[[f]] : (f32) -> i64 +end subroutine + + ! CONJG ! CHECK-LABEL: conjg_test subroutine conjg_test(z1, z2) @@ -54,6 +73,24 @@ subroutine conjg_test(z1, z2) z2 = conjg(z1) end subroutine +! FLOOR +! CHECK-LABEL: floor_test1 +subroutine floor_test1(i, a) + integer :: i + real :: a + i = floor(a) + ! CHECK: %[[f:.*]] = call @llvm.floor.f32 + ! CHECK: fir.convert %[[f]] : (f32) -> i32 +end subroutine +! CHECK-LABEL: floor_test2 +subroutine floor_test2(i, a) + integer(8) :: i + real :: a + i = floor(a, 8) + ! CHECK: %[[f:.*]] = call @llvm.floor.f32 + ! CHECK: fir.convert %[[f]] : (f32) -> i64 +end subroutine + ! ICHAR ! CHECK-LABEL: ichar_test subroutine ichar_test(c) @@ -72,7 +109,7 @@ subroutine len_test(i, c) end subroutine ! LEN_TRIM -!CHECK-LABEL: len_trim_test +! CHECK-LABEL: len_trim_test integer function len_trim_test(c) character(*) :: c ltrim = len_trim(c) @@ -91,6 +128,22 @@ integer function len_trim_test(c) ! CHECK: select %[[iterateResult]], %[[c0]], %[[len]] end function +! NINT +! CHECK-LABEL: nint_test1 +subroutine nint_test1(i, a) + integer :: i + real :: a + i = nint(a) + ! CHECK: call @llvm.lround.i32.f32 +end subroutine +! CHECK-LABEL: nint_test2 +subroutine nint_test2(i, a) + integer(8) :: i + real(8) :: a + i = nint(a, 8) + ! CHECK: call @llvm.lround.i64.f64 +end subroutine + ! SIGN diff --git a/flang/test/Lower/stop.f90 b/flang/test/Lower/stop.f90 new file mode 100644 index 0000000000000..402c00ab84cd7 --- /dev/null +++ b/flang/test/Lower/stop.f90 @@ -0,0 +1,51 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL stop_test +subroutine stop_test(b) + ! CHECK-DAG: %[[c0:.*]] = constant 0 : i32 + ! CHECK-DAG: %[[false:.*]] = constant 0 : i1 + ! CHECK-DAG: %[[false_0:.*]] = constant 0 : i1 + ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[false_0]]) + stop +end subroutine +! CHECK: func @_Fortran{{.*}}StopStatement(i32, i1, i1) -> none + +! CHECK-LABEL stop_code +subroutine stop_code() + stop 42 + ! CHECK-DAG: %[[c42:.*]] = constant 42 : i32 + ! CHECK-DAG: %[[false:.*]] = constant 0 : i1 + ! CHECK-DAG: %[[false_0:.*]] = constant 0 : i1 + ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c42]], %[[false]], %[[false_0]]) +end subroutine + +! CHECK-LABEL stop_error +subroutine stop_error() + error stop + ! CHECK-DAG: %[[c0:.*]] = constant 0 : i32 + ! CHECK-DAG: %[[true:.*]] = constant 1 : i1 + ! CHECK-DAG: %[[false:.*]] = constant 0 : i1 + ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[true]], %[[false]]) +end subroutine + +! CHECK-LABEL stop_quiet +subroutine stop_quiet(b) + logical :: b + stop, quiet = b + ! CHECK-DAG: %[[c0:.*]] = constant 0 : i32 + ! CHECK-DAG: %[[false:.*]] = constant 0 : i1 + ! CHECK-DAG: %[[b:.*]] = fir.load %arg0 + ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 + ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[bi1]]) +end subroutine + +! CHECK-LABEL stop_error_code_quiet +subroutine stop_error_code_quiet(b) + logical :: b + error stop 66, quiet = b + ! CHECK-DAG: %[[c66:.*]] = constant 66 : i32 + ! CHECK-DAG: %[[true:.*]] = constant 1 : i1 + ! CHECK-DAG: %[[b:.*]] = fir.load %arg0 + ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 + ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c66]], %[[true]], %[[bi1]]) +end subroutine From 63ff4731b3c507dd921398d783b83b97d1ef536c Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 12 May 2020 08:08:23 -0700 Subject: [PATCH 0025/1017] revert PR #61 --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 36 +------------------------ 1 file changed, 1 insertion(+), 35 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 0c0dd168d7992..d44cd76d0018c 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -23,7 +23,6 @@ #include "mlir/Target/LLVMIR.h" #include "mlir/Transforms/DialectConversion.h" #include "llvm/ADT/ArrayRef.h" -#include "llvm/ADT/TypeSwitch.h" #include "llvm/Config/abi-breaking.h" #include "llvm/IR/IRBuilder.h" #include "llvm/IR/Module.h" @@ -1090,7 +1089,7 @@ struct ConvertOpConversion : public FIROpConversion { static mlir::Type getComplexEleTy(mlir::Type complex) { if (auto cc = complex.dyn_cast()) return cc.getElementType(); - return complex.cast().getEleTy(); + return complex.cast().getElementType(); } }; @@ -1258,37 +1257,6 @@ struct ValueOpCommon { llvm_unreachable("must be a constant op"); return {}; } - - // Translate the arguments pertaining to any multidimensional array to - // row-major order for LLVM-IR. - static void toRowMajor(llvm::SmallVectorImpl &attrs, - mlir::Type ty) { - const auto end = attrs.size(); - for (std::remove_const_t i = 0; i < end; ++i) { - if (auto seq = ty.dyn_cast()) { - const auto dim = seq.getDimension(); - if (dim > 1) { - std::reverse(attrs.begin() + i, attrs.begin() + i + dim); - i += dim - 1; - } - ty = seq.getEleTy(); - continue; - } - if (auto eleTy = - llvm::TypeSwitch(ty) - .Case([&](auto match) { - return match.getType( - attrs[i].cast().getUInt()); - }) - .Case( - [](auto match) { return match.getEleTy(); }) - .Default([](mlir::Type) { return mlir::Type{}; })) { - ty = eleTy; - continue; - } - llvm_unreachable("index into invalid type"); - } - } }; /// Extract a subobject value from an ssa-value of aggregate type @@ -1306,7 +1274,6 @@ struct ExtractValueOpConversion SmallVector attrs; for (std::size_t i = 1, end{operands.size()}; i < end; ++i) attrs.push_back(getValue(operands[i])); - toRowMajor(attrs, extractVal.adt().getType()); auto position = mlir::ArrayAttr::get(attrs, extractVal.getContext()); rewriter.replaceOpWithNewOp( extractVal, ty, operands[0], position); @@ -1329,7 +1296,6 @@ struct InsertValueOpConversion SmallVector attrs; for (std::size_t i = 2, end{operands.size()}; i < end; ++i) attrs.push_back(getValue(operands[i])); - toRowMajor(attrs, insertVal.adt().getType()); auto position = mlir::ArrayAttr::get(attrs, insertVal.getContext()); rewriter.replaceOpWithNewOp( insertVal, ty, operands[0], operands[1], position); From ec3581ae7aadc580bdd973cf12b02b32674874d7 Mon Sep 17 00:00:00 2001 From: V Donaldson Date: Mon, 11 May 2020 21:33:19 -0700 Subject: [PATCH 0026/1017] Fix two control flow bugs in lapack files. File sgtsv.f has a problem transitioning from a structured DO construct to its containing IF construct. This problem is fixed in Bridge.cpp. File dsyevd_2stage.f contains dead code following a RETURN statement that results in an illegal basic block with multiple terminators. The illegal basic block is fixed in PFTBuilder.cpp. Compilation will still fail with this fix until a dead code elimination pass is implemented. Most of the PFTBuilder.cpp changes are cleanup changes. --- flang/lib/Lower/Bridge.cpp | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 660317de453f4..b4f9e90342295 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1613,10 +1613,17 @@ class FirConverter : public Fortran::lower::AbstractConverter { : eval.block); } eval.visit([&](const auto &stmt) { genFIR(eval, stmt); }); - if (unstructuredContext && eval.isActionStmt() && eval.controlSuccessor && - eval.controlSuccessor->block && blockIsUnterminated()) { + if (unstructuredContext && blockIsUnterminated()) { // Exit from an unstructured IF or SELECT construct block. - genBranch(eval.controlSuccessor->block); + Fortran::lower::pft::Evaluation *successor{}; + if (eval.isActionStmt()) + successor = eval.controlSuccessor; + else if (eval.isConstruct() && + eval.evaluationList->back() + .lexicalSuccessor->isIntermediateConstructStmt()) + successor = eval.constructExit; + if (successor && successor->block) + genBranch(successor->block); } } From 788c2e0bd1be8b20e58966ce6365e86fe9053bff Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 12 May 2020 11:20:12 -0700 Subject: [PATCH 0027/1017] remove some dead code need to flip from column-major to row-major when converting to LLVM. fix failing LAPACK tests add call to remove dead code in Bridge.cpp add back the registration of MLIR options remove overly conservative assertions fix bug with optional region fix type mismatch bugs workaround some bug in canonicalize that is causing failure in sgbsvx, etc. add a canonical test with temporary arrays change to expected failure rather than making test pass remove canonicalizer from tco temporarily update the lapack bug list file --- flang/LAPACK-bugs.txt | 27 ++-- flang/lib/Lower/Bridge.cpp | 183 ++++-------------------- flang/lib/Lower/CharRT.cpp | 2 - flang/lib/Optimizer/CodeGen/CodeGen.cpp | 42 ++++++ flang/test/Lower/array.f90 | 1 + flang/test/Lower/arraycopy.f90 | 35 +++++ flang/tools/bbc/bbc.cpp | 2 +- 7 files changed, 116 insertions(+), 176 deletions(-) create mode 100644 flang/test/Lower/arraycopy.f90 diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index b245ce51802d2..9da31215dc0f0 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -2,35 +2,32 @@ NEED ATTENTION ______________ [Eric] - . Bridge.cpp:1322 - array assignment + . Bridge.cpp:1361 - array assignment + . lapack/SRC/sbdsvdx.f - ConvertExpr.cpp:654! - Ev::Triplet -[Varun] +[Varun/Peter] . DATA statement loc("lapack/BLAS/SRC/srotmg.f":116:7): error: DATA statement is not handled. - . error: 'llvm.mlir.global' op initializer region type '!llvm.i1' does not match global type '!llvm.i32' [Jean] - . ConvertExpr.cpp:266 - character comparison - . ConvertExpr.cpp:458! - concat CHARs - -[Val] - - . lapack/SRC/sgtsv.f - error: unreachable blocks were not converted - . lapack/SRC/dsyevd_2stage.f - operation with block successors must terminate its parent block - . lapack/SRC/cgbsvx.f - type mismatch for bb argument #_ of successor #_ + . ConvertExpr.cpp:379! - concat CHARs + . lapack/INSTALL/second_INT_ETIME.f - 'etime' is not a known intrinsic procedure + . lapack/INSTALL/dsecnd_INT_ETIME.f - Failed in semantics + . lapack/INSTALL/second_INT_ETIME.f - Failed in semantics [unassigned] - . lapack/SRC/sbdsvdx.f - ConvertExpr.cpp:711! - Ev::Triplet - . lapack/INSTALL/second_INT_ETIME.f - 'etime' is not a known intrinsic procedure . lapack/SRC/chla_transtype.f - type of return operand 0 ('!fir.array<1x!fir.char<1>>') doesn't match function result type ('!fir.char<1>') - . lapack/INSTALL/dsecnd_INT_ETIME.f - Failed in semantics - . lapack/INSTALL/second_INT_ETIME.f - Failed in semantics FIXED _____ + . lapack/SRC/cgbsvx.f - type mismatch for bb argument #_ of successor #_ + . lapack/SRC/sgtsv.f - error: unreachable blocks were not converted + . lapack/SRC/dsyevd_2stage.f - operation with block successors must terminate its parent block + . ConvertExpr.cpp:266 - character comparison + . error: 'llvm.mlir.global' op initializer region type '!llvm.i1' does not match global type '!llvm.i32' . Missing LEN_TRIM lowering . Missing NINT lowering . STOP runtime mismatch diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index b4f9e90342295..f92e7d3d801b2 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -25,6 +25,7 @@ #include "mlir/Dialect/StandardOps/IR/Ops.h" #include "mlir/Parser.h" #include "mlir/Target/LLVMIR.h" +#include "mlir/Transforms/RegionUtils.h" #include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorHandling.h" #include "llvm/Support/MD5.h" @@ -55,11 +56,6 @@ static llvm::cl::opt "name"), llvm::cl::init(32)); -static llvm::cl::opt - useOldInitializerCode("enable-old-initializer-lowering", - llvm::cl::desc("TODO: remove the old code!"), - llvm::cl::init(false), llvm::cl::Hidden); - namespace { /// Information for generating a structured or unstructured increment loop. struct IncrementLoopInfo { @@ -103,31 +99,12 @@ static bool symIsChar(const Fortran::semantics::Symbol &sym) { static bool symIsArray(const Fortran::semantics::Symbol &sym) { const auto *det = sym.detailsIf(); - return det ? det->IsArray() : false; + return det && det->IsArray(); } static bool isExplicitShape(const Fortran::semantics::Symbol &sym) { const auto *det = sym.detailsIf(); - if (det && det->IsArray()) - return det->shape().IsExplicitShape(); - return false; -} - -/// Temporary helper to detect shapes that do not require evaluating -/// bound expressions at runtime or to get the shape from a descriptor. -static bool isConstantShape(const Fortran::semantics::ArraySpec &shape) { - auto isConstant = [](const auto &bound) { - const auto &expr = bound.GetExplicit(); - return expr.has_value() && Fortran::evaluate::IsConstantExpr(*expr); - }; - for (const auto &susbcript : shape) { - const auto &lb = susbcript.lbound(); - const auto &ub = susbcript.ubound(); - if (isConstant(lb) && (isConstant(ub) || ub.isAssumed())) - continue; - return false; - } - return true; + return det && det->IsArray() && det->shape().IsExplicitShape(); } namespace { @@ -1635,85 +1612,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { return Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty); } - /// Evaluate specification expressions of local symbol and add - /// the resulting `mlir::Value` to localSymbols. - /// Before evaluating a specification expression, the symbols - /// appearing in the expression are gathered, and if they are also - /// local symbols, their specification are evaluated first. In case - /// a circular dependency occurs, this will crash. - void instantiateLocalVariable( - const Fortran::semantics::Symbol &symbol, - Fortran::lower::SymMap &dummyArgs, - llvm::DenseSet attempted) { - if (lookupSymbol(symbol)) - return; // already instantiated - - if (IsProcedure(symbol)) - return; - - if (symbol.has() || - symbol.has()) - TODO(); // Need to keep the localSymbols of other units ? - - if (attempted.find(symbol) != attempted.end()) - TODO(); // Complex dependencies in specification expressions. - - attempted.insert(symbol); - mlir::Value localValue; - auto *type = symbol.GetType(); - assert(type && "expected type for local symbol"); - - if (type->category() == Fortran::semantics::DeclTypeSpec::Character) { - const auto &lengthParam = type->characterTypeSpec().length(); - if (auto expr = lengthParam.GetExplicit()) { - for (const auto &requiredSymbol : - Fortran::evaluate::CollectSymbols(*expr)) { - instantiateLocalVariable(requiredSymbol, dummyArgs, attempted); - } - auto lenValue = - genExprValue(Fortran::evaluate::AsGenericExpr(std::move(*expr))); - if (auto actual = dummyArgs.lookupSymbol(symbol)) { - auto unboxed = builder->createUnboxChar(actual); - localValue = builder->createEmboxChar(unboxed.first, lenValue); - } else { - // TODO: propagate symbol name to FIR. - localValue = builder->createCharacterTemp(genType(symbol), lenValue); - } - } else if (lengthParam.isDeferred()) { - TODO(); - } else { - // Assumed - localValue = dummyArgs.lookupSymbol(symbol); - assert(localValue && - "expected dummy arguments when length not explicit"); - } - addSymbol(symbol, localValue); - } else if (!type->AsIntrinsic()) { - TODO(); // Derived type / polymorphic - } else { - if (auto actualValue = dummyArgs.lookupSymbol(symbol)) - addSymbol(symbol, actualValue); - else - createTemp(toLocation(), symbol); - } - if (const auto *details = - symbol.detailsIf()) { - // For now, only allow compile time constant shapes that do no require - // to evaluate bounds expression here. Assumed size are also supported. - if (!isConstantShape(details->shape())) - TODO(); - // handle bounds specification expressions - if (!details->coshape().empty()) - TODO(); // handle cobounds specification expressions - if (details->init()) - TODO(); // init - } else { - assert(symbol.has()); - TODO(); // Procedure pointers - } - attempted.erase(symbol); - } - /// Instantiate a global variable. If it hasn't already been processed, add /// the global to the ModuleOp as a new uniqued symbol and initialize it with /// the correct value. It will be referenced on demand using `fir.addr_of`. @@ -1730,11 +1628,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (!sym.GetType()->AsIntrinsic()) { TODO(); // Derived type / polymorphic } + auto symTy = genType(sym); + auto loc = toLocation(); global = builder->createGlobal( - toLocation(), genType(sym), globalName, isConst, + loc, symTy, globalName, isConst, [&](Fortran::lower::FirOpBuilder &builder) { auto initVal = genExprValue(details->init().value()); - builder.create(toLocation(), initVal); + auto castTo = builder.createConvert(loc, symTy, initVal); + builder.create(loc, castTo); }); } else { global = builder->createGlobal(toLocation(), genType(sym), globalName); @@ -1977,11 +1878,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void instantiateVar(const Fortran::lower::pft::Variable &var) { - if (var.isGlobal()) { + if (var.isGlobal()) instantiateGlobal(var); - return; - } - instantiateLocal(var); + else + instantiateLocal(var); } /// Prepare to translate a new function @@ -2004,55 +1904,20 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->setInsertionPointToStart(&func.front()); bool hasAlternateReturns = false; - if (useOldInitializerCode) { - Fortran::lower::SymMap dummyAssociations; - // plumb function's arguments - if (funit.symbol && !funit.isMainProgram()) { - auto *entryBlock = &func.front(); - const auto &details = - funit.symbol->get(); - for (const auto &v : - llvm::zip(details.dummyArgs(), entryBlock->getArguments())) { - if (std::get<0>(v)) { - dummyAssociations.addSymbol(*std::get<0>(v), std::get<1>(v)); - } else { - TODO(); // [alt return; code under useOldInitializerCode is dead] - } - } - - // Go through the symbol scope and evaluate specification expressions - llvm::DenseSet attempted; - assert(funit.symbol->scope() && "subprogram symbol must have a scope"); - // TODO: This loop through scope symbols offers no stability guarantee - // regarding the order. This should not be a problem given how - // instantiateLocalVariable is implemented, but may harm - // reproducibility. A solution would be to sort the symbol based on - // their source location. - for (const auto &iter : *funit.symbol->scope()) { - instantiateLocalVariable(iter.second.get(), dummyAssociations, - attempted); - } - - // if (details.isFunction()) - // createTemp(toLocation(), details.result()); - } - } else { - auto *entryBlock = &func.front(); - if (funit.symbol && !funit.isMainProgram()) { - const auto &details = - funit.symbol->get(); - auto blockIter = entryBlock->getArguments().begin(); - for (const auto &dummy : details.dummyArgs()) { - if (dummy) { - addSymbol(*dummy, *blockIter++); - } else { - hasAlternateReturns = true; - } - } + auto *entryBlock = &func.front(); + if (funit.symbol && !funit.isMainProgram()) { + const auto &details = + funit.symbol->get(); + auto blockIter = entryBlock->getArguments().begin(); + for (const auto &dummy : details.dummyArgs()) { + if (dummy) + addSymbol(*dummy, *blockIter++); + else + hasAlternateReturns = true; } - for (const auto &var : funit.getOrderedSymbolTable()) - instantiateVar(var); } + for (const auto &var : funit.getOrderedSymbolTable()) + instantiateVar(var); // Create most function blocks in advance. createEmptyBlocks(funit.evaluationList); @@ -2129,6 +1994,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { else genFIRProcedureExit(funit, funit.getSubprogramSymbol()); + // immediately throw away any dead code just created + mlir::simplifyRegions({builder->getRegion()}); delete builder; builder = nullptr; localSymbols.clear(); diff --git a/flang/lib/Lower/CharRT.cpp b/flang/lib/Lower/CharRT.cpp index c6b1c976cf28b..b11326a8711c3 100644 --- a/flang/lib/Lower/CharRT.cpp +++ b/flang/lib/Lower/CharRT.cpp @@ -123,8 +123,6 @@ Fortran::lower::genBoxCharCompare(Fortran::lower::AbstractConverter &converter, mlir::Value lhs, mlir::Value rhs) { auto &builder = converter.getFirOpBuilder(); builder.setLocation(loc); - assert(lhs.getType().isa() && "not a boxchar"); - assert(rhs.getType().isa() && "not a boxchar"); auto lhsPair = builder.materializeCharacter(lhs); auto rhsPair = builder.materializeCharacter(rhs); return genRawCharCompare(converter, loc, cmp, lhsPair.first, lhsPair.second, diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index d44cd76d0018c..e14c142443bce 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -1247,6 +1247,7 @@ struct EmboxProcOpConversion : public FIROpConversion { } }; +// Code shared between insert_value and extract_value Ops. struct ValueOpCommon { static mlir::Attribute getValue(mlir::Value value) { auto defOp = value.getDefiningOp(); @@ -1257,6 +1258,45 @@ struct ValueOpCommon { llvm_unreachable("must be a constant op"); return {}; } + + // Translate the arguments pertaining to any multidimensional array to + // row-major order for LLVM-IR. + static void toRowMajor(llvm::SmallVectorImpl &attrs, + mlir::LLVM::LLVMType ty) { + assert(ty && "type is null"); + auto *llTy = ty.getUnderlyingType(); + const auto end = attrs.size(); + for (std::remove_const_t i = 0; i < end; ++i) { + if (auto *seq = dyn_cast(llTy)) { + const auto dim = getDimension(seq); + if (dim > 1) { + std::reverse(attrs.begin() + i, attrs.begin() + i + dim); + i += dim - 1; + } + llTy = getArrayElementType(seq); + } else if (auto *st = dyn_cast(llTy)) { + llTy = st->getElementType(attrs[i].cast().getInt()); + } else { + llvm_unreachable("index into invalid type"); + } + } + } + +private: + static unsigned getDimension(llvm::ArrayType *ty) { + unsigned result = 1; + for (auto *eleTy = dyn_cast(ty->getElementType()); eleTy; + eleTy = dyn_cast(eleTy->getElementType())) + ++result; + return result; + } + + static llvm::Type *getArrayElementType(llvm::ArrayType *ty) { + auto *eleTy = ty->getElementType(); + while (auto *arrTy = dyn_cast(eleTy)) + eleTy = arrTy->getElementType(); + return eleTy; + } }; /// Extract a subobject value from an ssa-value of aggregate type @@ -1274,6 +1314,7 @@ struct ExtractValueOpConversion SmallVector attrs; for (std::size_t i = 1, end{operands.size()}; i < end; ++i) attrs.push_back(getValue(operands[i])); + toRowMajor(attrs, lowering.unwrap(operands[0].getType())); auto position = mlir::ArrayAttr::get(attrs, extractVal.getContext()); rewriter.replaceOpWithNewOp( extractVal, ty, operands[0], position); @@ -1296,6 +1337,7 @@ struct InsertValueOpConversion SmallVector attrs; for (std::size_t i = 2, end{operands.size()}; i < end; ++i) attrs.push_back(getValue(operands[i])); + toRowMajor(attrs, lowering.unwrap(operands[0].getType())); auto position = mlir::ArrayAttr::get(attrs, insertVal.getContext()); rewriter.replaceOpWithNewOp( insertVal, ty, operands[0], operands[1], position); diff --git a/flang/test/Lower/array.f90 b/flang/test/Lower/array.f90 index c3a0e80ec5853..045e8fe51f65e 100644 --- a/flang/test/Lower/array.f90 +++ b/flang/test/Lower/array.f90 @@ -1,4 +1,5 @@ ! RUN: bbc -o - %s | FileCheck %s +! XFAIL: * subroutine s(i,j,k,ii,jj,kk,a1,a2,a3,a4,a5,a6,a7) integer i, j, k, ii, jj, kk diff --git a/flang/test/Lower/arraycopy.f90 b/flang/test/Lower/arraycopy.f90 new file mode 100644 index 0000000000000..2a61998003f06 --- /dev/null +++ b/flang/test/Lower/arraycopy.f90 @@ -0,0 +1,35 @@ + +! RUN: bbc %s -o - | FileCheck %s + +! CHECK-LABEL: _QPsub + +! F77 code for the array computation c = ((a + b) * c) + (b / 2.0). +! (Eventually, test that the temporary arrays are eliminated.) +subroutine sub(a,b,c,i,j,k) + real a(i,j,k), b(i,j,k), c(i,j,k) + real t1(i,j,k), t2(i,j,k) + integer i, j, k + integer r, s, t + + do t = 1, k + do s = 1, j + do r = 1, i + t1(r,s,t) = a(r,s,t) + b(r,s,t) + end do + end do + end do + do t = 1, k + do s = 1, j + do r = 1, i + t2(r,s,t) = t1(r,s,t) * c(r,s,t) + end do + end do + end do + do t = 1, k + do s = 1, j + do r = 1, i + c(r,s,t) = t2(r,s,t) + b(r,s,t) / 2.0 + end do + end do + end do +end subroutine sub diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 3dfb29553d004..cea8765e6033c 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -225,7 +225,7 @@ static void convertFortranSourceToMLIR( pm.addPass(mlir::createLowerToCFGPass()); // pm.addPass(fir::createMemToRegPass()); pm.addPass(fir::createCSEPass()); - pm.addPass(mlir::createCanonicalizerPass()); + //pm.addPass(mlir::createCanonicalizerPass()); if (emitLLVM) { // Continue to lower from MLIR down to LLVM IR. Emit LLVM and MLIR. From 23b7be39b4a71b5a264d472ec77e467d2708766e Mon Sep 17 00:00:00 2001 From: Varun Jayathirtha Date: Mon, 11 May 2020 10:41:31 -0700 Subject: [PATCH 0028/1017] Multi dimensional array initializers --- flang/test/Lower/global-init.f90 | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/flang/test/Lower/global-init.f90 b/flang/test/Lower/global-init.f90 index 812a0a080d7c4..ec92e1b2fe949 100644 --- a/flang/test/Lower/global-init.f90 +++ b/flang/test/Lower/global-init.f90 @@ -6,12 +6,16 @@ program bar integer, save :: my_data = 1 print *, my_data contains + +! CHECK-LABEL: func @_QPfoo subroutine foo() ! CHECK: fir.address_of(@[[name2:.*foo.*my_data]]) ! CHECK: fir.global @[[name2]] integer, save :: my_data = 2 print *, my_data + 1 end subroutine + +! CHECK-LABEL: func @_QPfoo2 subroutine foo2() ! CHECK: fir.address_of(@[[name3:.*foo2.*my_data]]) ! CHECK: fir.global @[[name3]] @@ -19,14 +23,20 @@ subroutine foo2() my_data = 4 print *, my_data end subroutine + +! CHECK-LABEL: func @_QPfoo3 subroutine foo3() -! CHECK: fir.address_of(@[[name4:.*foo3.*idata]]){{.*}}fir.array<5xi32> -! CHECK: fir.address_of(@[[name5:.*foo3.*rdata]]){{.*}}fir.array<3xf16> -! CHECK: fir.global @[[name4]]{{.*}}fir.array<5xi32> -! CHECK: fir.global @[[name5]]{{.*}}fir.array<3xf16> +! CHECK-DAG: fir.address_of(@[[name4:.*foo3.*idata]]){{.*}}fir.array<5xi32> +! CHECK-DAG: fir.global @[[name4]]{{.*}}fir.array<5xi32> +! CHECK-DAG: fir.address_of(@[[name5:.*foo3.*rdata]]){{.*}}fir.array<3xf16> +! CHECK-DAG: fir.global @[[name5]]{{.*}}fir.array<3xf16> +! CHECK-DAG: fir.address_of(@[[name6:.*foo3.*my_data]]){{.*}}fir.array<2x4xi64> +! CHECK-DAG: fir.global @[[name6]]{{.*}}fir.array<2x4xi64> integer*4, dimension(5), save :: idata = (/ (i*i, i=1,5) /) + integer*8, dimension(2, 10:13), save :: my_data = reshape((/1,2,3,4,5,6,7,8/), shape(my_data)) real*2, dimension(7:9), save :: rdata = (/100., 99., 98./) print *, rdata(9) print *, idata(3) + print *, my_data(1,11) end subroutine end program From 711ff48d8b1531c56ce28b47970cce5681884fdd Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Wed, 13 May 2020 02:11:47 -0700 Subject: [PATCH 0029/1017] Scalar character concatenation Inlined character concatenation implementation using fir.loop and fir.alloca to allocate the result. --- flang/LAPACK-bugs.txt | 6 +- flang/test/Lower/concat.f90 | 45 ++++++++++ ...end-to-end-character-assignment-driver.cpp | 84 ++++++++++++------- .../Lower/end-to-end-character-assignment.f90 | 12 ++- 4 files changed, 115 insertions(+), 32 deletions(-) create mode 100644 flang/test/Lower/concat.f90 diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt index 9da31215dc0f0..74419a2a56db1 100644 --- a/flang/LAPACK-bugs.txt +++ b/flang/LAPACK-bugs.txt @@ -11,14 +11,13 @@ ______________ loc("lapack/BLAS/SRC/srotmg.f":116:7): error: DATA statement is not handled. [Jean] - . ConvertExpr.cpp:379! - concat CHARs . lapack/INSTALL/second_INT_ETIME.f - 'etime' is not a known intrinsic procedure . lapack/INSTALL/dsecnd_INT_ETIME.f - Failed in semantics . lapack/INSTALL/second_INT_ETIME.f - Failed in semantics + . lapack/SRC/chla_transtype.f - type of return operand 0 ('!fir.array<1x!fir.char<1>>') doesn't match function result type ('!fir.char<1>') [unassigned] - . lapack/SRC/chla_transtype.f - type of return operand 0 ('!fir.array<1x!fir.char<1>>') doesn't match function result type ('!fir.char<1>') FIXED _____ @@ -34,3 +33,6 @@ _____ . ConvertExpr.cpp:193 - function type mismatch . 'std.call' op incorrect number of operands for callee + + . ConvertExpr.cpp:266 - character comparison + . ConvertExpr.cpp:379! - concat CHARs diff --git a/flang/test/Lower/concat.f90 b/flang/test/Lower/concat.f90 new file mode 100644 index 0000000000000..fe844307fef80 --- /dev/null +++ b/flang/test/Lower/concat.f90 @@ -0,0 +1,45 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test character scalar concatenation lowering + +! CHECK-LABEL: concat_1 +subroutine concat_1(a, b) + character(*) :: a, b + ! CHECK: call @{{.*}}BeginExternalListOutput + ! CHECK-DAG: %[[a:.*]]:2 = fir.unboxchar %arg0 + ! CHECK-DAG: %[[b:.*]]:2 = fir.unboxchar %arg1 + + print *, a // b + ! Concatenation + + ! CHECK: %[[len:.*]] = addi %[[a]]#1, %[[b]]#1 + ! CHECK: %[[temp:.*]] = fir.alloca !fir.char<1>, %[[len]] + + ! CHECK-DAG: %[[c0:.*]] = constant 0 + ! CHECK-DAG: %[[c1:.*]] = constant 1 + ! CHECK-DAG: %[[count:.*]] = subi %[[a]]#1, %[[c1]] + ! CHECK: fir.do_loop %[[index:.*]] = %[[c0]] to %[[count]] step %[[c1]] { + ! CHECK: %[[a_addr:.*]] = fir.coordinate_of %[[a]]#0, %[[index]] + ! CHECK: %[[a_elt:.*]] = fir.load %[[a_addr]] + ! CHECK: %[[temp_addr:.*]] = fir.coordinate_of %[[temp]], %[[index]] + ! CHECK: fir.store %[[a_elt]] to %[[temp_addr]] + ! CHECK: } + + ! CHECK: %[[c1_0:.*]] = constant 1 + ! CHECK: %[[count2:.*]] = subi %[[len]], %[[c1_0]] + ! CHECK: fir.do_loop %[[index2:.*]] = %[[a]]#1 to %[[count2]] step %[[c1_0]] { + ! CHECK: %[[b_index:.*]] = subi %[[index]], %[[a]]#1 + ! CHECK: %[[b_addr:.*]] = fir.coordinate_of %[[b]]#0, %[[b_index]] + ! CHECK: %[[b_elt:.*]] = fir.load %[[b_addr]] + ! CHECK: %[[temp_addr2:.*]] = fir.coordinate_of %[[temp]], %[[index2]] + ! CHECK: fir.store %[[b_elt]] to %[[temp_addr2]] + ! CHECK: } + + ! CHECK: %[[embox_temp:.*]] = fir.emboxchar %[[temp]], %[[len]] + + ! IO runtime call + ! CHECK: %[[result:.*]]:2 = fir.unboxchar %[[embox_temp]] + ! CHECK-DAG: %[[raddr:.*]] = fir.convert %[[result]]#0 + ! CHECK-DAG: %[[rlen:.*]] = fir.convert %[[result]]#1 + ! CHECK: call @{{.*}}OutputAscii(%{{.*}}, %[[raddr]], %[[rlen]]) +end subroutine diff --git a/flang/test/Lower/end-to-end-character-assignment-driver.cpp b/flang/test/Lower/end-to-end-character-assignment-driver.cpp index 6e3a3c9ba4668..e5b324bd19cca 100644 --- a/flang/test/Lower/end-to-end-character-assignment-driver.cpp +++ b/flang/test/Lower/end-to-end-character-assignment-driver.cpp @@ -26,15 +26,15 @@ struct Fchar { LenT len; }; -template using SubF18 = void (*)(Fchar, Fchar, T...); -template +template using SubF18 = void (*)(Fchar, Fchar, T...); +template using SubF77 = void (*)(char *, char *, T..., LenT, LenT); -template +template void CallSubroutine(SubF18 f, Fchar s1, Fchar s2, T... args) { f(s1, s2, args...); } -template +template void CallSubroutine(SubF77 f, Fchar s1, Fchar s2, T... args) { f(s1.data, s2.data, args..., s1.len, s2.len); } @@ -42,31 +42,31 @@ void CallSubroutine(SubF77 f, Fchar s1, Fchar s2, T... args) { // Define structures to create and manipulate Fortran Character // A canary is always added at the end of character storage so that // invalid overwrites can be detected. -template struct CharStorage {}; -template<> struct CharStorage<1> { +template struct CharStorage {}; +template <> struct CharStorage<1> { using Type = std::string; static const Type canary; }; const CharStorage<1>::Type CharStorage<1>::canary{"_CaNaRy"}; -template<> struct CharStorage<2> { +template <> struct CharStorage<2> { using Type = std::u16string; static const Type canary; }; const CharStorage<2>::Type CharStorage<2>::canary{u"_CaNaRy"}; -template<> struct CharStorage<4> { +template <> struct CharStorage<4> { using Type = std::u32string; static const Type canary; }; const CharStorage<4>::Type CharStorage<4>::canary{U"_CaNaRy"}; -template struct FcharData { +template struct FcharData { using String = typename CharStorage::Type; using CharT = typename String::value_type; FcharData(String str) - : data{str + CharStorage::canary}, len{static_cast( - str.length())} {} + : data{str + CharStorage::canary}, len{static_cast( + str.length())} {} Fchar getFchar() { const char *addr{reinterpret_cast(data.data())}; return Fchar{const_cast(addr), len}; @@ -98,10 +98,10 @@ template struct FcharData { } String data; - LenT len; // may differ from string length for test purposes + LenT len; // may differ from string length for test purposes }; -template +template bool Check(const FcharData &test, const FcharData &ref, const std::string &desc) { if (test.data != ref.data) { @@ -115,7 +115,7 @@ bool Check(const FcharData &test, const FcharData &ref, // Call compiled test subroutine and compare variable afterwards with a // reference. Compare against result from reference subroutine. -template +template bool TestSubroutine(const std::string &testName, SubF18 fooTest, SubF18 fooRef, const FcharData &s1, const FcharData &s2, T... otherArgs) { @@ -134,7 +134,7 @@ bool TestSubroutine(const std::string &testName, SubF18 fooTest, } // Compare against precomputed results. -template +template bool TestSubroutine(const std::string &testName, SubF18 fooTest, const FcharData &s1, const FcharData &refS1, const FcharData &s2, const FcharData &refS2, T... otherArgs) { @@ -150,21 +150,21 @@ bool TestSubroutine(const std::string &testName, SubF18 fooTest, // Test driver code (could maybe generated somehow) // String data to be used as inputs during the tests. -template struct Inputs { static FcharData s1, s2, s3; }; +template struct Inputs { static FcharData s1, s2, s3; }; -template<> FcharData<1> Inputs<1>::s1{"aw*lSe4frliaw"}; -template<> FcharData<1> Inputs<1>::s2{"8\n e7t4$%&52Z"}; -template<> FcharData<1> Inputs<1>::s3{"quAli64^&$*#$8gl6"}; +template <> FcharData<1> Inputs<1>::s1{"aw*lSe4frliaw"}; +template <> FcharData<1> Inputs<1>::s2{"8\n e7t4$%&52Z"}; +template <> FcharData<1> Inputs<1>::s3{"quAli64^&$*#$8gl6"}; -template<> FcharData<2> Inputs<2>::s1{u"\u4e4dhy7&3o8%\u4e24"}; -template<> FcharData<2> Inputs<2>::s2{u"\u4f60\u4e0d\u662f F18 !\uff1f"}; -template<> +template <> FcharData<2> Inputs<2>::s1{u"\u4e4dhy7&3o8%\u4e24"}; +template <> FcharData<2> Inputs<2>::s2{u"\u4f60\u4e0d\u662f F18 !\uff1f"}; +template <> FcharData<2> Inputs<2>::s3{ u"\u4f60\u597d\uff0c\u6211\u66df F18 ! \u4f60\u5462\uff1f"}; -template<> FcharData<4> Inputs<4>::s1{U"\u4e4dhy7&3o8%\u4e24"}; -template<> FcharData<4> Inputs<4>::s2{U"\u4f60\u4e0d\u662f F18 !\uff1f"}; -template<> +template <> FcharData<4> Inputs<4>::s1{U"\u4e4dhy7&3o8%\u4e24"}; +template <> FcharData<4> Inputs<4>::s2{U"\u4f60\u4e0d\u662f F18 !\uff1f"}; +template <> FcharData<4> Inputs<4>::s3{ U"\u4f60\u597d\uff0c\u6211\u66df F18 ! \u4f60\u5462\uff1f"}; @@ -181,7 +181,7 @@ void _QPassign2(Fchar, Fchar); void _QPassign4(Fchar, Fchar); } -template +template void TestNormalAssignement(Func testedSub, int &tests, int &passed) { auto &s1{Inputs::s1}; auto &s2{Inputs::s2}; @@ -226,7 +226,7 @@ void _QPassign_substring2(Fchar, Fchar, int *, int *); void _QPassign_substring4(Fchar, Fchar, int *, int *); } -template +template void TestSubstringAssignement(Func testedSub, int &tests, int &passed) { auto &s1{Inputs::s3}; auto &s2{Inputs::s1}; @@ -262,7 +262,7 @@ void _QPassign_overlap2(Fchar, Fchar, int *); void _QPassign_overlap4(Fchar, Fchar, int *); } -template +template void TestOverlappingAssignement(Func testedSub, int &tests, int &passed) { auto &s1{Inputs::s1}; auto &s2{Inputs::s2}; @@ -295,7 +295,7 @@ void _QPassign_spec_expr_len2(Fchar s1, Fchar s2, int *l1, int *l2); void _QPassign_spec_expr_len4(Fchar s1, Fchar s2, int *l1, int *l2); } -template +template void TestSpecExprLenAssignement(Func testedSub, int &tests, int &passed) { auto &s1{Inputs::s1}; auto &s2{Inputs::s2}; @@ -333,6 +333,30 @@ void TestSpecExprLenAssignement(Func testedSub, int &tests, int &passed) { } } +// Test concatenation +extern "C" { +// SUBROUTINE concat1(s1, s2) +// CHARACTER(*) :: s1, s2 +// s2 = s1 // " another piece of string" +// END SUBROUTINE +void _QPconcat1(Fchar s1, Fchar s2); +} + +template +void TestConcat(Func testedSub, int &tests, int &passed) { + auto &s1{Inputs::s1}; + using ST = typename CharStorage::Type; + ST appended = " another piece of string"; + FcharData output{ST(s1.len + appended.length(), ' ')}; + + const std::string &desc{"concatenation"}; + FcharData expected{s1.data.substr(0, s1.len) + appended}; + tests++; + if (TestSubroutine(desc, testedSub, s1, s1, output, /* expect*/ expected)) { + passed++; + } +} + int main(int, char **) { int tests{0}, passed{0}; @@ -352,6 +376,8 @@ int main(int, char **) { TestSpecExprLenAssignement<2>(_QPassign_spec_expr_len2, tests, passed); TestSpecExprLenAssignement<4>(_QPassign_spec_expr_len4, tests, passed); + TestConcat<1>(_QPconcat1, tests, passed); + std::cout << passed << " tests passed out of " << tests << std::endl; return tests == passed ? 0 : -1; } diff --git a/flang/test/Lower/end-to-end-character-assignment.f90 b/flang/test/Lower/end-to-end-character-assignment.f90 index 444993ad32984..e2f93547ed1d7 100644 --- a/flang/test/Lower/end-to-end-character-assignment.f90 +++ b/flang/test/Lower/end-to-end-character-assignment.f90 @@ -1,4 +1,4 @@ -! RUN: bbc -emit-llvm -o - %s | tco | llc | as -o %t +! RUN: bbc -emit-llvm -o - %s | tco | llc --relocation-model=pic | as -o %t ! RUN: %CXX -std=c++17 %t %S/end-to-end-character-assignment-driver.cpp ! RUN: ./a.out @@ -74,3 +74,13 @@ subroutine assign_spec_expr_len4(s1, s2, l1, l2) character(l2, 4) :: s2 s1 = s2 end subroutine + +! Test string concatenation +subroutine concat1(s1, s2) + character(*) :: s1, s2 + s2 = s1 // " another piece of string" +end subroutine +! FIXME: concat test for other kind not written because there constant +! character with kind !=1 have issues (most likely due to the presence null +! bytes in the middle of the string. This has nothing to do with concat it +! just prevent running the tests. From 830c09535daf2a0047082e7c113569fb6f1e866f Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 15 May 2020 13:58:48 -0700 Subject: [PATCH 0030/1017] rebase fallout. handles changes from renaming things in MLIR. --- flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp | 2 +- flang/lib/Optimizer/Transforms/RaiseToAffine.cpp | 2 +- flang/lib/Optimizer/Transforms/RewriteLoop.cpp | 8 ++++---- flang/tools/bbc/bbc.cpp | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp index 47bdbc9028449..a752730a4ac16 100644 --- a/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp +++ b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp @@ -148,7 +148,7 @@ class ControlFlowLoweringPass patterns.insert(&getContext()); mlir::populateAffineToStdConversionPatterns(patterns, &getContext()); mlir::ConversionTarget target(getContext()); - target.addLegalDialect(); target.addIllegalOp(); diff --git a/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp b/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp index 24513d6143af1..0f53b12c5a616 100644 --- a/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp +++ b/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp @@ -58,7 +58,7 @@ class AffineDialectPromotion patterns.insert(context); mlir::ConversionTarget target = *context; target.addLegalDialect(); // target.addDynamicallyLegalOp(); diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 8b06e13fcd26e..f329d010e6327 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -45,7 +45,7 @@ class LoopLoopConv : public mlir::OpRewritePattern { assert(low && high && step); // ForOp has different bounds semantics. Adjust upper bound. auto adjustUp = rewriter.create(loc, high, step); - auto f = rewriter.create(loc, low, adjustUp, step); + auto f = rewriter.create(loc, low, adjustUp, step); f.region().getBlocks().clear(); rewriter.inlineRegionBefore(loop.region(), f.region(), f.region().end()); rewriter.eraseOp(loop); @@ -64,7 +64,7 @@ class LoopWhereConv : public mlir::OpRewritePattern { auto loc = where.getLoc(); bool hasOtherRegion = !where.otherRegion().empty(); auto cond = where.condition(); - auto ifOp = rewriter.create(loc, cond, hasOtherRegion); + auto ifOp = rewriter.create(loc, cond, hasOtherRegion); rewriter.inlineRegionBefore(where.whereRegion(), &ifOp.thenRegion().back()); ifOp.thenRegion().back().erase(); if (hasOtherRegion) { @@ -85,7 +85,7 @@ class LoopResultConv : public mlir::OpRewritePattern { mlir::LogicalResult matchAndRewrite(fir::ResultOp op, mlir::PatternRewriter &rewriter) const override { - rewriter.replaceOpWithNewOp(op); + rewriter.replaceOpWithNewOp(op); return success(); } }; @@ -182,7 +182,7 @@ class LoopDialectConversion patterns2.insert(context); mlir::ConversionTarget target = *context; target.addLegalDialect(); // apply the patterns diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index cea8765e6033c..04b8b0813f9e2 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -32,7 +32,7 @@ #include "flang/Semantics/expression.h" #include "flang/Semantics/semantics.h" #include "flang/Semantics/unparse-with-symbols.h" -#include "mlir/Conversion/LoopToStandard/ConvertLoopToStandard.h" +#include "mlir/Conversion/SCFToStandard/SCFToStandard.h" #include "mlir/IR/MLIRContext.h" #include "mlir/IR/Module.h" #include "mlir/Parser.h" From c160cb4d687d3e4077595e5cd794ac38cf527484 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 15 May 2020 18:57:00 -0700 Subject: [PATCH 0031/1017] ignore compiler directives for now. this change exposes a problem in PFT. --- flang/lib/Lower/Bridge.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index f92e7d3d801b2..f9f7edf8bb33c 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -968,7 +968,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::CompilerDirective &) { - TODO(); + mlir::emitWarning(toLocation(), "ignoring all compiler directives"); } void genFIR(Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPConstruct &) { From af97ae4249d8e8ead3b2a91e2cedae00197b6a99 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 1 May 2020 16:13:23 -0700 Subject: [PATCH 0032/1017] Initial work on internal boxing that starts threading extended box values through genval. The purpose of these changes is to move from the present "single Value" model to a "boxed value" model. To lower arrays and derived types will require the bridge to track more information. --- flang/include/flang/Lower/ConvertExpr.h | 20 +- .../include/flang/Optimizer/Dialect/FIROps.td | 18 ++ flang/lib/Lower/Bridge.cpp | 283 +++++++++++++----- flang/lib/Lower/Intrinsics.cpp | 2 +- flang/tools/bbc/bbc.cpp | 3 +- 5 files changed, 240 insertions(+), 86 deletions(-) diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h index 453fbfdcc1f72..93e15475852db 100644 --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -5,11 +5,17 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +/// +/// Implements the conversion from Fortran::evaluate::Expr trees to FIR. +/// +/// [Coding style](https://llvm.org/docs/CodingStandards.html) +/// +//===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_CONVERT_EXPR_H #define FORTRAN_LOWER_CONVERT_EXPR_H -/// [Coding style](https://llvm.org/docs/CodingStandards.html) +#include "flang/Lower/Support/BoxValue.h" namespace mlir { class Location; @@ -51,6 +57,12 @@ mlir::Value createSomeExpression(mlir::Location loc, const evaluate::Expr &expr, SymMap &symMap); +/// Create an extended expression value. +ExValue +createSomeExtendedExpression(mlir::Location loc, AbstractConverter &converter, + const evaluate::Expr &expr, + SymMap &symMap, llvm::ArrayRef lcvs); + /// Create an address. /// Lowers `expr` to the FIR dialect of MLIR. The expression must be an entity /// and the address of the entity is returned. @@ -58,6 +70,12 @@ mlir::Value createSomeAddress(mlir::Location loc, AbstractConverter &converter, const evaluate::Expr &expr, SymMap &symMap); +/// Create an extended expression address. +ExValue +createSomeExtendedAddress(mlir::Location loc, AbstractConverter &converter, + const evaluate::Expr &expr, + SymMap &symMap, llvm::ArrayRef lcvs); + } // namespace lower } // namespace Fortran diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td index a38630b2a04f0..cf07a9cd414f9 100644 --- a/flang/include/flang/Optimizer/Dialect/FIROps.td +++ b/flang/include/flang/Optimizer/Dialect/FIROps.td @@ -2190,6 +2190,24 @@ def fir_InsertOnRangeOp : fir_OneResultOp<"insert_on_range", [NoSideEffect]> { }]; } +def fir_InsertOnRangeOp : fir_OneResultOp<"insert_on_range", [NoSideEffect]> { + let summary = "insert sub-value into a range on an existing sequence"; + + let description = [{ + Insert a constant value into an entity with an array type. Returns a + new ssa value where the range of offsets from the original array have been + replaced with the constant. The result is an array type entity. + }]; + + let arguments = (ins fir_SequenceType:$seq, AnyType:$val, + Index:$start, Index:$end); + let results = (outs fir_SequenceType); + + let assemblyFormat = [{ + operands attr-dict `:` functional-type(operands, results) + }]; +} + def fir_LenParamIndexOp : fir_OneResultOp<"len_param_index", [NoSideEffect]> { let summary = "create a field index value from a LEN type parameter identifier"; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index f9f7edf8bb33c..e8748b094fd49 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -218,7 +218,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { fir::NameUniquer &uniquer) : mlirContext{bridge.getMLIRContext()}, cooked{bridge.getCookedSource()}, module{bridge.getModule()}, defaults{bridge.getDefaultKinds()}, - kindMap{bridge.getKindMap()}, uniquer{uniquer} {} + kindMap{bridge.getKindMap()}, uniquer{uniquer}, + getShape{[&](const Fortran::lower::SomeExpr &expr) { + auto foldCtx = bridge.createFoldingContext(); + return Fortran::evaluate::GetShape(foldCtx, expr); + }} {} virtual ~FirConverter() = default; /// Convert the PFT to FIR @@ -1324,69 +1328,148 @@ class FirConverter : public Fortran::lower::AbstractConverter { noRuntimeSupport("LOCK"); } + fir::LoopOp createLoopNest(llvm::SmallVectorImpl &lcvs, + const Fortran::evaluate::Shape &shape) { + llvm::SmallVector extents; + auto idxTy = builder->getIndexType(); + auto zero = builder->createIntegerConstant(idxTy, 0); + auto one = builder->createIntegerConstant(idxTy, 1); + auto loc = toLocation(); + for (auto s : shape) { + if (s.has_value()) { + auto ub = builder->createConvert( + loc, idxTy, + genExprValue(Fortran::evaluate::AsGenericExpr(std::move(*s)))); + auto up = builder->create(loc, ub, one); + extents.push_back(up); + } else { + TODO(); + } + } + // Iteration space is created with outermost columns, innermost rows + std::reverse(extents.begin(), extents.end()); + fir::LoopOp inner; + auto insPt = builder->saveInsertionPoint(); + for (auto e : extents) { + if (inner) + builder->setInsertionPointToStart(inner.getBody()); + auto loop = builder->create(loc, zero, e, one); + lcvs.push_back(loop.getInductionVar()); + if (!inner) + insPt = builder->saveInsertionPoint(); + inner = loop; + } + builder->restoreInsertionPoint(insPt); + return inner; + } + + mlir::OpBuilder::InsertPoint + genPrelude(llvm::SmallVectorImpl &lcvs, bool isHeap, + const Fortran::lower::SomeExpr &lhs, + const Fortran::lower::SomeExpr &rhs, + const Fortran::evaluate::Shape &shape) { + if (isHeap) { + // does this require a dealloc and realloc? + } + if (/*needToMakeCopies*/ false) { + // make copies + } + // create the loop nest + auto innerLoop = createLoopNest(lcvs, shape); + std::reverse(lcvs.begin(), lcvs.end()); + assert(innerLoop); + auto insPt = builder->saveInsertionPoint(); + // move insertion point inside loop nest + builder->setInsertionPointToStart(innerLoop.getBody()); + return insPt; + } + + void genPostlude(bool isHeap, const Fortran::lower::SomeExpr &lhs, + const Fortran::lower::SomeExpr &rhs, + mlir::OpBuilder::InsertPoint insPt) { + builder->restoreInsertionPoint(insPt); + if (/*copiesWereMade*/ false) { + // free buffers + } + } + + Fortran::lower::ExValue genExprEleValue(const Fortran::lower::SomeExpr &expr, + llvm::ArrayRef lcvs) { + return createSomeExtendedExpression(toLocation(), *this, expr, localSymbols, + lcvs); + } + + Fortran::lower::ExValue genExprEleAddr(const Fortran::lower::SomeExpr &expr, + llvm::ArrayRef lcvs) { + return createSomeExtendedAddress(toLocation(), *this, expr, localSymbols, + lcvs); + } + /// Shared for both assignments and pointer assignments. - void genFIR(const Fortran::evaluate::Assignment &assignment) { + void genFIR(const Fortran::evaluate::Assignment &assign) { std::visit( Fortran::common::visitors{ [&](const Fortran::evaluate::Assignment::Intrinsic &) { + auto loc = toLocation(); const auto *sym = - Fortran::evaluate::UnwrapWholeSymbolDataRef(assignment.lhs); - if (sym && Fortran::semantics::IsAllocatable(*sym)) { - // Assignment of allocatable are more complex, the lhs - // may need to be deallocated/reallocated. - // See Fortran 2018 10.2.1.3 p3 - TODO(); - } else if (sym && Fortran::semantics::IsPointer(*sym)) { - // Target of the pointer must be assigned. - // See Fortran 2018 10.2.1.3 p2 - auto lhsType = assignment.lhs.GetType(); - assert(lhsType && "lhs cannot be typeless"); - if (isNumericScalarCategory(lhsType->category())) { - auto val = genExprValue(assignment.rhs); - auto addr = genExprValue(assignment.lhs); - auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); - auto cast = - builder->convertWithSemantics(toLocation(), toTy, val); - builder->create(toLocation(), cast, addr); - } else if (isCharacterCategory(lhsType->category())) { - TODO(); - } else { - assert(lhsType->category() == - Fortran::common::TypeCategory::Derived); - TODO(); - } - } else if (assignment.lhs.Rank() > 0) { + Fortran::evaluate::UnwrapWholeSymbolDataRef(assign.lhs); + // Assignment of allocatable are more complex, the lhs may need to + // be deallocated/reallocated. See Fortran 2018 10.2.1.3 p3 + const bool isHeap = + sym && Fortran::semantics::IsAllocatable(*sym); + // Target of the pointer must be assigned. See Fortran + // 2018 10.2.1.3 p2 + const bool isPointer = sym && Fortran::semantics::IsPointer(*sym); + auto lhsType = assign.lhs.GetType(); + assert(lhsType && "lhs cannot be typeless"); + + if (assign.lhs.Rank() > 0 || (assign.rhs.Rank() > 0 && isHeap)) { // Array assignment // See Fortran 2018 10.2.1.3 p5, p6, and p7 + auto shape = getShape(assign.lhs); + assert(shape.has_value() && "array without shape"); + llvm::SmallVector lcvs; + auto insPt = + genPrelude(lcvs, isHeap, assign.lhs, assign.rhs, *shape); + auto valBox = genExprEleValue(assign.rhs, lcvs); + auto addrBox = genExprEleAddr(assign.lhs, lcvs); + builder->create(loc, fir::getBase(valBox), + fir::getBase(addrBox)); + genPostlude(isHeap, assign.lhs, assign.rhs, insPt); + return; + } + + // Scalar assignment + if (isHeap) { + TODO(); + } + if (isNumericScalarCategory(lhsType->category())) { + // Fortran 2018 10.2.1.3 p8 and p9 + // Conversions should have been inserted by semantic analysis, + // but they can be incorrect between the rhs and lhs. Correct + // that here. + mlir::Value addr = isPointer ? genExprValue(assign.lhs) + : genExprAddr(assign.lhs); + auto val = genExprValue(assign.rhs); + auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); + auto cast = builder->convertWithSemantics(loc, toTy, val); + builder->create(loc, cast, addr); + return; + } + if (isCharacterCategory(lhsType->category())) { + // Fortran 2018 10.2.1.3 p10 and p11 + // Generating value for lhs to get fir.boxchar. + auto lhs = genExprValue(assign.lhs); + auto rhs = genExprValue(assign.rhs); + builder->createAssign(lhs, rhs); + return; + } + if (lhsType->category() == + Fortran::common::TypeCategory::Derived) { + // Fortran 2018 10.2.1.3 p12 and p13 TODO(); - } else { - // Scalar assignments - auto lhsType = assignment.lhs.GetType(); - assert(lhsType && "lhs cannot be typeless"); - if (isNumericScalarCategory(lhsType->category())) { - // Fortran 2018 10.2.1.3 p8 and p9 - // Conversions should have been inserted by semantic analysis, - // but they can be incorrect between the rhs and lhs. Correct - // that here. - auto loc = toLocation(); - auto addr = genExprAddr(assignment.lhs); - auto val = genExprValue(assignment.rhs); - auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); - auto cast = builder->convertWithSemantics(loc, toTy, val); - builder->create(loc, cast, addr); - } else if (isCharacterCategory(lhsType->category())) { - // Fortran 2018 10.2.1.3 p10 and p11 - // Generating value for lhs to get fir.boxchar. - auto lhs{genExprValue(assignment.lhs)}; - auto rhs{genExprValue(assignment.rhs)}; - builder->createAssign(lhs, rhs); - } else { - assert(lhsType->category() == - Fortran::common::TypeCategory::Derived); - // Fortran 2018 10.2.1.3 p12 and p13 - TODO(); - } } + llvm_unreachable("unknown category"); }, [&](const Fortran::evaluate::ProcedureRef &) { // Defined assignment: call ProcRef @@ -1401,7 +1484,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { TODO(); }, }, - assignment.u); + assign.u); } void genFIR(Fortran::lower::pft::Evaluation &, @@ -1642,7 +1725,38 @@ class FirConverter : public Fortran::lower::AbstractConverter { } auto addrOf = builder->create( toLocation(), global.resultType(), global.getSymbol()); - addSymbol(sym, addrOf); + SymbolIndexAnalyzer sia(sym); + sia.analyze(); + if (sia.isTrivial()) { + addSymbol(sym, addrOf); + return; + } + auto idxTy = builder->getIndexType(); + mlir::Value len; + if (sia.isChar) { + auto c = sia.getCharLenConst(); + assert(c.hasValue()); + len = builder->createIntegerConstant(idxTy, *c); + } + llvm::SmallVector extents; + llvm::SmallVector lbounds; + if (sia.isArray) { + assert(sia.staticSize); + for (auto i : sia.staticShape) + extents.push_back(builder->createIntegerConstant(idxTy, i)); + if (!sia.lboundIsAllOnes()) + for (auto i : sia.staticLBound) + lbounds.push_back(builder->createIntegerConstant(idxTy, i)); + } + if (sia.isChar && sia.isArray) { + localSymbols.addCharSymbolWithBounds(sym, addrOf, len, extents, + lbounds); + } else if (sia.isChar) { + localSymbols.addCharSymbol(sym, addrOf, len); + } else { + assert(sia.isArray); + localSymbols.addSymbolWithBounds(sym, addrOf, extents, lbounds); + } } else { TODO(); // Procedure pointer } @@ -1745,11 +1859,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (sia.isArray) { // if object is an array process the lower bound and extent values - llvm::SmallVector bounds; + llvm::SmallVector extents; + llvm::SmallVector lbounds; mustBeDummy = !isExplicitShape(sym); if (sia.staticSize) { // object shape is constant - auto castTy = fir::ReferenceType::get(genType(sym)); + auto castTy = builder->getRefType(genType(sym)); if (addr) addr = builder->createConvert(loc, castTy, addr); if (sia.lboundIsAllOnes()) { @@ -1778,7 +1893,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } else { // cast to the known constant parts from the declaration - auto castTy = fir::ReferenceType::get(genType(sym)); + auto castTy = builder->getRefType(genType(sym)); if (addr) { // XXX: special handling for boxchar; see proviso above if (auto box = @@ -1792,7 +1907,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { for (const auto &i : llvm::zip(sia.staticLBound, sia.staticShape)) { auto fst = builder->createIntegerConstant(idxTy, std::get<0>(i)); auto snd = builder->createIntegerConstant(idxTy, std::get<1>(i)); - bounds.emplace_back(fst, snd); + lbounds.emplace_back(fst); + extents.emplace_back(snd); } // default array case: populate `bounds` with lower and extent values @@ -1808,50 +1924,42 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto one = builder->createIntegerConstant(ty, 1); auto sz = builder->create(loc, ty, diff, one); auto idx = builder->createConvert(loc, idxTy, sz); - bounds.emplace_back(lb, idx); + lbounds.emplace_back(lb); + extents.emplace_back(idx); continue; } if (low && spec->ubound().isAssumed()) { // An assumed size array. The extent is not computed. auto lb = genExprValue(Fortran::semantics::SomeExpr{*low}); - bounds.emplace_back(lb, mlir::Value{}); + lbounds.emplace_back(lb); + extents.emplace_back(mlir::Value{}); } break; } - auto unzipInto = - [&](llvm::SmallVectorImpl &shape, - llvm::ArrayRef bounds) { - std::for_each(bounds.begin(), bounds.end(), [&](const auto &pair) { - mlir::Value second; - std::tie(std::ignore, second) = pair; - shape.push_back(second); - }); - }; if (sia.isChar) { if (isDummy) { - localSymbols.addCharSymbolWithBounds(sym, addr, len, bounds, true); + localSymbols.addCharSymbolWithBounds(sym, addr, len, extents, lbounds, + true); return; } // local CHARACTER array with computed bounds assert(!mustBeDummy); llvm::SmallVector shape; shape.push_back(len); - unzipInto(shape, bounds); + shape.append(extents.begin(), extents.end()); auto local = createNewLocal(loc, sym, shape); - localSymbols.addCharSymbolWithBounds(sym, local, len, bounds); + localSymbols.addCharSymbolWithBounds(sym, local, len, extents, lbounds); return; } if (isDummy) { - localSymbols.addSymbolWithBounds(sym, addr, bounds, true); + localSymbols.addSymbolWithBounds(sym, addr, extents, lbounds, true); return; } // local array with computed bounds assert(!mustBeDummy); - llvm::SmallVector shape; - unzipInto(shape, bounds); - auto local = createNewLocal(loc, sym, shape); - localSymbols.addSymbolWithBounds(sym, local, bounds); + auto local = createNewLocal(loc, sym, extents); + localSymbols.addSymbolWithBounds(sym, local, extents, lbounds); return; } @@ -2039,15 +2147,23 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::parser::CookedSource *cooked; mlir::ModuleOp &module; const Fortran::common::IntrinsicTypeDefaultKinds &defaults; - Fortran::lower::FirOpBuilder *builder = nullptr; const fir::KindMapping &kindMap; fir::NameUniquer &uniquer; + std::function( + const Fortran::lower::SomeExpr &)> + getShape; + Fortran::lower::FirOpBuilder *builder = nullptr; Fortran::lower::SymMap localSymbols; Fortran::parser::CharBlock currentPosition; }; } // namespace +Fortran::evaluate::FoldingContext +Fortran::lower::LoweringBridge::createFoldingContext() const { + return {getDefaultKinds(), getIntrinsicTable()}; +} + void Fortran::lower::LoweringBridge::lower( const Fortran::parser::Program &prg, fir::NameUniquer &uniquer, const Fortran::semantics::SemanticsContext &semanticsContext) { @@ -2066,8 +2182,9 @@ void Fortran::lower::LoweringBridge::parseSourceFile(llvm::SourceMgr &srcMgr) { Fortran::lower::LoweringBridge::LoweringBridge( const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, - const Fortran::parser::CookedSource *cooked) - : defaultKinds{defaultKinds}, cooked{cooked}, + const Fortran::evaluate::IntrinsicProcTable &intrinsics, + const Fortran::parser::CookedSource &cooked) + : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked}, context{std::make_unique()}, kindMap{context.get()} { module = std::make_unique( mlir::ModuleOp::create(mlir::UnknownLoc::get(context.get()))); diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index 7b36c50a25de6..94335bd83c892 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -728,7 +728,7 @@ mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, auto dataAndLen = builder.createUnboxChar(arg); auto charType = fir::CharacterType::get( builder.getContext(), builder.getCharacterKind(arg.getType())); - auto refType = fir::ReferenceType::get(charType); + auto refType = builder.getRefType(charType); auto charAddr = builder.createHere(refType, dataAndLen.first); auto charVal = builder.createHere(charType, charAddr); return builder.createHere(resultType, charVal); diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 04b8b0813f9e2..7c396ed30087c 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -198,7 +198,8 @@ static void convertFortranSourceToMLIR( // MLIR+FIR fir::NameUniquer nameUniquer; auto burnside = Fortran::lower::LoweringBridge::create( - semanticsContext.defaultKinds(), &parsing.cooked()); + semanticsContext.defaultKinds(), semanticsContext.intrinsics(), + parsing.cooked()); burnside.lower(parseTree, nameUniquer, semanticsContext); mlir::ModuleOp mlirModule = burnside.getModule(); std::error_code ec; From c9ac7f9fd0d293841967b67bfd6daa1d2ffdbd02 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 18 May 2020 15:14:56 -0700 Subject: [PATCH 0033/1017] remove the LAPACK-bugs.txt file. We're near the end of bugs and missing features to support the F77 version of LAPACK. Removing this file in favor of opening Issues on github to track any new problems. fixes issue #74 https://github.com/flang-compiler/f18-llvm-project/issues/74 fix bug #78 https://github.com/flang-compiler/f18-llvm-project/issues/78 Another crash apparently related to issue #74. Add check for empty list. --- flang/LAPACK-bugs.txt | 38 -------------------------------------- flang/lib/Lower/Bridge.cpp | 5 +++-- 2 files changed, 3 insertions(+), 40 deletions(-) delete mode 100644 flang/LAPACK-bugs.txt diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt deleted file mode 100644 index 74419a2a56db1..0000000000000 --- a/flang/LAPACK-bugs.txt +++ /dev/null @@ -1,38 +0,0 @@ -NEED ATTENTION -______________ - -[Eric] - . Bridge.cpp:1361 - array assignment - . lapack/SRC/sbdsvdx.f - ConvertExpr.cpp:654! - Ev::Triplet - -[Varun/Peter] - - . DATA statement - loc("lapack/BLAS/SRC/srotmg.f":116:7): error: DATA statement is not handled. - -[Jean] - . lapack/INSTALL/second_INT_ETIME.f - 'etime' is not a known intrinsic procedure - . lapack/INSTALL/dsecnd_INT_ETIME.f - Failed in semantics - . lapack/INSTALL/second_INT_ETIME.f - Failed in semantics - . lapack/SRC/chla_transtype.f - type of return operand 0 ('!fir.array<1x!fir.char<1>>') doesn't match function result type ('!fir.char<1>') - -[unassigned] - - -FIXED -_____ - - . lapack/SRC/cgbsvx.f - type mismatch for bb argument #_ of successor #_ - . lapack/SRC/sgtsv.f - error: unreachable blocks were not converted - . lapack/SRC/dsyevd_2stage.f - operation with block successors must terminate its parent block - . ConvertExpr.cpp:266 - character comparison - . error: 'llvm.mlir.global' op initializer region type '!llvm.i1' does not match global type '!llvm.i32' - . Missing LEN_TRIM lowering - . Missing NINT lowering - . STOP runtime mismatch - - . ConvertExpr.cpp:193 - function type mismatch - . 'std.call' op incorrect number of operands for callee - - . ConvertExpr.cpp:266 - character comparison - . ConvertExpr.cpp:379! - concat CHARs diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index e8748b094fd49..4f546d77e905e 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1668,7 +1668,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (unstructuredContext) { // When transitioning from unstructured to structured code, // the structured code might be a target that starts a new block. - maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured() + maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured() && + !eval.evaluationList->empty() ? eval.evaluationList->front().block : eval.block); } @@ -1678,7 +1679,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::lower::pft::Evaluation *successor{}; if (eval.isActionStmt()) successor = eval.controlSuccessor; - else if (eval.isConstruct() && + else if (eval.isConstruct() && !eval.evaluationList->empty() && eval.evaluationList->back() .lexicalSuccessor->isIntermediateConstructStmt()) successor = eval.constructExit; From 1063acd408cfdbae252d176e766cf3495c48da23 Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Tue, 19 May 2020 23:41:57 +0530 Subject: [PATCH 0034/1017] Add name mangling support for constants in procedures. A small typo in '--fdebug-dump-pre-fir'. --- flang/lib/Lower/Bridge.cpp | 6 +++--- flang/test/Lower/program-units-fir-mangling.f90 | 7 +++++++ 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 4f546d77e905e..aa22a20371078 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -40,9 +40,9 @@ llvm_unreachable("not yet implemented"); \ } -static llvm::cl::opt - dumpBeforeFir("fdebug-dump-pre-fir", llvm::cl::init(false), - llvm::cl::desc("dump the IR tree prior to FIR")); +static llvm::cl::opt dumpBeforeFir( + "fdebug-dump-pre-fir", llvm::cl::init(false), + llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation")); static llvm::cl::opt disableToDoAssertions("disable-burnside-todo", diff --git a/flang/test/Lower/program-units-fir-mangling.f90 b/flang/test/Lower/program-units-fir-mangling.f90 index ee6461c78ee06..9e4920e853d54 100644 --- a/flang/test/Lower/program-units-fir-mangling.f90 +++ b/flang/test/Lower/program-units-fir-mangling.f90 @@ -16,6 +16,13 @@ function foo() ! CHECK: } end function +! CHECK-LABEL: func @_QPfunctn() -> f32 { +function functn +! CHECK-LABEL: fir.global @_QECpi + real, parameter :: pi = 3.14 +! CHECK: } +end function + module testMod contains ! CHECK-LABEL: func @_QMtestmodPsub() { From ca4f0c4b4a296586d33a668142539021f152e85d Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 19 May 2020 12:41:11 -0700 Subject: [PATCH 0035/1017] remove unrelated change --- .../include/flang/Optimizer/Dialect/FIROps.td | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td index cf07a9cd414f9..a38630b2a04f0 100644 --- a/flang/include/flang/Optimizer/Dialect/FIROps.td +++ b/flang/include/flang/Optimizer/Dialect/FIROps.td @@ -2190,24 +2190,6 @@ def fir_InsertOnRangeOp : fir_OneResultOp<"insert_on_range", [NoSideEffect]> { }]; } -def fir_InsertOnRangeOp : fir_OneResultOp<"insert_on_range", [NoSideEffect]> { - let summary = "insert sub-value into a range on an existing sequence"; - - let description = [{ - Insert a constant value into an entity with an array type. Returns a - new ssa value where the range of offsets from the original array have been - replaced with the constant. The result is an array type entity. - }]; - - let arguments = (ins fir_SequenceType:$seq, AnyType:$val, - Index:$start, Index:$end); - let results = (outs fir_SequenceType); - - let assemblyFormat = [{ - operands attr-dict `:` functional-type(operands, results) - }]; -} - def fir_LenParamIndexOp : fir_OneResultOp<"len_param_index", [NoSideEffect]> { let summary = "create a field index value from a LEN type parameter identifier"; From 411ebf535c13eeb680367a1d8c0e79c3f6492668 Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 19 May 2020 13:11:32 -0700 Subject: [PATCH 0036/1017] merge the handling of constant and runtime array index cases. remove and simplify the cases to one path. --- flang/lib/Lower/Bridge.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index aa22a20371078..34a858f1836f1 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1360,6 +1360,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { inner = loop; } builder->restoreInsertionPoint(insPt); + std::reverse(lcvs.begin(), lcvs.end()); return inner; } @@ -1376,7 +1377,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // create the loop nest auto innerLoop = createLoopNest(lcvs, shape); - std::reverse(lcvs.begin(), lcvs.end()); assert(innerLoop); auto insPt = builder->saveInsertionPoint(); // move insertion point inside loop nest From f140ee73d1daa2c806f1313656b2a605c2d971a3 Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 19 May 2020 16:34:39 -0700 Subject: [PATCH 0037/1017] add a test for global vars to mangling. also fix the scope issue with constant. --- flang/test/Lower/program-units-fir-mangling.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/flang/test/Lower/program-units-fir-mangling.f90 b/flang/test/Lower/program-units-fir-mangling.f90 index 9e4920e853d54..5eab37e8f7586 100644 --- a/flang/test/Lower/program-units-fir-mangling.f90 +++ b/flang/test/Lower/program-units-fir-mangling.f90 @@ -13,16 +13,20 @@ subroutine AsUbRoUtInE() ! CHECK-LABEL: func @_QPfoo() -> f32 { function foo() real(4) :: foo + real :: pi = 3.14159 ! CHECK: } end function +! CHECK-LABEL: fir.global @_QFfooEpi : f32 { + ! CHECK-LABEL: func @_QPfunctn() -> f32 { function functn -! CHECK-LABEL: fir.global @_QECpi real, parameter :: pi = 3.14 ! CHECK: } end function +! CHECK-LABEL: fir.global @_QFfunctnECpi constant : f32 { + module testMod contains ! CHECK-LABEL: func @_QMtestmodPsub() { From 7c7fda8524a80524424ff3eee3ecda3d52f53b10 Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 19 May 2020 17:40:23 -0700 Subject: [PATCH 0038/1017] register a diagnostic handler --- flang/lib/Lower/Bridge.cpp | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 34a858f1836f1..6b846a40c3af4 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2187,6 +2187,27 @@ Fortran::lower::LoweringBridge::LoweringBridge( const Fortran::parser::CookedSource &cooked) : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked}, context{std::make_unique()}, kindMap{context.get()} { + context.get()->getDiagEngine().registerHandler([](mlir::Diagnostic &diag) { + auto &os = llvm::errs(); + switch (diag.getSeverity()) { + case mlir::DiagnosticSeverity::Error: + os << "error: "; + break; + case mlir::DiagnosticSeverity::Remark: + os << "info: "; + break; + case mlir::DiagnosticSeverity::Warning: + os << "warning: "; + break; + default: + break; + } + if (!diag.getLocation().isa()) + os << diag.getLocation() << ": "; + os << diag << '\n'; + os.flush(); + return mlir::success(); + }); module = std::make_unique( mlir::ModuleOp::create(mlir::UnknownLoc::get(context.get()))); } From 37b8419932846593574728a307e2890f3425651e Mon Sep 17 00:00:00 2001 From: V Donaldson Date: Tue, 19 May 2020 15:10:41 -0700 Subject: [PATCH 0039/1017] Split a Directive Evaluation variant out from the Construct variant. Review update --- flang/lib/Lower/Bridge.cpp | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 6b846a40c3af4..710f55702bf5e 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -773,17 +773,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// Generate FIR to begin a structured or unstructured increment loop. void genFIRIncrementLoopBegin(IncrementLoopInfo &info) { auto location = toLocation(); - mlir::Type type = info.isStructured() - ? mlir::IndexType::get(builder->getContext()) - : info.loopVariableType; + mlir::Type type = + info.isStructured() ? builder->getIndexType() : info.loopVariableType; auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); auto upperValue = genFIRLoopIndex(info.upperExpr, type); info.stepValue = info.stepExpr.has_value() ? genFIRLoopIndex(*info.stepExpr, type) - : (info.isStructured() - ? builder->create(location, 1) - : builder->createIntegerConstant(info.loopVariableType, 1)); + : info.isStructured() + ? builder->create(location, 1) + : builder->createIntegerConstant(info.loopVariableType, 1); assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(location, *info.loopVariableSym); @@ -1279,7 +1278,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto ty = genType(*sym.symbol); auto load = builder->create( toLocation(), lookupSymbol(*sym.symbol)); - auto idxTy = mlir::IndexType::get(&mlirContext); + auto idxTy = builder->getIndexType(); auto zero = builder->create( toLocation(), idxTy, builder->getIntegerAttr(idxTy, 0)); auto cast = builder->createConvert(toLocation(), ty, zero); @@ -1667,22 +1666,25 @@ class FirConverter : public Fortran::lower::AbstractConverter { setCurrentPosition(eval.position); if (unstructuredContext) { // When transitioning from unstructured to structured code, - // the structured code might be a target that starts a new block. - maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured() && - !eval.evaluationList->empty() + // the structured code could be a target that starts a new block. + maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured() ? eval.evaluationList->front().block : eval.block); } + eval.visit([&](const auto &stmt) { genFIR(eval, stmt); }); + if (unstructuredContext && blockIsUnterminated()) { // Exit from an unstructured IF or SELECT construct block. Fortran::lower::pft::Evaluation *successor{}; - if (eval.isActionStmt()) + if (eval.isActionStmt()) { successor = eval.controlSuccessor; - else if (eval.isConstruct() && !eval.evaluationList->empty() && - eval.evaluationList->back() + } else if (eval.isConstruct()) { + assert(!eval.evaluationList->empty() && "empty construct eval list"); + if (eval.evaluationList->back() .lexicalSuccessor->isIntermediateConstructStmt()) - successor = eval.constructExit; + successor = eval.constructExit; + } if (successor && successor->block) genBranch(successor->block); } @@ -2057,7 +2059,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { eval.block = builder->createBlock(&builder->getRegion()); for (size_t i = 0, n = eval.localBlocks.size(); i < n; ++i) eval.localBlocks[i] = builder->createBlock(&builder->getRegion()); - if (eval.isConstruct()) { + if (eval.isConstruct() || eval.isDirective()) { if (eval.lowerAsUnstructured()) { createEmptyBlocks(*eval.evaluationList); } else { From 45a8fab3a335ed24e4cf5dc98b2fdf2887eae476 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 20 May 2020 12:59:30 -0700 Subject: [PATCH 0040/1017] fix fallout from file rename --- flang/lib/Optimizer/Transforms/CSE.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp index 0a66e768bc7c5..df21ae29a1178 100644 --- a/flang/lib/Optimizer/Transforms/CSE.cpp +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -18,7 +18,7 @@ #include "mlir/IR/Builders.h" #include "mlir/IR/Dominance.h" #include "mlir/IR/Function.h" -#include "mlir/Interfaces/SideEffects.h" +#include "mlir/Interfaces/SideEffectInterfaces.h" #include "mlir/Pass/Pass.h" #include "mlir/Transforms/Passes.h" #include "mlir/Transforms/Utils.h" From 1d8a2397bf42ef8bd9a1bda16f8d9e87afa3a63d Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 21 May 2020 09:15:26 -0700 Subject: [PATCH 0041/1017] fix a correctness bug in block fusion algorithm --- mlir/lib/IR/OperationSupport.cpp | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/mlir/lib/IR/OperationSupport.cpp b/mlir/lib/IR/OperationSupport.cpp index 60910f7f35de8..a19cb385af903 100644 --- a/mlir/lib/IR/OperationSupport.cpp +++ b/mlir/lib/IR/OperationSupport.cpp @@ -559,8 +559,11 @@ bool OperationEquivalence::isEquivalentTo(Operation *lhs, Operation *rhs, return false; // Compare operands. bool ignoreOperands = flags & Flags::IgnoreOperands; - if (ignoreOperands) - return true; + if (ignoreOperands) { + // Ignore the operand values, but cannot ignore their types. + return std::equal(lhs->operand_type_begin(), lhs->operand_type_end(), + rhs->operand_type_begin()); + } // TODO: Allow commutative operations to have different ordering. return std::equal(lhs->operand_begin(), lhs->operand_end(), rhs->operand_begin()); From 9a337c641b75876d795e03b4f1925bf6b0712875 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 21 May 2020 09:16:07 -0700 Subject: [PATCH 0042/1017] re-enable canonicalization passes --- flang/tools/bbc/bbc.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 7c396ed30087c..abe7342e5ba67 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -226,7 +226,7 @@ static void convertFortranSourceToMLIR( pm.addPass(mlir::createLowerToCFGPass()); // pm.addPass(fir::createMemToRegPass()); pm.addPass(fir::createCSEPass()); - //pm.addPass(mlir::createCanonicalizerPass()); + pm.addPass(mlir::createCanonicalizerPass()); if (emitLLVM) { // Continue to lower from MLIR down to LLVM IR. Emit LLVM and MLIR. From 5da889b453cc9f2f85790b56465efb3605a766ad Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 21 May 2020 09:16:49 -0700 Subject: [PATCH 0043/1017] fix test to account for block fusion, now enabled --- flang/test/Fir/loop.fir | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/flang/test/Fir/loop.fir b/flang/test/Fir/loop.fir index 2c13f992aff4b..61b25a7880ff5 100644 --- a/flang/test/Fir/loop.fir +++ b/flang/test/Fir/loop.fir @@ -4,18 +4,20 @@ // CHECK-LABEL: @x func @x(%lb : index, %ub : index, %step : index, %b : i1, %addr : !fir.ref) { + // CHECK: [[LOOP:[0-9]+]]: // CHECK: %[[COND:.*]] = icmp slt i64 // CHECK: br i1 %[[COND]] fir.do_loop %iv = %lb to %ub step %step unordered { - // CHECK: br i1 % + // expect following conditional blocks to get fused + // CHECK: select i1 % fir.if %b { // CHECK: store i64 fir.store %iv to %addr : !fir.ref } else { %zero = constant 0 : index - // CHECK: store i64 fir.store %zero to %addr : !fir.ref } + // CHECK: br label %[[LOOP]] } // CHECK: ret void return From ae3bcb2d9c3a24e3e70bed3ce166e441803afb42 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 21 May 2020 09:17:18 -0700 Subject: [PATCH 0044/1017] take the array test back off the XFAIL list notice that code in the constant bounds case had lost information, so undo a previous patch that caused that regression --- flang/test/Lower/array.f90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/flang/test/Lower/array.f90 b/flang/test/Lower/array.f90 index 045e8fe51f65e..d9c56d8adfdb6 100644 --- a/flang/test/Lower/array.f90 +++ b/flang/test/Lower/array.f90 @@ -1,5 +1,4 @@ ! RUN: bbc -o - %s | FileCheck %s -! XFAIL: * subroutine s(i,j,k,ii,jj,kk,a1,a2,a3,a4,a5,a6,a7) integer i, j, k, ii, jj, kk @@ -18,19 +17,22 @@ subroutine s(i,j,k,ii,jj,kk,a1,a2,a3,a4,a5,a6,a7) ! CHECK-LABEL: BeginExternalListOutput ! CHECK-DAG: fir.load %arg3 : ! CHECK-DAG: %[[i1:.*]] = subi %{{.*}}, %[[one:c1.*]] : - ! CHECK-DAG: fir.load %arg4 : - ! CHECK-DAG: %[[j1:.*]] = subi %{{.*}}, %[[one]] : + ! CHECK: fir.load %arg4 : + ! CHECK: %[[j1:.*]] = subi %{{.*}}, %[[one]] : ! CHECK: fir.coordinate_of %arg6, %[[i1]], %[[j1]] : ! CHECK-LABEL: EndIoStatement print *, a1(ii,jj) ! CHECK-LABEL: BeginExternalListOutput + ! CHECK: fir.coordinate_of %{{[0-9]+}}, %{{[0-9]+}} : {{.*}} -> !fir.ref ! CHECK-LABEL: EndIoStatement print *, a2(ii,jj) ! CHECK-LABEL: BeginExternalListOutput ! CHECK-DAG: fir.load %arg3 : - ! CHECK-DAG: %[[i2:.*]] = subi %{{.*}}, %c2{{.*}} : + ! CHECK-DAG: %[[cc2:.*]] = fir.convert %c2{{.*}} : + ! CHECK: %[[i2:.*]] = subi %{{.*}}, %[[cc2]] : ! CHECK-DAG: fir.load %arg4 : - ! CHECK-DAG: %[[j2:.*]] = subi %{{.*}}, %c3{{.*}} : + ! CHECK-DAG: %[[cc3:.*]] = fir.convert %c3{{.*}} : + ! CHECK: %[[j2:.*]] = subi %{{.*}}, %[[cc3]] : ! CHECK: fir.coordinate_of %arg8, %[[i2]], %[[j2]] : ! CHECK-LABEL: EndIoStatement print *, a3(ii,jj) From 26caa1fdd8a063537ec049835694f973b34946cf Mon Sep 17 00:00:00 2001 From: Sameeran joshi Date: Wed, 20 May 2020 18:52:38 +0530 Subject: [PATCH 0045/1017] Basic support for gtest infra --- flang/unittests/Optimizer/Basic.cpp | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 flang/unittests/Optimizer/Basic.cpp diff --git a/flang/unittests/Optimizer/Basic.cpp b/flang/unittests/Optimizer/Basic.cpp new file mode 100644 index 0000000000000..fdea2ea38b27f --- /dev/null +++ b/flang/unittests/Optimizer/Basic.cpp @@ -0,0 +1,18 @@ +#include "flang/Optimizer/Support/InternalNames.h" +#include +#include + +using namespace fir; +using namespace llvm; + +TEST(genericName, MyTest) { + NameUniquer obj; + std::string val = obj.doCommonBlock("hello"); + std::cout << val; +} + +int main(int argc, char **argv) { + testing::InitGoogleTest(&argc, argv); + return RUN_ALL_TESTS(); +} + From b12133a56ca14928fc02ad0cff424c52d5ef448f Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 21 May 2020 12:35:18 -0700 Subject: [PATCH 0046/1017] finishes the unittest target setup --- flang/test/Unit/lit.cfg.py | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/flang/test/Unit/lit.cfg.py b/flang/test/Unit/lit.cfg.py index b3103012de73e..bb95fab48def7 100644 --- a/flang/test/Unit/lit.cfg.py +++ b/flang/test/Unit/lit.cfg.py @@ -17,9 +17,6 @@ config.test_source_root = os.path.join(config.flang_obj_root, 'unittests') config.test_exec_root = config.test_source_root -# testFormat: The test format to use to interpret tests. -config.test_format = lit.formats.GoogleTest(config.llvm_build_mode, 'Tests') - # Tweak the PATH to include the tools dir. path = os.path.pathsep.join((config.flang_tools_dir, config.llvm_tools_dir, config.environment['PATH'])) config.environment['PATH'] = path @@ -28,5 +25,11 @@ config.environment.get('LD_LIBRARY_PATH',''))) config.environment['LD_LIBRARY_PATH'] = path +# Propagate LLVM_SRC_ROOT into the environment. +config.environment['LLVM_SRC_ROOT'] = config.llvm_src_root + # Propagate PYTHON_EXECUTABLE into the environment #config.environment['PYTHON_EXECUTABLE'] = sys.executable + +# testFormat: The test format to use to interpret tests. +config.test_format = lit.formats.GoogleTest(config.llvm_build_mode, 'Tests') From eeb202bf47168fed5ec1b497cadb16d40d2e3396 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 21 May 2020 15:35:38 -0700 Subject: [PATCH 0047/1017] start to add an inlining pass --- flang/lib/Optimizer/Dialect/FIRDialect.cpp | 29 +++++++++++ flang/lib/Optimizer/Transforms/CMakeLists.txt | 1 + .../lib/Optimizer/Transforms/RewriteLoop.cpp | 49 +++++++++---------- flang/test/Fir/inline.fir | 19 +++++++ flang/tools/bbc/bbc.cpp | 2 +- 5 files changed, 74 insertions(+), 26 deletions(-) create mode 100644 flang/test/Fir/inline.fir diff --git a/flang/lib/Optimizer/Dialect/FIRDialect.cpp b/flang/lib/Optimizer/Dialect/FIRDialect.cpp index f80aa7d3380e8..e1b636af517cd 100644 --- a/flang/lib/Optimizer/Dialect/FIRDialect.cpp +++ b/flang/lib/Optimizer/Dialect/FIRDialect.cpp @@ -14,9 +14,37 @@ #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Transforms/InliningUtils.h" using namespace fir; +namespace { +/// This class defines the interface for handling inlining of FIR calls. +struct FIRInlinerInterface : public mlir::DialectInlinerInterface { + using DialectInlinerInterface::DialectInlinerInterface; + + /// This hook checks to see if the operation `op` is legal to inline into the + /// given region `reg`. + bool isLegalToInline(mlir::Operation *op, mlir::Region *reg, + mlir::BlockAndValueMapping &map) const final { + return fir::canLegallyInline(op, reg, map); + } + + /// This hook is called when a terminator operation has been inlined. + /// We handle the return (a Fortran FUNCTION) by replacing the values + /// previously returned by the call operation with the operands of the + /// return. + void handleTerminator(mlir::Operation *op, + llvm::ArrayRef valuesToRepl) const final { + auto returnOp = cast(op); + assert(returnOp.getNumOperands() == valuesToRepl.size()); + for (const auto &it : llvm::enumerate(returnOp.getOperands())) + valuesToRepl[it.index()].replaceAllUsesWith(it.value()); + } +}; +} // namespace + fir::FIROpsDialect::FIROpsDialect(mlir::MLIRContext *ctx) : mlir::Dialect("fir", ctx, mlir::TypeID::get()) { registerTypes(); @@ -25,6 +53,7 @@ fir::FIROpsDialect::FIROpsDialect(mlir::MLIRContext *ctx) #define GET_OP_LIST #include "flang/Optimizer/Dialect/FIROps.cpp.inc" >(); + addInterfaces(); } // anchor the class vtable to this compilation unit diff --git a/flang/lib/Optimizer/Transforms/CMakeLists.txt b/flang/lib/Optimizer/Transforms/CMakeLists.txt index 4d301784f8dfc..9512c5818add7 100644 --- a/flang/lib/Optimizer/Transforms/CMakeLists.txt +++ b/flang/lib/Optimizer/Transforms/CMakeLists.txt @@ -3,6 +3,7 @@ get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) add_flang_library(FIRTransforms ControlFlowConverter.cpp CSE.cpp + Inliner.cpp MemToReg.cpp RaiseToAffine.cpp RewriteLoop.cpp diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index f329d010e6327..17f10fdea8474 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -15,24 +15,24 @@ #include "mlir/Transforms/DialectConversion.h" #include "llvm/Support/CommandLine.h" -/// disable FIR to loop dialect conversion +/// disable FIR to scf dialect conversion static llvm::cl::opt - disableLoopConversion("disable-loop-conversion", - llvm::cl::desc("disable FIR to Loop pass"), - llvm::cl::init(false)); + disableScfConversion("disable-scf-conversion", + llvm::cl::desc("disable FIR to SCF pass"), + llvm::cl::init(false)); using namespace fir; namespace { -// Conversion to the MLIR loop dialect +// Conversion to the MLIR scf dialect // // FIR loops that cannot be converted to the affine dialect will remain as -// `fir.loop` operations. These can be converted to `loop.for` operations. MLIR -// includes a pass to lower `loop.for` operations to a CFG. +// `fir.do_loop` operations. These can be converted to `scf.for` operations. +// MLIR includes a pass to lower `scf.for` operations to a CFG. -/// Convert `fir.loop` to `loop.for` -class LoopLoopConv : public mlir::OpRewritePattern { +/// Convert `fir.do_loop` to `scf.for` +class ScfLoopConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -53,8 +53,8 @@ class LoopLoopConv : public mlir::OpRewritePattern { } }; -/// Convert `fir.where` to `loop.if` -class LoopWhereConv : public mlir::OpRewritePattern { +/// Convert `fir.where` to `scf.if` +class ScfWhereConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -78,7 +78,7 @@ class LoopWhereConv : public mlir::OpRewritePattern { }; /// Replace FirEndOp with TerminatorOp -class LoopResultConv : public mlir::OpRewritePattern { +class ScfResultConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -90,7 +90,7 @@ class LoopResultConv : public mlir::OpRewritePattern { } }; -class LoopIterWhileConv : public mlir::OpRewritePattern { +class ScfIterWhileConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -166,24 +166,23 @@ class LoopIterWhileConv : public mlir::OpRewritePattern { } }; -/// Convert `fir.loop` and `fir.where` to `loop.for` and `loop.if`. -class LoopDialectConversion - : public mlir::PassWrapper { +/// Convert `fir.do_loop` and `fir.if` to `scf.for` and `scf.if`. +class ScfDialectConversion + : public mlir::PassWrapper { public: void runOnFunction() override { - if (disableLoopConversion) + if (disableScfConversion) return; auto *context = &getContext(); mlir::OwningRewritePatternList patterns1; - patterns1.insert(context); + patterns1.insert(context); mlir::OwningRewritePatternList patterns2; - patterns2.insert(context); + patterns2.insert(context); mlir::ConversionTarget target = *context; target.addLegalDialect(); + mlir::scf::SCFDialect, mlir::StandardOpsDialect>(); // apply the patterns target.addIllegalOp(); @@ -197,16 +196,16 @@ class LoopDialectConversion if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, std::move(patterns2)))) { mlir::emitError(mlir::UnknownLoc::get(context), - "error in converting to MLIR loop dialect\n"); + "error in converting to MLIR scf dialect\n"); signalPassFailure(); } } }; } // namespace -/// Convert `fir.loop` and `fir.where` to `loop.for` and `loop.if`. This +/// Convert `fir.do_loop` and `fir.if` to `scf.for` and `scf.if`. This /// conversion enables the `createLowerToCFGPass` to transform these to CFG /// form. -std::unique_ptr fir::createLowerToLoopPass() { - return std::make_unique(); +std::unique_ptr fir::createLowerToScfPass() { + return std::make_unique(); } diff --git a/flang/test/Fir/inline.fir b/flang/test/Fir/inline.fir new file mode 100644 index 0000000000000..bd4136c974591 --- /dev/null +++ b/flang/test/Fir/inline.fir @@ -0,0 +1,19 @@ +// RUN: tco --enable-inlining %s -o - | FileCheck %s + +// CHECK-LABEL: @add +func @add(%a : i32, %b : i32) -> i32 { + // CHECK: %[[add:.*]] = add i32 + %p = addi %a, %b : i32 + // CHECK: ret i32 %[[add]] + return %p : i32 +} + +// CHECK-LABEL: @test +func @test(%a : i32, %b : i32, %c : i32) -> i32 { + // CHECK: %[[add:.*]] = add i32 + %m = fir.call @add(%a, %b) : (i32, i32) -> i32 + // CHECK: %[[mul:.*]] = mul i32 %[[add]], + %n = muli %m, %c : i32 + // CHECK: ret i32 %[[mul]] + return %n : i32 +} diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index abe7342e5ba67..17dc3462519b3 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -221,7 +221,7 @@ static void convertFortranSourceToMLIR( mlir::PassManager pm(mlirModule.getContext()); mlir::applyPassManagerCLOptions(pm); pm.addPass(fir::createPromoteToAffinePass()); - pm.addPass(fir::createLowerToLoopPass()); + pm.addPass(fir::createLowerToScfPass()); pm.addPass(fir::createControlFlowLoweringPass()); pm.addPass(mlir::createLowerToCFGPass()); // pm.addPass(fir::createMemToRegPass()); From 8fa2924b2789d2497a2800b559804e8708b04a93 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 21 May 2020 15:50:29 -0700 Subject: [PATCH 0048/1017] reword some comments to reflect new MLIR names for dialects, etc. --- flang/lib/Optimizer/Transforms/RewriteLoop.cpp | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 17f10fdea8474..cf199832b653a 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -25,7 +25,7 @@ using namespace fir; namespace { -// Conversion to the MLIR scf dialect +// Conversion to the SCF dialect. // // FIR loops that cannot be converted to the affine dialect will remain as // `fir.do_loop` operations. These can be converted to `scf.for` operations. @@ -53,8 +53,8 @@ class ScfLoopConv : public mlir::OpRewritePattern { } }; -/// Convert `fir.where` to `scf.if` -class ScfWhereConv : public mlir::OpRewritePattern { +/// Convert `fir.if` to `scf.if` +class ScfIfConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -77,7 +77,7 @@ class ScfWhereConv : public mlir::OpRewritePattern { } }; -/// Replace FirEndOp with TerminatorOp +/// Convert `fir.result` to `scf.yield` class ScfResultConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -166,7 +166,7 @@ class ScfIterWhileConv : public mlir::OpRewritePattern { } }; -/// Convert `fir.do_loop` and `fir.if` to `scf.for` and `scf.if`. +/// Convert FIR structured control flow ops to SCF ops. class ScfDialectConversion : public mlir::PassWrapper { public: @@ -179,7 +179,7 @@ class ScfDialectConversion patterns1.insert(context); mlir::OwningRewritePatternList patterns2; - patterns2.insert(context); + patterns2.insert(context); mlir::ConversionTarget target = *context; target.addLegalDialect(); @@ -196,14 +196,14 @@ class ScfDialectConversion if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, std::move(patterns2)))) { mlir::emitError(mlir::UnknownLoc::get(context), - "error in converting to MLIR scf dialect\n"); + "error in converting to scf dialect\n"); signalPassFailure(); } } }; } // namespace -/// Convert `fir.do_loop` and `fir.if` to `scf.for` and `scf.if`. This +/// Convert FIR's structured control flow ops to SCF ops. This /// conversion enables the `createLowerToCFGPass` to transform these to CFG /// form. std::unique_ptr fir::createLowerToScfPass() { From a3f61350eb54dc8e7e7b96ae975f3e875b57559e Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 22 May 2020 11:57:31 -0700 Subject: [PATCH 0049/1017] [cleanup] reduce the amount of repetitive code by using a data member. --- flang/lib/Lower/Bridge.cpp | 423 +++++++++++++------------------------ 1 file changed, 144 insertions(+), 279 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 710f55702bf5e..3f2f63ae07cc4 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -108,13 +108,13 @@ static bool isExplicitShape(const Fortran::semantics::Symbol &sym) { } namespace { -struct SymbolIndexAnalyzer { +struct SymbolBoxAnalyzer { using FromBox = std::monostate; - explicit SymbolIndexAnalyzer(const Fortran::semantics::Symbol &sym) + explicit SymbolBoxAnalyzer(const Fortran::semantics::Symbol &sym) : sym{sym} {} - SymbolIndexAnalyzer() = delete; - SymbolIndexAnalyzer(const SymbolIndexAnalyzer &) = delete; + SymbolBoxAnalyzer() = delete; + SymbolBoxAnalyzer(const SymbolBoxAnalyzer &) = delete; /// Run the analysis on the symbol. Used to determine the type of index to /// save in the symbol map. @@ -517,8 +517,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } /// Lowering of CALL statement - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::CallStmt &stmt) { + void genFIR(const Fortran::parser::CallStmt &stmt) { + auto &eval = getEval(); setCurrentPosition(stmt.v.source); assert(stmt.typedCall && "Call was not analyzed"); Fortran::semantics::SomeExpr expr{*stmt.typedCall}; @@ -544,8 +544,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->create(toLocation(), res, indexList, blockList); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::IfStmt &stmt) { + void genFIR(const Fortran::parser::IfStmt &stmt) { + auto &eval = getEval(); if (eval.lowerAsUnstructured()) { genFIRConditionalBranch( std::get(stmt.t), @@ -560,13 +560,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->restoreInsertionPoint(pair.first); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::WhereStmt &) { - TODO(); - } + void genFIR(const Fortran::parser::WhereStmt &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ComputedGotoStmt &stmt) { + void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) { + auto &eval = getEval(); mlir::Value selectExpr = genExprValue(*Fortran::semantics::GetExpr( std::get(stmt.t))); llvm::SmallVector indexList; @@ -581,13 +578,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { blockList); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ForallStmt &) { - TODO(); - } + void genFIR(const Fortran::parser::ForallStmt &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ArithmeticIfStmt &stmt) { + void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) { + auto &eval = getEval(); mlir::Value expr = genExprValue( *Fortran::semantics::GetExpr(std::get(stmt.t))); auto exprType = expr.getType(); @@ -628,8 +622,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { blockOfLabel(eval, std::get<2>(stmt.t))); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::AssignedGotoStmt &stmt) { + void genFIR(const Fortran::parser::AssignedGotoStmt &stmt) { // Program requirement 1990 8.2.4 - // // At the time of execution of an assigned GOTO statement, the integer @@ -639,6 +632,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // only by an ASSIGN statement in the same scoping unit as the assigned // GOTO statement. + auto &eval = getEval(); const auto &symbolLabelMap = eval.getOwningProcedure()->assignSymbolLabelMap; const auto &symbol = *std::get(stmt.t).symbol; @@ -689,30 +683,18 @@ class FirConverter : public Fortran::lower::AbstractConverter { blockList); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::AssociateConstruct &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::BlockConstruct &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ChangeTeamConstruct &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::CriticalConstruct &) { - TODO(); - } + void genFIR(const Fortran::parser::AssociateConstruct &) { TODO(); } + void genFIR(const Fortran::parser::BlockConstruct &) { TODO(); } + void genFIR(const Fortran::parser::ChangeTeamConstruct &) { TODO(); } + void genFIR(const Fortran::parser::CriticalConstruct &) { TODO(); } /// Generate FIR for a DO construct. There are six variants: /// - unstructured infinite and while loops /// - structured and unstructured increment loops /// - structured and unstructured concurrent loops - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::DoConstruct &) { - bool unstructuredContext{eval.lowerAsUnstructured()}; + void genFIR(const Fortran::parser::DoConstruct &) { + auto &eval = getEval(); + bool unstructuredContext = eval.lowerAsUnstructured(); Fortran::lower::pft::Evaluation &doStmtEval = eval.evaluationList->front(); auto *doStmt = doStmtEval.getIf(); assert(doStmt && "missing DO statement"); @@ -760,6 +742,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Generate loop body code. for (auto &e : *eval.evaluationList) genFIR(e, unstructuredContext); + setCurrentEval(eval); // Generate end loop code. if (infiniteLoop || whileCondition) { @@ -849,8 +832,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } /// Generate structured or unstructured FIR for an IF construct. - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::IfConstruct &) { + void genFIR(const Fortran::parser::IfConstruct &) { + auto &eval = getEval(); if (eval.lowerAsStructured()) { // Structured fir.where nest. fir::WhereOp underWhere; @@ -872,6 +855,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { genFIR(e, /*unstructuredContext=*/false); } } + setCurrentEval(eval); return; } @@ -896,31 +880,21 @@ class FirConverter : public Fortran::lower::AbstractConverter { genFIR(e); } } + setCurrentEval(eval); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::CaseConstruct &) { - for (auto &e : *eval.evaluationList) + void genFIR(const Fortran::parser::CaseConstruct &) { + for (auto &e : *getEval().evaluationList) genFIR(e); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SelectRankConstruct &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SelectTypeConstruct &) { - TODO(); - } + void genFIR(const Fortran::parser::SelectRankConstruct &) { TODO(); } + void genFIR(const Fortran::parser::SelectTypeConstruct &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::WhereConstruct &) { - TODO(); - } + void genFIR(const Fortran::parser::WhereConstruct &) { TODO(); } /// Lower FORALL construct (See 10.2.4) - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ForallConstruct &forall) { + void genFIR(const Fortran::parser::ForallConstruct &forall) { auto &stmt = std::get< Fortran::parser::Statement>( forall.t); @@ -939,24 +913,20 @@ class FirConverter : public Fortran::lower::AbstractConverter { [&](const Fortran::parser::Statement< Fortran::parser::ForallAssignmentStmt> &b) { setCurrentPosition(b.source); - genFIR(eval, b.statement); + genFIR(b.statement); }, [&](const Fortran::parser::Statement &b) { setCurrentPosition(b.source); - genFIR(eval, b.statement); - }, - [&](const Fortran::parser::WhereConstruct &b) { - genFIR(eval, b); + genFIR(b.statement); }, + [&](const Fortran::parser::WhereConstruct &b) { genFIR(b); }, [&](const Fortran::common::Indirection< - Fortran::parser::ForallConstruct> &b) { - genFIR(eval, b.value()); - }, + Fortran::parser::ForallConstruct> &b) { genFIR(b.value()); }, [&](const Fortran::parser::Statement &b) { setCurrentPosition(b.source); - genFIR(eval, b.statement); + genFIR(b.statement); }, }, s.u); @@ -964,43 +934,23 @@ class FirConverter : public Fortran::lower::AbstractConverter { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ForallAssignmentStmt &s) { - std::visit([&](auto &b) { genFIR(eval, b); }, s.u); + void genFIR(const Fortran::parser::ForallAssignmentStmt &s) { + std::visit([&](auto &b) { genFIR(b); }, s.u); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::CompilerDirective &) { + void genFIR(const Fortran::parser::CompilerDirective &) { mlir::emitWarning(toLocation(), "ignoring all compiler directives"); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::OpenMPConstruct &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::OmpEndLoopDirective &) { - TODO(); - } + void genFIR(const Fortran::parser::OpenMPConstruct &) { TODO(); } + void genFIR(const Fortran::parser::OmpEndLoopDirective &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::AssociateStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EndAssociateStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::BlockStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EndBlockStmt &) { - TODO(); - } + void genFIR(const Fortran::parser::AssociateStmt &) { TODO(); } + void genFIR(const Fortran::parser::EndAssociateStmt &) { TODO(); } + void genFIR(const Fortran::parser::BlockStmt &) { TODO(); } + void genFIR(const Fortran::parser::EndBlockStmt &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SelectCaseStmt &stmt) { + void genFIR(const Fortran::parser::SelectCaseStmt &stmt) { + auto &eval = getEval(); using ScalarExpr = Fortran::parser::Scalar; MLIRContext *context = builder->getContext(); const auto selectExpr = genExprValue( @@ -1059,146 +1009,85 @@ class FirConverter : public Fortran::lower::AbstractConverter { valueList, blockList); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::CaseStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EndSelectStmt &) {} // nop + void genFIR(const Fortran::parser::CaseStmt &) {} // nop + void genFIR(const Fortran::parser::EndSelectStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ChangeTeamStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EndChangeTeamStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::CriticalStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EndCriticalStmt &) { - TODO(); - } + void genFIR(const Fortran::parser::ChangeTeamStmt &) { TODO(); } + void genFIR(const Fortran::parser::EndChangeTeamStmt &) { TODO(); } + void genFIR(const Fortran::parser::CriticalStmt &) { TODO(); } + void genFIR(const Fortran::parser::EndCriticalStmt &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::NonLabelDoStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::EndDoStmt &) {} // nop + void genFIR(const Fortran::parser::NonLabelDoStmt &) {} // nop + void genFIR(const Fortran::parser::EndDoStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::IfThenStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::ElseIfStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::ElseStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::EndIfStmt &) {} // nop + void genFIR(const Fortran::parser::IfThenStmt &) {} // nop + void genFIR(const Fortran::parser::ElseIfStmt &) {} // nop + void genFIR(const Fortran::parser::ElseStmt &) {} // nop + void genFIR(const Fortran::parser::EndIfStmt &) {} // nop - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SelectRankStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SelectRankCaseStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SelectTypeStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::TypeGuardStmt &) { - TODO(); - } + void genFIR(const Fortran::parser::SelectRankStmt &) { TODO(); } + void genFIR(const Fortran::parser::SelectRankCaseStmt &) { TODO(); } + void genFIR(const Fortran::parser::SelectTypeStmt &) { TODO(); } + void genFIR(const Fortran::parser::TypeGuardStmt &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::WhereConstructStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::MaskedElsewhereStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ElsewhereStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EndWhereStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ForallConstructStmt &) { - TODO(); - } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EndForallStmt &) { - TODO(); - } + void genFIR(const Fortran::parser::WhereConstructStmt &) { TODO(); } + void genFIR(const Fortran::parser::MaskedElsewhereStmt &) { TODO(); } + void genFIR(const Fortran::parser::ElsewhereStmt &) { TODO(); } + void genFIR(const Fortran::parser::EndWhereStmt &) { TODO(); } + void genFIR(const Fortran::parser::ForallConstructStmt &) { TODO(); } + void genFIR(const Fortran::parser::EndForallStmt &) { TODO(); } //===--------------------------------------------------------------------===// // IO statements (see io.h) //===--------------------------------------------------------------------===// - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::BackspaceStmt &stmt) { + void genFIR(const Fortran::parser::BackspaceStmt &stmt) { auto iostat = genBackspaceStatement(*this, stmt); - genIoConditionBranches(eval, stmt.v, iostat); + genIoConditionBranches(getEval(), stmt.v, iostat); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::CloseStmt &stmt) { + void genFIR(const Fortran::parser::CloseStmt &stmt) { auto iostat = genCloseStatement(*this, stmt); - genIoConditionBranches(eval, stmt.v, iostat); + genIoConditionBranches(getEval(), stmt.v, iostat); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::EndfileStmt &stmt) { + void genFIR(const Fortran::parser::EndfileStmt &stmt) { auto iostat = genEndfileStatement(*this, stmt); - genIoConditionBranches(eval, stmt.v, iostat); + genIoConditionBranches(getEval(), stmt.v, iostat); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::FlushStmt &stmt) { + void genFIR(const Fortran::parser::FlushStmt &stmt) { auto iostat = genFlushStatement(*this, stmt); - genIoConditionBranches(eval, stmt.v, iostat); + genIoConditionBranches(getEval(), stmt.v, iostat); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::InquireStmt &stmt) { + void genFIR(const Fortran::parser::InquireStmt &stmt) { auto iostat = genInquireStatement(*this, stmt); genIoConditionBranches( - eval, std::get>(stmt.u), + getEval(), std::get>(stmt.u), iostat); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::OpenStmt &stmt) { + void genFIR(const Fortran::parser::OpenStmt &stmt) { auto iostat = genOpenStatement(*this, stmt); - genIoConditionBranches(eval, stmt.v, iostat); + genIoConditionBranches(getEval(), stmt.v, iostat); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::PrintStmt &stmt) { + void genFIR(const Fortran::parser::PrintStmt &stmt) { genPrintStatement(*this, stmt, - eval.getOwningProcedure()->labelEvaluationMap); + getEval().getOwningProcedure()->labelEvaluationMap); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ReadStmt &stmt) { + void genFIR(const Fortran::parser::ReadStmt &stmt) { auto iostat = genReadStatement( - *this, stmt, eval.getOwningProcedure()->labelEvaluationMap); - genIoConditionBranches(eval, stmt.controls, iostat); + *this, stmt, getEval().getOwningProcedure()->labelEvaluationMap); + genIoConditionBranches(getEval(), stmt.controls, iostat); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::RewindStmt &stmt) { + void genFIR(const Fortran::parser::RewindStmt &stmt) { auto iostat = genRewindStatement(*this, stmt); - genIoConditionBranches(eval, stmt.v, iostat); + genIoConditionBranches(getEval(), stmt.v, iostat); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::WaitStmt &stmt) { + void genFIR(const Fortran::parser::WaitStmt &stmt) { auto iostat = genWaitStatement(*this, stmt); - genIoConditionBranches(eval, stmt.v, iostat); + genIoConditionBranches(getEval(), stmt.v, iostat); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::WriteStmt &stmt) { + void genFIR(const Fortran::parser::WriteStmt &stmt) { auto iostat = genWriteStatement( - *this, stmt, eval.getOwningProcedure()->labelEvaluationMap); - genIoConditionBranches(eval, stmt.controls, iostat); + *this, stmt, getEval().getOwningProcedure()->labelEvaluationMap); + genIoConditionBranches(getEval(), stmt.controls, iostat); } template @@ -1255,22 +1144,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Memory allocation and deallocation //===--------------------------------------------------------------------===// - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::AllocateStmt &) { - TODO(); - } + void genFIR(const Fortran::parser::AllocateStmt &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::DeallocateStmt &) { - TODO(); - } + void genFIR(const Fortran::parser::DeallocateStmt &) { TODO(); } /// Nullify pointer object list /// /// For each pointer object, reset the pointer to a disassociated status. /// We do this by setting each pointer to null. - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::NullifyStmt &stmt) { + void genFIR(const Fortran::parser::NullifyStmt &stmt) { for (auto &po : stmt.v) { std::visit( Fortran::common::visitors{ @@ -1292,8 +1174,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { //===--------------------------------------------------------------------===// - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::ContinueStmt &) { + void genFIR(const Fortran::parser::ContinueStmt &) { // do nothing } @@ -1305,24 +1186,20 @@ class FirConverter : public Fortran::lower::AbstractConverter { std::exit(1); } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::EventPostStmt &) { + void genFIR(const Fortran::parser::EventPostStmt &) { // FIXME: There is no runtime call to make for this yet. noRuntimeSupport("EVENT POST"); } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::EventWaitStmt &) { + void genFIR(const Fortran::parser::EventWaitStmt &) { // FIXME: There is no runtime call to make for this yet. noRuntimeSupport("EVENT WAIT"); } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::FormTeamStmt &) { + void genFIR(const Fortran::parser::FormTeamStmt &) { // FIXME: There is no runtime call to make for this yet. noRuntimeSupport("FORM TEAM"); } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::LockStmt &) { + void genFIR(const Fortran::parser::LockStmt &) { // FIXME: There is no runtime call to make for this yet. noRuntimeSupport("LOCK"); } @@ -1405,7 +1282,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } /// Shared for both assignments and pointer assignments. - void genFIR(const Fortran::evaluate::Assignment &assign) { + void genAssignment(const Fortran::evaluate::Assignment &assign) { std::visit( Fortran::common::visitors{ [&](const Fortran::evaluate::Assignment::Intrinsic &) { @@ -1486,44 +1363,36 @@ class FirConverter : public Fortran::lower::AbstractConverter { assign.u); } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::PointerAssignmentStmt &stmt) { - genFIR(*stmt.typedAssignment->v); + void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) { + genAssignment(*stmt.typedAssignment->v); } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::AssignmentStmt &stmt) { - genFIR(*stmt.typedAssignment->v); + void genFIR(const Fortran::parser::AssignmentStmt &stmt) { + genAssignment(*stmt.typedAssignment->v); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SyncAllStmt &) { + void genFIR(const Fortran::parser::SyncAllStmt &) { // FIXME: There is no runtime call to make for this yet. noRuntimeSupport("SYNC ALL"); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SyncImagesStmt &) { + void genFIR(const Fortran::parser::SyncImagesStmt &) { // FIXME: There is no runtime call to make for this yet. noRuntimeSupport("SYNC IMAGES"); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SyncMemoryStmt &) { + void genFIR(const Fortran::parser::SyncMemoryStmt &) { // FIXME: There is no runtime call to make for this yet. noRuntimeSupport("SYNC MEMORY"); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::SyncTeamStmt &) { + void genFIR(const Fortran::parser::SyncTeamStmt &) { // FIXME: There is no runtime call to make for this yet. noRuntimeSupport("SYNC TEAM"); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::UnlockStmt &) { + void genFIR(const Fortran::parser::UnlockStmt &) { // FIXME: There is no runtime call to make for this yet. noRuntimeSupport("UNLOCK"); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::AssignStmt &stmt) { + void genFIR(const Fortran::parser::AssignStmt &stmt) { const auto &symbol = *std::get(stmt.t).symbol; auto variable = lookupSymbol(symbol); if (!variable) @@ -1533,48 +1402,37 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->create(toLocation(), labelValue, variable); } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::FormatStmt &) { + void genFIR(const Fortran::parser::FormatStmt &) { // do nothing. // FORMAT statements have no semantics. They may be lowered if used by a // data transfer statement. } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::EntryStmt &) { - TODO(); - } + void genFIR(const Fortran::parser::EntryStmt &) { TODO(); } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::PauseStmt &) { + void genFIR(const Fortran::parser::PauseStmt &) { // FIXME: There is no runtime call to make for this yet. noRuntimeSupport("PAUSE"); } - void genFIR(Fortran::lower::pft::Evaluation &, - const Fortran::parser::DataStmt &) { + void genFIR(const Fortran::parser::DataStmt &) { // FIXME: The front-end doesn't provide the right information yet. mlir::emitError(toLocation(), "DATA statement is not handled."); exit(1); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::NamelistStmt &) { - TODO(); - } + void genFIR(const Fortran::parser::NamelistStmt &) { TODO(); } // call FAIL IMAGE in runtime - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::FailImageStmt &stmt) { + void genFIR(const Fortran::parser::FailImageStmt &stmt) { auto callee = genFailImageStatementRuntime(*builder); llvm::SmallVector operands; // FAIL IMAGE has no args builder->create(toLocation(), callee, operands); } // call STOP, ERROR STOP in runtime - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::StopStmt &stmt) { + void genFIR(const Fortran::parser::StopStmt &stmt) { auto callee = genStopStatementRuntime(*builder); auto calleeType = callee.getType(); llvm::SmallVector operands; @@ -1619,8 +1477,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // gen expression, if any; share code with END of procedure - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ReturnStmt &stmt) { + void genFIR(const Fortran::parser::ReturnStmt &stmt) { + auto &eval = getEval(); auto *funit = eval.getOwningProcedure(); assert(funit && "not inside main program, function or subroutine"); if (funit->isMainProgram()) { @@ -1645,19 +1503,17 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->create(toLocation(), funit->finalBlock); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::CycleStmt &) { - genBranch(eval.controlSuccessor->block); + void genFIR(const Fortran::parser::CycleStmt &) { + genBranch(getEval().controlSuccessor->block); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::ExitStmt &) { - genBranch(eval.controlSuccessor->block); + void genFIR(const Fortran::parser::ExitStmt &) { + genBranch(getEval().controlSuccessor->block); } - void genFIR(Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::GotoStmt &) { - genBranch(eval.controlSuccessor->block); + void genFIR(const Fortran::parser::GotoStmt &) { + genBranch(getEval().controlSuccessor->block); } + /// Generate the FIR for the Evaluation `eval`. void genFIR(Fortran::lower::pft::Evaluation &eval, bool unstructuredContext = true) { if (eval.skip) @@ -1672,7 +1528,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { : eval.block); } - eval.visit([&](const auto &stmt) { genFIR(eval, stmt); }); + setCurrentEval(eval); + eval.visit([&](const auto &stmt) { genFIR(stmt); }); if (unstructuredContext && blockIsUnterminated()) { // Exit from an unstructured IF or SELECT construct block. @@ -1682,7 +1539,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } else if (eval.isConstruct()) { assert(!eval.evaluationList->empty() && "empty construct eval list"); if (eval.evaluationList->back() - .lexicalSuccessor->isIntermediateConstructStmt()) + .lexicalSuccessor->isIntermediateConstructStmt()) successor = eval.constructExit; } if (successor && successor->block) @@ -1728,7 +1585,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } auto addrOf = builder->create( toLocation(), global.resultType(), global.getSymbol()); - SymbolIndexAnalyzer sia(sym); + SymbolBoxAnalyzer sia(sym); sia.analyze(); if (sia.isTrivial()) { addSymbol(sym, addrOf); @@ -1796,7 +1653,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->setLocation(loc); auto idxTy = builder->getIndexType(); const auto isDummy = Fortran::semantics::IsDummy(sym); - SymbolIndexAnalyzer sia(sym); + SymbolBoxAnalyzer sia(sym); sia.analyze(); if (sia.isTrivial()) { @@ -2145,6 +2002,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { } mlir::Location toLocation() { return toLocation(currentPosition); } + void setCurrentEval(Fortran::lower::pft::Evaluation &eval) { + evalPtr = &eval; + } + Fortran::lower::pft::Evaluation &getEval() { + assert(evalPtr); + return *evalPtr; + } mlir::MLIRContext &mlirContext; const Fortran::parser::CookedSource *cooked; @@ -2156,6 +2020,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::lower::SomeExpr &)> getShape; Fortran::lower::FirOpBuilder *builder = nullptr; + Fortran::lower::pft::Evaluation *evalPtr = nullptr; Fortran::lower::SymMap localSymbols; Fortran::parser::CharBlock currentPosition; }; From bc189e9c7a699362bd2c6ef59330e49a0ea7fac2 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 22 May 2020 12:22:12 -0700 Subject: [PATCH 0050/1017] move where and forall --- flang/lib/Lower/Bridge.cpp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 3f2f63ae07cc4..88d33d3c28b35 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -560,8 +560,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->restoreInsertionPoint(pair.first); } - void genFIR(const Fortran::parser::WhereStmt &) { TODO(); } - void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) { auto &eval = getEval(); mlir::Value selectExpr = genExprValue(*Fortran::semantics::GetExpr( @@ -578,8 +576,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { blockList); } - void genFIR(const Fortran::parser::ForallStmt &) { TODO(); } - void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) { auto &eval = getEval(); mlir::Value expr = genExprValue( @@ -1363,6 +1359,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { assign.u); } + void genFIR(const Fortran::parser::WhereStmt &) { TODO(); } + + void genFIR(const Fortran::parser::ForallStmt &) { TODO(); } + void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) { genAssignment(*stmt.typedAssignment->v); } From 5350bb60cac5e4233b7e4ca277d9b4101980eee8 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 22 May 2020 15:01:02 -0700 Subject: [PATCH 0051/1017] [cleanup] refactor some of the statement lowering in the bridge into different files. --- flang/lib/Lower/Bridge.cpp | 192 ++++++++++++------------------------ flang/lib/Lower/Runtime.cpp | 158 ++++++++++++++++++++++++++--- 2 files changed, 211 insertions(+), 139 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 88d33d3c28b35..5d76e34259236 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -14,6 +14,7 @@ #include "flang/Lower/FIRBuilder.h" #include "flang/Lower/IO.h" #include "flang/Lower/Mangler.h" +#include "flang/Lower/OpenMP.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" #include "flang/Optimizer/Dialect/FIRAttr.h" @@ -31,24 +32,12 @@ #include "llvm/Support/MD5.h" #undef TODO -#define TODO() \ - { \ - if (disableToDoAssertions) \ - mlir::emitError(toLocation(), __FILE__) \ - << ':' << __LINE__ << " not implemented"; \ - else \ - llvm_unreachable("not yet implemented"); \ - } +#define TODO() llvm_unreachable("not yet implemented"); static llvm::cl::opt dumpBeforeFir( "fdebug-dump-pre-fir", llvm::cl::init(false), llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation")); -static llvm::cl::opt - disableToDoAssertions("disable-burnside-todo", - llvm::cl::desc("disable burnside bridge asserts"), - llvm::cl::init(false), llvm::cl::Hidden); - static llvm::cl::opt nameLengthHashSize("length-to-hash-string-literal", llvm::cl::desc("string literals that exceed this length" @@ -679,11 +668,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { blockList); } - void genFIR(const Fortran::parser::AssociateConstruct &) { TODO(); } - void genFIR(const Fortran::parser::BlockConstruct &) { TODO(); } - void genFIR(const Fortran::parser::ChangeTeamConstruct &) { TODO(); } - void genFIR(const Fortran::parser::CriticalConstruct &) { TODO(); } - /// Generate FIR for a DO construct. There are six variants: /// - unstructured infinite and while loops /// - structured and unstructured increment loops @@ -884,11 +868,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { genFIR(e); } - void genFIR(const Fortran::parser::SelectRankConstruct &) { TODO(); } - void genFIR(const Fortran::parser::SelectTypeConstruct &) { TODO(); } - - void genFIR(const Fortran::parser::WhereConstruct &) { TODO(); } - /// Lower FORALL construct (See 10.2.4) void genFIR(const Fortran::parser::ForallConstruct &forall) { auto &stmt = std::get< @@ -937,13 +916,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::CompilerDirective &) { mlir::emitWarning(toLocation(), "ignoring all compiler directives"); } - void genFIR(const Fortran::parser::OpenMPConstruct &) { TODO(); } - void genFIR(const Fortran::parser::OmpEndLoopDirective &) { TODO(); } - void genFIR(const Fortran::parser::AssociateStmt &) { TODO(); } - void genFIR(const Fortran::parser::EndAssociateStmt &) { TODO(); } - void genFIR(const Fortran::parser::BlockStmt &) { TODO(); } - void genFIR(const Fortran::parser::EndBlockStmt &) { TODO(); } + void genFIR(const Fortran::parser::OpenMPConstruct &omp) { + genOpenMPConstruct(*this, getEval(), omp); + } + + void genFIR(const Fortran::parser::OmpEndLoopDirective &omp) { + genOpenMPEndLoop(*this, getEval(), omp); + } void genFIR(const Fortran::parser::SelectCaseStmt &stmt) { auto &eval = getEval(); @@ -1005,34 +985,39 @@ class FirConverter : public Fortran::lower::AbstractConverter { valueList, blockList); } - void genFIR(const Fortran::parser::CaseStmt &) {} // nop - void genFIR(const Fortran::parser::EndSelectStmt &) {} // nop + void genFIR(const Fortran::parser::CaseStmt &) {} // nop + void genFIR(const Fortran::parser::EndSelectStmt &) {} // nop + void genFIR(const Fortran::parser::NonLabelDoStmt &) {} // nop + void genFIR(const Fortran::parser::EndDoStmt &) {} // nop + void genFIR(const Fortran::parser::IfThenStmt &) {} // nop + void genFIR(const Fortran::parser::ElseIfStmt &) {} // nop + void genFIR(const Fortran::parser::ElseStmt &) {} // nop + void genFIR(const Fortran::parser::EndIfStmt &) {} // nop + + void genFIR(const Fortran::parser::AssociateConstruct &) { TODO(); } + void genFIR(const Fortran::parser::AssociateStmt &) { TODO(); } + void genFIR(const Fortran::parser::EndAssociateStmt &) { TODO(); } + + void genFIR(const Fortran::parser::BlockConstruct &) { TODO(); } + void genFIR(const Fortran::parser::BlockStmt &) { TODO(); } + void genFIR(const Fortran::parser::EndBlockStmt &) { TODO(); } + void genFIR(const Fortran::parser::ChangeTeamConstruct &) { TODO(); } void genFIR(const Fortran::parser::ChangeTeamStmt &) { TODO(); } void genFIR(const Fortran::parser::EndChangeTeamStmt &) { TODO(); } + + void genFIR(const Fortran::parser::CriticalConstruct &) { TODO(); } void genFIR(const Fortran::parser::CriticalStmt &) { TODO(); } void genFIR(const Fortran::parser::EndCriticalStmt &) { TODO(); } - void genFIR(const Fortran::parser::NonLabelDoStmt &) {} // nop - void genFIR(const Fortran::parser::EndDoStmt &) {} // nop - - void genFIR(const Fortran::parser::IfThenStmt &) {} // nop - void genFIR(const Fortran::parser::ElseIfStmt &) {} // nop - void genFIR(const Fortran::parser::ElseStmt &) {} // nop - void genFIR(const Fortran::parser::EndIfStmt &) {} // nop - + void genFIR(const Fortran::parser::SelectRankConstruct &) { TODO(); } void genFIR(const Fortran::parser::SelectRankStmt &) { TODO(); } void genFIR(const Fortran::parser::SelectRankCaseStmt &) { TODO(); } + + void genFIR(const Fortran::parser::SelectTypeConstruct &) { TODO(); } void genFIR(const Fortran::parser::SelectTypeStmt &) { TODO(); } void genFIR(const Fortran::parser::TypeGuardStmt &) { TODO(); } - void genFIR(const Fortran::parser::WhereConstructStmt &) { TODO(); } - void genFIR(const Fortran::parser::MaskedElsewhereStmt &) { TODO(); } - void genFIR(const Fortran::parser::ElsewhereStmt &) { TODO(); } - void genFIR(const Fortran::parser::EndWhereStmt &) { TODO(); } - void genFIR(const Fortran::parser::ForallConstructStmt &) { TODO(); } - void genFIR(const Fortran::parser::EndForallStmt &) { TODO(); } - //===--------------------------------------------------------------------===// // IO statements (see io.h) //===--------------------------------------------------------------------===// @@ -1174,30 +1159,20 @@ class FirConverter : public Fortran::lower::AbstractConverter { // do nothing } - // We don't have runtime library support for various features. When they are - // encountered, we emit an error message and exit immediately. - void noRuntimeSupport(llvm::StringRef stmt) { - mlir::emitError(toLocation(), "There is no runtime support for ") - << stmt << " statement.\n"; - std::exit(1); + void genFIR(const Fortran::parser::EventPostStmt &stmt) { + genEventPostStatement(*this, stmt); } - void genFIR(const Fortran::parser::EventPostStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport("EVENT POST"); - } - void genFIR(const Fortran::parser::EventWaitStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport("EVENT WAIT"); + void genFIR(const Fortran::parser::EventWaitStmt &stmt) { + genEventWaitStatement(*this, stmt); } - void genFIR(const Fortran::parser::FormTeamStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport("FORM TEAM"); + void genFIR(const Fortran::parser::FormTeamStmt &stmt) { + genFormTeamStatement(*this, stmt); } - void genFIR(const Fortran::parser::LockStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport("LOCK"); + + void genFIR(const Fortran::parser::LockStmt &stmt) { + genLockStatement(*this, stmt); } fir::LoopOp createLoopNest(llvm::SmallVectorImpl &lcvs, @@ -1359,8 +1334,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { assign.u); } + void genFIR(const Fortran::parser::WhereConstruct &) { TODO(); } + void genFIR(const Fortran::parser::WhereConstructStmt &) { TODO(); } + void genFIR(const Fortran::parser::MaskedElsewhereStmt &) { TODO(); } + void genFIR(const Fortran::parser::ElsewhereStmt &) { TODO(); } + void genFIR(const Fortran::parser::EndWhereStmt &) { TODO(); } void genFIR(const Fortran::parser::WhereStmt &) { TODO(); } + void genFIR(const Fortran::parser::ForallConstructStmt &) { TODO(); } + void genFIR(const Fortran::parser::EndForallStmt &) { TODO(); } void genFIR(const Fortran::parser::ForallStmt &) { TODO(); } void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) { @@ -1371,25 +1353,24 @@ class FirConverter : public Fortran::lower::AbstractConverter { genAssignment(*stmt.typedAssignment->v); } - void genFIR(const Fortran::parser::SyncAllStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport("SYNC ALL"); + void genFIR(const Fortran::parser::SyncAllStmt &stmt) { + genSyncAllStatement(*this, stmt); } - void genFIR(const Fortran::parser::SyncImagesStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport("SYNC IMAGES"); + + void genFIR(const Fortran::parser::SyncImagesStmt &stmt) { + genSyncImagesStatement(*this, stmt); } - void genFIR(const Fortran::parser::SyncMemoryStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport("SYNC MEMORY"); + + void genFIR(const Fortran::parser::SyncMemoryStmt &stmt) { + genSyncMemoryStatement(*this, stmt); } - void genFIR(const Fortran::parser::SyncTeamStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport("SYNC TEAM"); + + void genFIR(const Fortran::parser::SyncTeamStmt &stmt) { + genSyncTeamStatement(*this, stmt); } - void genFIR(const Fortran::parser::UnlockStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport("UNLOCK"); + + void genFIR(const Fortran::parser::UnlockStmt &stmt) { + genUnlockStatement(*this, stmt); } void genFIR(const Fortran::parser::AssignStmt &stmt) { @@ -1411,9 +1392,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::EntryStmt &) { TODO(); } - void genFIR(const Fortran::parser::PauseStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport("PAUSE"); + void genFIR(const Fortran::parser::PauseStmt &stmt) { + genPauseStatement(*this, stmt); } void genFIR(const Fortran::parser::DataStmt &) { @@ -1426,54 +1406,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { // call FAIL IMAGE in runtime void genFIR(const Fortran::parser::FailImageStmt &stmt) { - auto callee = genFailImageStatementRuntime(*builder); - llvm::SmallVector operands; // FAIL IMAGE has no args - builder->create(toLocation(), callee, operands); + genFailImageStatement(*this); } // call STOP, ERROR STOP in runtime void genFIR(const Fortran::parser::StopStmt &stmt) { - auto callee = genStopStatementRuntime(*builder); - auto calleeType = callee.getType(); - llvm::SmallVector operands; - assert(calleeType.getNumInputs() == 3 && - "expected 3 arguments in STOP runtime"); - // First operand is stop code (zero if absent) - if (const auto &code = - std::get>(stmt.t)) { - auto expr = Fortran::semantics::GetExpr(*code); - assert(expr && "failed getting typed expression"); - operands.push_back(genExprValue(*expr)); - } else { - operands.push_back( - builder->createIntegerConstant(calleeType.getInput(0), 0)); - } - // Second operand indicates ERROR STOP - bool isError = std::get(stmt.t) == - Fortran::parser::StopStmt::Kind::ErrorStop; - operands.push_back( - builder->createIntegerConstant(calleeType.getInput(1), isError)); - - // Third operand indicates QUIET (default to false). - if (const auto &quiet = - std::get>( - stmt.t)) { - auto expr = Fortran::semantics::GetExpr(*quiet); - assert(expr && "failed getting typed expression"); - operands.push_back(genExprValue(*expr)); - } else { - operands.push_back( - builder->createIntegerConstant(calleeType.getInput(2), 0)); - } - - // Cast operands in case they have different integer/logical types - // compare to runtime. - auto i = 0; - for (auto &op : operands) { - auto type = calleeType.getInput(i++); - op = builder->createConvert(toLocation(), type, op); - } - builder->create(toLocation(), callee, operands); + genStopStatement(*this, stmt); } // gen expression, if any; share code with END of procedure diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index 504e90be56b79..a1dc0df6eea19 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -7,12 +7,14 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/Runtime.h" +#include "../runtime/stop.h" #include "RTBuilder.h" +#include "flang/Lower/Bridge.h" #include "flang/Lower/FIRBuilder.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Semantics/tools.h" #include "llvm/ADT/SmallVector.h" -#include "../runtime/stop.h" - using Fortran::lower::operator""_rt_ident; #define MakeRuntimeEntry(X) mkKey(RTNAME(X)) @@ -28,22 +30,154 @@ static mlir::FuncOp genRuntimeFunction(Fortran::lower::FirOpBuilder &builder) { return func; } -mlir::FuncOp -Fortran::lower::genStopStatementRuntime(Fortran::lower::FirOpBuilder &builder) { +static mlir::FuncOp +genStopStatementRuntime(Fortran::lower::FirOpBuilder &builder) { return genRuntimeFunction(builder); } -mlir::FuncOp Fortran::lower::genStopStatementTextRuntime( - Fortran::lower::FirOpBuilder &builder) { +static mlir::FuncOp +genStopStatementTextRuntime(Fortran::lower::FirOpBuilder &builder) { return genRuntimeFunction(builder); } -mlir::FuncOp Fortran::lower::genFailImageStatementRuntime( - Fortran::lower::FirOpBuilder &builder) { - return genRuntimeFunction(builder); +static mlir::FuncOp +genProgramEndStatementRuntime(Fortran::lower::FirOpBuilder &builder) { + return genRuntimeFunction(builder); } -mlir::FuncOp Fortran::lower::genProgramEndStatementRuntime( - Fortran::lower::FirOpBuilder &builder) { - return genRuntimeFunction(builder); +// TODO: We don't have runtime library support for various features. When they +// are encountered, we emit an error message and exit immediately. +static void noRuntimeSupport(mlir::Location loc, llvm::StringRef stmt) { + mlir::emitError(loc, "There is no runtime support for ") + << stmt << " statement.\n"; + std::exit(1); +} + +//===----------------------------------------------------------------------===// +// Misc. Fortran statements that lower to runtime calls +//===----------------------------------------------------------------------===// + +void Fortran::lower::genStopStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::StopStmt &stmt) { + auto &builder = converter.getFirOpBuilder(); + auto loc = converter.getCurrentLocation(); + auto callee = genStopStatementRuntime(builder); + auto calleeType = callee.getType(); + llvm::SmallVector operands; + assert(calleeType.getNumInputs() == 3 && + "expected 3 arguments in STOP runtime"); + // First operand is stop code (zero if absent) + if (const auto &code = + std::get>(stmt.t)) { + auto expr = Fortran::semantics::GetExpr(*code); + assert(expr && "failed getting typed expression"); + operands.push_back(converter.genExprValue(*expr)); + } else { + operands.push_back( + builder.createIntegerConstant(calleeType.getInput(0), 0)); + } + // Second operand indicates ERROR STOP + bool isError = std::get(stmt.t) == + Fortran::parser::StopStmt::Kind::ErrorStop; + operands.push_back( + builder.createIntegerConstant(calleeType.getInput(1), isError)); + + // Third operand indicates QUIET (default to false). + if (const auto &quiet = + std::get>(stmt.t)) { + auto expr = Fortran::semantics::GetExpr(*quiet); + assert(expr && "failed getting typed expression"); + operands.push_back(converter.genExprValue(*expr)); + } else { + operands.push_back( + builder.createIntegerConstant(calleeType.getInput(2), 0)); + } + + // Cast operands in case they have different integer/logical types + // compare to runtime. + auto i = 0; + for (auto &op : operands) { + auto type = calleeType.getInput(i++); + op = builder.createConvert(loc, type, op); + } + builder.create(loc, callee, operands); +} + +void Fortran::lower::genFailImageStatement( + Fortran::lower::AbstractConverter &converter) { + auto &bldr = converter.getFirOpBuilder(); + auto loc = converter.getCurrentLocation(); + auto callee = genRuntimeFunction(bldr); + bldr.create(loc, callee, llvm::None); +} + +void Fortran::lower::genEventPostStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::EventPostStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "EVENT POST"); +} + +void Fortran::lower::genEventWaitStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::EventWaitStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "EVENT WAIT"); +} + +void Fortran::lower::genFormTeamStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::FormTeamStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "FORM TEAM"); +} + +void Fortran::lower::genLockStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::LockStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "LOCK"); +} + +void Fortran::lower::genUnlockStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::UnlockStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "UNLOCK"); +} + +void Fortran::lower::genSyncAllStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::SyncAllStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "SYNC ALL"); +} + +void Fortran::lower::genSyncImagesStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::SyncImagesStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "SYNC IMAGES"); +} + +void Fortran::lower::genSyncMemoryStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::SyncMemoryStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "SYNC MEMORY"); +} + +void Fortran::lower::genSyncTeamStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::SyncTeamStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "SYNC TEAM"); +} + +void Fortran::lower::genPauseStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::PauseStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "PAUSE"); } From 82f878733fb1ebadd78f0bd9320d96b208538daa Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 22 May 2020 18:19:45 -0700 Subject: [PATCH 0052/1017] gtest.h is not a system header --- flang/unittests/Optimizer/Basic.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/unittests/Optimizer/Basic.cpp b/flang/unittests/Optimizer/Basic.cpp index fdea2ea38b27f..8dbb91eef33d3 100644 --- a/flang/unittests/Optimizer/Basic.cpp +++ b/flang/unittests/Optimizer/Basic.cpp @@ -1,5 +1,5 @@ #include "flang/Optimizer/Support/InternalNames.h" -#include +#include "gtest/gtest.h" #include using namespace fir; From a6143d53ae21f48528f5d103c8511fd78540c040 Mon Sep 17 00:00:00 2001 From: Steve Scalpone Date: Sun, 24 May 2020 15:51:24 -0700 Subject: [PATCH 0053/1017] Update support for module, which is the destination directory for module files. Add support for intrinsic-module-directory, which is where Fortran intrinsic modules are located. --- flang/tools/bbc/bbc.cpp | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 17dc3462519b3..6d2a50dfe74f9 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -62,8 +62,13 @@ static llvm::cl::opt static llvm::cl::list includeDirs("I", llvm::cl::desc("include search paths")); -static llvm::cl::list - moduleDirs("module", llvm::cl::desc("module search paths")); +static llvm::cl::opt + intrinsicModuleDir("intrinsic-module-directory", + llvm::cl::desc("intrinsic module directory")); + +static llvm::cl::opt + moduleDir("module", llvm::cl::desc("module output directory (default .)"), + llvm::cl::init(".")); static llvm::cl::opt moduleSuffix("module-suffix", llvm::cl::desc("module file suffix override"), @@ -271,8 +276,10 @@ int main(int argc, char **argv) { if (includeDirs.size() == 0) includeDirs.push_back("."); - if (moduleDirs.size() == 0) - moduleDirs.push_back("."); + + if (!intrinsicModuleDir.empty()) { + includeDirs.insert(includeDirs.begin(), intrinsicModuleDir); + } Fortran::parser::Options options; options.predefinitions.emplace_back("__F18", "1"); @@ -287,7 +294,7 @@ int main(int argc, char **argv) { Fortran::parser::AllSources allSources; Fortran::semantics::SemanticsContext semanticsContext{ defaultKinds, options.features, allSources}; - semanticsContext.set_moduleDirectory(moduleDirs.front()) + semanticsContext.set_moduleDirectory(moduleDir) .set_moduleFileSuffix(moduleSuffix) .set_searchDirectories(includeDirs) .set_warnOnNonstandardUsage(warnStdViolation) From bbbe8589c2643bfd1988c8905c33fc0c06ed9795 Mon Sep 17 00:00:00 2001 From: zachary-selk Date: Tue, 26 May 2020 00:41:26 -0600 Subject: [PATCH 0054/1017] Fixed upper bound adjustment Adjusting properly now --- flang/lib/Optimizer/Transforms/RewriteLoop.cpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index cf199832b653a..188c538fa1553 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -44,7 +44,8 @@ class ScfLoopConv : public mlir::OpRewritePattern { auto step = loop.step(); assert(low && high && step); // ForOp has different bounds semantics. Adjust upper bound. - auto adjustUp = rewriter.create(loc, high, step); + auto diff = rewriter.create(loc, high, low); + auto adjustUp = rewriter.create(loc, diff, step); auto f = rewriter.create(loc, low, adjustUp, step); f.region().getBlocks().clear(); rewriter.inlineRegionBefore(loop.region(), f.region(), f.region().end()); From c81a9ed750dff4b33d8d1f4f104f04ae448043d0 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 26 May 2020 17:35:13 -0700 Subject: [PATCH 0055/1017] add some flags for lowering of variables --- flang/include/flang/Lower/PFTBuilder.h | 423 +++++++------------------ 1 file changed, 109 insertions(+), 314 deletions(-) diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 16abf6bc8f3a4..3e9fb2dbc1ddc 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -6,10 +6,6 @@ // //===----------------------------------------------------------------------===// // -// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ -// -//===----------------------------------------------------------------------===// -// // PFT (Pre-FIR Tree) interface. // //===----------------------------------------------------------------------===// @@ -19,20 +15,31 @@ #include "flang/Common/reference.h" #include "flang/Common/template.h" -#include "flang/Lower/PFTDefs.h" #include "flang/Parser/parse-tree.h" -#include "flang/Semantics/attr.h" -#include "flang/Semantics/symbol.h" -#include "llvm/Support/ErrorHandling.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/SmallSet.h" #include "llvm/Support/raw_ostream.h" -namespace Fortran::lower::pft { +namespace mlir { +class Block; +} + +namespace Fortran { +namespace semantics { +class SemanticsContext; +class Scope; +} // namespace semantics +namespace lower { +namespace pft { struct Evaluation; struct Program; struct ModuleLikeUnit; struct FunctionLikeUnit; +// TODO: A collection of Evaluations can obviously be any of the container +// types; leaving this as a std::list _for now_ because we reserve the right to +// insert PFT nodes in any order in O(1) time. using EvaluationList = std::list; using LabelEvalMap = llvm::DenseMap; @@ -54,11 +61,7 @@ class ReferenceVariantBase { template constexpr BaseType &get() const { - return std::get>(u).get(); - } - template - constexpr BaseType &getStatement() const { - return std::get>>(u).get().statement; + return std::get> > (u).get(); } template constexpr BaseType *getIf() const { @@ -84,10 +87,10 @@ using ReferenceVariant = ReferenceVariantBase; template using MutableReferenceVariant = ReferenceVariantBase; -/// PftNode is used to provide a reference to the unit a parse-tree node +/// ParentVariant is used to provide a reference to the unit a parse-tree node /// belongs to. It is a variant of non-nullable pointers. -using PftNode = MutableReferenceVariant; +using ParentVariant = MutableReferenceVariant; /// Classify the parse-tree nodes from ExecutablePartConstruct @@ -106,8 +109,8 @@ using ActionStmts = std::tuple< parser::ComputedGotoStmt, parser::ForallStmt, parser::ArithmeticIfStmt, parser::AssignStmt, parser::AssignedGotoStmt, parser::PauseStmt>; -using OtherStmts = - std::tuple; +using OtherStmts = std::tuple; using ConstructStmts = std::tuple< parser::AssociateStmt, parser::EndAssociateStmt, parser::BlockStmt, @@ -120,10 +123,6 @@ using ConstructStmts = std::tuple< parser::MaskedElsewhereStmt, parser::ElsewhereStmt, parser::EndWhereStmt, parser::ForallConstructStmt, parser::EndForallStmt>; -using EndStmts = - std::tuple; - using Constructs = std::tuple}; template static constexpr bool isConstructStmt{common::HasMember}; -template -static constexpr bool isEndStmt{common::HasMember}; - template static constexpr bool isConstruct{common::HasMember}; @@ -172,6 +168,10 @@ static constexpr bool isFunctionLike{common::HasMember< parser::SubroutineSubprogram, parser::SeparateModuleSubprogram>>}; +using LabelSet = llvm::SmallSet; +using SymbolRef = common::Reference; +using SymbolLabelMap = llvm::DenseMap; + template struct MakeReferenceVariantHelper {}; template @@ -186,8 +186,8 @@ template using MakeReferenceVariant = typename MakeReferenceVariantHelper::type; using EvaluationTuple = - common::CombineTuples; + common::CombineTuples; /// Hide non-nullable pointers to the parse-tree node. /// Build type std::variant /// from EvaluationTuple type (std::tuple). @@ -199,16 +199,16 @@ struct Evaluation : EvaluationVariant { /// General ctor template - Evaluation(const A &a, const PftNode &parent, + Evaluation(const A &a, const ParentVariant &parentVariant, const parser::CharBlock &position, const std::optional &label) - : EvaluationVariant{a}, parent{parent}, position{position}, label{label} { - } + : EvaluationVariant{a}, + parentVariant{parentVariant}, position{position}, label{label} {} - /// Construct and Directive ctor + /// Construct ctor template - Evaluation(const A &a, const PftNode &parent) - : EvaluationVariant{a}, parent{parent} { + Evaluation(const A &a, const ParentVariant &parentVariant) + : EvaluationVariant{a}, parentVariant{parentVariant} { static_assert(pft::isConstruct || pft::isDirective, "must be a construct or directive"); } @@ -227,10 +227,6 @@ struct Evaluation : EvaluationVariant { return pft::isConstructStmt>; }}); } - constexpr bool isEndStmt() const { - return visit(common::visitors{ - [](auto &r) { return pft::isEndStmt>; }}); - } constexpr bool isConstruct() const { return visit(common::visitors{ [](auto &r) { return pft::isConstruct>; }}); @@ -253,8 +249,6 @@ struct Evaluation : EvaluationVariant { }}); } - LLVM_DUMP_METHOD void dump() const; - /// Return the first non-nop successor of an evaluation, possibly exiting /// from one or more enclosing constructs. Evaluation &nonNopSuccessor() const { @@ -293,13 +287,14 @@ struct Evaluation : EvaluationVariant { bool lowerAsStructured() const; bool lowerAsUnstructured() const; - // FIR generation looks primarily at PFT ActionStmt and ConstructStmt leaf - // nodes. Members such as lexicalSuccessor and block are applicable only - // to these nodes. The controlSuccessor member is used for nonlexical - // successors, such as linking to a GOTO target. For multiway branches, - // it is set to the first target. Successor and exit links always target - // statements. An internal Construct node has a constructExit link that - // applies to exits from anywhere within the construct. + // FIR generation looks primarily at PFT statement (leaf) nodes. So members + // such as lexicalSuccessor and the various block fields are only applicable + // to statement nodes. One exception is that an internal construct node is + // a convenient place for a constructExit link that applies to exits from any + // statement within the construct. The controlSuccessor member is used for + // nonlexical successors, such as linking to a GOTO target. For multiway + // branches, controlSuccessor is set to one of the targets (might as well be + // the first target). Successor and exit links always target statements. // // An unstructured construct is one that contains some form of goto. This // is indicated by the isUnstructured member flag, which may be set on a @@ -308,21 +303,25 @@ struct Evaluation : EvaluationVariant { // FIR operations. An unstructured statement is materialized as mlir // operation sequences that include explicit branches. // - // The block member is set for statements that begin a new block. This - // block is the target of any branch to the statement. Statements may have - // additional (unstructured) "local" blocks, but such blocks cannot be the - // target of any explicit branch. The primary example of an (unstructured) - // statement that may have multiple associated blocks is NonLabelDoStmt, - // which may have a loop preheader block for loop initialization code (the - // block member), and always has a "local" header block that is the target - // of the loop back edge. If the NonLabelDoStmt is a concurrent loop, it - // may be associated with an arbitrary number of nested preheader, header, - // and mask blocks. + // There are two mlir::Block members. The block member is set for statements + // that begin a new block. If a statement may have more than one associated + // block, this member must be the block that would be the target of a branch + // to the statement. The prime example of a statement that may have multiple + // associated blocks is NonLabelDoStmt, which may have a loop preheader block + // for loop initialization code, and always has a header block that is the + // target of the loop back edge. If the NonLabelDoStmt is a concurrent loop, + // there may be an arbitrary number of nested preheader, header, and mask + // blocks. Any such additional blocks in the localBlocks member are local + // to a construct and cannot be the target of an unstructured branch. For + // NonLabelDoStmt, the block member designates the preheader block, which may + // be absent if loop initialization code may be appended to a predecessor + // block. The primary loop header block is localBlocks[0], with additional + // DO CONCURRENT blocks at localBlocks[1], etc. // // The printIndex member is only set for statements. It is used for dumps - // (and debugging) and does not affect FIR generation. + // and does not affect FIR generation. It may also be helpful for debugging. - PftNode parent; + ParentVariant parentVariant; parser::CharBlock position{}; std::optional label{}; std::unique_ptr evaluationList; // nested evaluations @@ -332,8 +331,9 @@ struct Evaluation : EvaluationVariant { Evaluation *constructExit{nullptr}; // set for constructs bool isNewBlock{false}; // evaluation begins a new basic block bool isUnstructured{false}; // evaluation has unstructured control flow - bool negateCondition{false}; // If[Then]Stmt condition must be negated - mlir::Block *block{nullptr}; // isNewBlock block (ActionStmt, ConstructStmt) + bool skip{false}; // evaluation has been processed in advance + mlir::Block *block{nullptr}; // isNewBlock block + llvm::SmallVector localBlocks{}; // construct local blocks int printIndex{0}; // (ActionStmt, ConstructStmt) evaluation index for dumps }; @@ -341,201 +341,52 @@ using ProgramVariant = ReferenceVariant; + parser::BlockData>; /// A program is a list of program units. /// These units can be function like, module like, or block data. struct ProgramUnit : ProgramVariant { template - ProgramUnit(const A &p, const PftNode &parent) - : ProgramVariant{p}, parent{parent} {} + ProgramUnit(const A &p, const ParentVariant &parentVariant) + : ProgramVariant{p}, parentVariant{parentVariant} {} ProgramUnit(ProgramUnit &&) = default; ProgramUnit(const ProgramUnit &) = delete; - PftNode parent; + ParentVariant parentVariant; }; /// A variable captures an object to be created per the declaration part of a /// function like unit. /// -/// Fortran EQUIVALENCE statements are a mechanism that introduces aliasing -/// between named variables. The set of overlapping aliases will materialize a -/// generic store object with a designated offset and size. Participant -/// symbols will simply be pointers into the aggregate store. -/// -/// EQUIVALENCE can also interact with COMMON and other global variables to -/// imply aliasing between (subparts of) a global and other local variable -/// names. -/// /// Properties can be applied by lowering. For example, a local array that is /// known to be very large may be transformed into a heap allocated entity by /// lowering. That decision would be tracked in its Variable instance. struct Variable { - /// Most variables are nominal and require the allocation of local/global - /// storage space. A nominal variable may also be an alias for some other - /// (subpart) of storage. - struct Nominal { - Nominal(const semantics::Symbol *symbol, int depth, bool global) - : symbol{symbol}, depth{depth}, global{global} {} - const semantics::Symbol *symbol{}; - - bool isGlobal() const { return global; } - bool isDeclaration() const { - return !symbol || symbol != &symbol->GetUltimate(); - } - - int depth{}; - bool global{}; - bool heapAlloc{}; // variable needs deallocation on exit - bool pointer{}; - bool target{}; - bool aliaser{}; // participates in EQUIVALENCE union - std::size_t aliasOffset{}; - }; - - using Interval = std::tuple; - - /// An interval of storage is a contiguous block of memory to be allocated or - /// mapped onto another variable. Aliasing variables will be pointers into - /// interval stores and may overlap each other. - struct AggregateStore { - AggregateStore(Interval &&interval, const Fortran::semantics::Scope &scope, - bool isDeclaration = false) - : interval{std::move(interval)}, scope{&scope}, isDecl{isDeclaration} {} - AggregateStore(Interval &&interval, const Fortran::semantics::Scope &scope, - const llvm::SmallVector &vars, - bool isDeclaration = false) - : interval{std::move(interval)}, scope{&scope}, vars{vars}, - isDecl{isDeclaration} {} - - bool isGlobal() const { return vars.size() > 0; } - bool isDeclaration() const { return isDecl; } - /// Get offset of the aggregate inside its scope. - std::size_t getOffset() const { return std::get<0>(interval); } - - Interval interval{}; - /// scope in which the interval is. - const Fortran::semantics::Scope *scope; - llvm::SmallVector vars{}; - /// Is this a declaration of a storage defined in another scope ? - bool isDecl; - }; - explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false, int depth = 0) - : var{Nominal(&sym, depth, global)} {} - explicit Variable(AggregateStore &&istore) : var{std::move(istore)} {} - - /// Return the front-end symbol for a nominal variable. - const Fortran::semantics::Symbol &getSymbol() const { - assert(hasSymbol() && "variable is not nominal"); - return *std::get(var).symbol; - } - - /// Return the aggregate store. - const AggregateStore &getAggregateStore() const { - assert(isAggregateStore()); - return std::get(var); - } - - /// Return the interval range of an aggregate store. - const Interval &getInterval() const { - assert(isAggregateStore()); - return std::get(var).interval; - } - - /// Only nominal variable have front-end symbols. - bool hasSymbol() const { return std::holds_alternative(var); } - - /// Is this an aggregate store? - bool isAggregateStore() const { - return std::holds_alternative(var); - } - - /// Is this variable a global? - bool isGlobal() const { - return std::visit([](const auto &x) { return x.isGlobal(); }, var); - } - - /// Is this a declaration of a variable owned by another scope ? - bool isDeclaration() const { - return std::visit([](const auto &x) { return x.isDeclaration(); }, var); - } - - const Fortran::semantics::Scope *getOwningScope() const { - return std::visit( - common::visitors{ - [](const Nominal &x) { return &x.symbol->GetUltimate().owner(); }, - [](const AggregateStore &agg) { return agg.scope; }}, - var); - } - - bool isHeapAlloc() const { - if (const auto *s = std::get_if(&var)) - return s->heapAlloc; - return false; - } - bool isPointer() const { - if (const auto *s = std::get_if(&var)) - return s->pointer; - return false; - } - bool isTarget() const { - if (const auto *s = std::get_if(&var)) - return s->target; - return false; - } + : sym{&sym}, depth{depth}, global{global} {} - /// An alias(er) is a variable that is part of a EQUIVALENCE that is allocated - /// locally on the stack. - bool isAlias() const { - if (const auto *s = std::get_if(&var)) - return s->aliaser; - return false; - } - std::size_t getAlias() const { - if (auto *s = std::get_if(&var)) - return s->aliasOffset; - return 0; - } - void setAlias(std::size_t offset) { - if (auto *s = std::get_if(&var)) { - s->aliaser = true; - s->aliasOffset = offset; - } else { - llvm_unreachable("not a nominal var"); - } - } + const Fortran::semantics::Symbol &getSymbol() const { return *sym; } - void setHeapAlloc(bool to = true) { - if (auto *s = std::get_if(&var)) - s->heapAlloc = to; - else - llvm_unreachable("not a nominal var"); - } - void setPointer(bool to = true) { - if (auto *s = std::get_if(&var)) - s->pointer = to; - else - llvm_unreachable("not a nominal var"); - } - void setTarget(bool to = true) { - if (auto *s = std::get_if(&var)) - s->target = to; - else - llvm_unreachable("not a nominal var"); - } + bool isGlobal() const { return global; } + bool isHeapAlloc() const { return heapAlloc; } + bool isPointer() const { return pointer; } + bool isTarget() const { return target; } + int getDepth() const { return depth; } + void setHeapAlloc(bool to = true) { heapAlloc = to; } + void setPointer(bool to = true) { pointer = to; } + void setTarget(bool to = true) { target = to; } - /// The depth is recorded for nominal variables as a debugging aid. - int getDepth() const { - if (const auto *s = std::get_if(&var)) - return s->depth; - return 0; - } - - LLVM_DUMP_METHOD void dump() const; + void setHeapAlloc(bool to = true) { heapAlloc = to; } + void setPointer(bool to = true) { pointer = to; } + void setTarget(bool to = true) { target = to; } private: - std::variant var; + const Fortran::semantics::Symbol *sym; + int depth; + bool global; + bool heapAlloc{false}; // variable needs deallocation on exit + bool pointer{false}; + bool target{false}; }; /// Function-like units may contain evaluations (executable statements) and @@ -553,30 +404,22 @@ struct FunctionLikeUnit : public ProgramUnit { parser::Statement>; FunctionLikeUnit( - const parser::MainProgram &f, const PftNode &parent, + const parser::MainProgram &f, const ParentVariant &parentVariant, const Fortran::semantics::SemanticsContext &semanticsContext); FunctionLikeUnit( - const parser::FunctionSubprogram &f, const PftNode &parent, + const parser::FunctionSubprogram &f, const ParentVariant &parentVariant, const Fortran::semantics::SemanticsContext &semanticsContext); FunctionLikeUnit( - const parser::SubroutineSubprogram &f, const PftNode &parent, + const parser::SubroutineSubprogram &f, const ParentVariant &parentVariant, const Fortran::semantics::SemanticsContext &semanticsContext); FunctionLikeUnit( - const parser::SeparateModuleSubprogram &f, const PftNode &parent, + const parser::SeparateModuleSubprogram &f, + const ParentVariant &parentVariant, const Fortran::semantics::SemanticsContext &semanticsContext); FunctionLikeUnit(FunctionLikeUnit &&) = default; FunctionLikeUnit(const FunctionLikeUnit &) = delete; - /// Return true iff this function like unit is Fortran recursive (actually - /// meaning it's reentrant). - bool isRecursive() const { - if (isMainProgram()) - return false; - const auto &sym = getSubprogramSymbol(); - return sym.attrs().test(semantics::Attr::RECURSIVE) || - (!sym.attrs().test(semantics::Attr::NON_RECURSIVE) && - defaultRecursiveFunctionSetting()); - } + void processSymbolTable(const Fortran::semantics::Scope &); std::vector getOrderedSymbolTable() { return varList[0]; } @@ -593,36 +436,18 @@ struct FunctionLikeUnit : public ProgramUnit { return stmtSourceLoc(endStmt); } - void setActiveEntry(int entryIndex) { - assert(entryIndex >= 0 && entryIndex < (int)entryPointList.size() && - "invalid entry point index"); - activeEntry = entryIndex; - } - - /// Return a reference to the subprogram symbol of this FunctionLikeUnit. - /// This should not be called if the FunctionLikeUnit is the main program - /// since anonymous main programs do not have a symbol. + /// Returns reference to the subprogram symbol of this FunctionLikeUnit. + /// Dies if the FunctionLikeUnit is not a subprogram. const semantics::Symbol &getSubprogramSymbol() const { - const auto *symbol = entryPointList[activeEntry].first; - if (!symbol) - llvm::report_fatal_error( - "not inside a procedure; do not call on main program."); + assert(symbol && "not inside a procedure"); return *symbol; } - /// Return a pointer to the current entry point Evaluation. - /// This is null for a primary entry point. - Evaluation *getEntryEval() const { - return entryPointList[activeEntry].second; - } - /// Helper to get location from FunctionLikeUnit begin/end statements. static parser::CharBlock stmtSourceLoc(const FunctionStatement &stmt) { return stmt.visit(common::visitors{[](const auto &x) { return x.source; }}); } - LLVM_DUMP_METHOD void dump() const; - /// Anonymous programs do not have a begin statement std::optional beginStmt; FunctionStatement endStmt; @@ -630,20 +455,11 @@ struct FunctionLikeUnit : public ProgramUnit { LabelEvalMap labelEvaluationMap; SymbolLabelMap assignSymbolLabelMap; std::list nestedFunctions; - /// pairs for each entry point. The pair at index 0 - /// is the primary entry point; remaining pairs are alternate entry points. - /// The primary entry point symbol is Null for an anonymous program. - /// A named program symbol has MainProgramDetails. Other symbols have - /// SubprogramDetails. Evaluations are filled in for alternate entries. - llvm::SmallVector, 1> - entryPointList{std::pair{nullptr, nullptr}}; - /// Current index into entryPointList. Index 0 is the primary entry point. - int activeEntry = 0; - /// Dummy arguments that are not universal across entry points. - llvm::SmallVector nonUniversalDummyArguments; - /// Primary result for function subprograms with alternate entries. This - /// is one of the largest result values, not necessarily the first one. - const semantics::Symbol *primaryResult{nullptr}; + /// Symbol associated to this FunctionLikeUnit. + /// Null if the FunctionLikeUnit is an anonymous program. + /// The symbol has MainProgramDetails for named programs, otherwise it has + /// SubprogramDetails. + const semantics::Symbol *symbol{nullptr}; /// Terminal basic block (if any) mlir::Block *finalBlock{}; std::vector> varList; @@ -658,66 +474,44 @@ struct ModuleLikeUnit : public ProgramUnit { parser::Statement, parser::Statement>; - ModuleLikeUnit(const parser::Module &m, const PftNode &parent); - ModuleLikeUnit(const parser::Submodule &m, const PftNode &parent); + ModuleLikeUnit(const parser::Module &m, const ParentVariant &parentVariant); + ModuleLikeUnit(const parser::Submodule &m, + const ParentVariant &parentVariant); ~ModuleLikeUnit() = default; ModuleLikeUnit(ModuleLikeUnit &&) = default; ModuleLikeUnit(const ModuleLikeUnit &) = delete; - LLVM_DUMP_METHOD void dump() const; - - std::vector getOrderedSymbolTable() { return varList[0]; } - ModuleStatement beginStmt; ModuleStatement endStmt; std::list nestedFunctions; - std::vector> varList; }; -/// Block data units contain the variables and data initializers for common -/// blocks, etc. struct BlockDataUnit : public ProgramUnit { - BlockDataUnit(const parser::BlockData &bd, const PftNode &parent, - const Fortran::semantics::SemanticsContext &semanticsContext); + BlockDataUnit(const parser::BlockData &bd, + const ParentVariant &parentVariant); BlockDataUnit(BlockDataUnit &&) = default; BlockDataUnit(const BlockDataUnit &) = delete; - - LLVM_DUMP_METHOD void dump() const; - - const Fortran::semantics::Scope &symTab; // symbol table -}; - -// Top level compiler directives -struct CompilerDirectiveUnit : public ProgramUnit { - CompilerDirectiveUnit(const parser::CompilerDirective &directive, - const PftNode &parent) - : ProgramUnit{directive, parent} {}; - CompilerDirectiveUnit(CompilerDirectiveUnit &&) = default; - CompilerDirectiveUnit(const CompilerDirectiveUnit &) = delete; }; /// A Program is the top-level root of the PFT. struct Program { - using Units = std::variant; + using Units = std::variant; Program() = default; Program(Program &&) = default; Program(const Program &) = delete; - const std::list &getUnits() const { return units; } std::list &getUnits() { return units; } /// LLVM dump method on a Program. - LLVM_DUMP_METHOD void dump() const; + void dump(); private: std::list units; }; -} // namespace Fortran::lower::pft +} // namespace pft -namespace Fortran::lower { /// Create a PFT (Pre-FIR Tree) from the parse tree. /// /// A PFT is a light weight tree over the parse tree that is used to create FIR. @@ -731,8 +525,9 @@ createPFT(const parser::Program &root, const Fortran::semantics::SemanticsContext &semanticsContext); /// Dumper for displaying a PFT. -void dumpPFT(llvm::raw_ostream &outputStream, const pft::Program &pft); +void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft); -} // namespace Fortran::lower +} // namespace lower +} // namespace Fortran #endif // FORTRAN_LOWER_PFTBUILDER_H From 2aa8c835e9111d85f03253daac63551ed2ff08b2 Mon Sep 17 00:00:00 2001 From: Sameeran joshi Date: Wed, 27 May 2020 00:58:32 +0530 Subject: [PATCH 0056/1017] Unittest for InternalNamesTest.h Add some more deconstruct unit tests and fix a bug in readName and readInt git-clang-formatted code --- flang/unittests/Optimizer/Basic.cpp | 18 ------------------ 1 file changed, 18 deletions(-) delete mode 100644 flang/unittests/Optimizer/Basic.cpp diff --git a/flang/unittests/Optimizer/Basic.cpp b/flang/unittests/Optimizer/Basic.cpp deleted file mode 100644 index 8dbb91eef33d3..0000000000000 --- a/flang/unittests/Optimizer/Basic.cpp +++ /dev/null @@ -1,18 +0,0 @@ -#include "flang/Optimizer/Support/InternalNames.h" -#include "gtest/gtest.h" -#include - -using namespace fir; -using namespace llvm; - -TEST(genericName, MyTest) { - NameUniquer obj; - std::string val = obj.doCommonBlock("hello"); - std::cout << val; -} - -int main(int argc, char **argv) { - testing::InitGoogleTest(&argc, argv); - return RUN_ALL_TESTS(); -} - From 7880063591a3b3abfd07b72fb52b55c10ff194ec Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 27 May 2020 11:49:48 -0700 Subject: [PATCH 0057/1017] revert PR #97 wait for a more comprehensive fix that does not use scf.for as an intermediate lowering step. --- flang/lib/Optimizer/Transforms/RewriteLoop.cpp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 188c538fa1553..cf199832b653a 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -44,8 +44,7 @@ class ScfLoopConv : public mlir::OpRewritePattern { auto step = loop.step(); assert(low && high && step); // ForOp has different bounds semantics. Adjust upper bound. - auto diff = rewriter.create(loc, high, low); - auto adjustUp = rewriter.create(loc, diff, step); + auto adjustUp = rewriter.create(loc, high, step); auto f = rewriter.create(loc, low, adjustUp, step); f.region().getBlocks().clear(); rewriter.inlineRegionBefore(loop.region(), f.region(), f.region().end()); From 195b1b3896e3bc725fe84d8c612ab0bbacafb72c Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 21 May 2020 16:34:50 -0700 Subject: [PATCH 0058/1017] work on allocatable/pointer locals --- flang/include/flang/Lower/PFTBuilder.h | 3 --- flang/lib/Lower/Bridge.cpp | 36 +++++++++++++++++--------- flang/test/Lower/variable.f90 | 12 +++++++++ 3 files changed, 36 insertions(+), 15 deletions(-) create mode 100644 flang/test/Lower/variable.f90 diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 3e9fb2dbc1ddc..044e6084330fa 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -372,9 +372,6 @@ struct Variable { bool isPointer() const { return pointer; } bool isTarget() const { return target; } int getDepth() const { return depth; } - void setHeapAlloc(bool to = true) { heapAlloc = to; } - void setPointer(bool to = true) { pointer = to; } - void setTarget(bool to = true) { target = to; } void setHeapAlloc(bool to = true) { heapAlloc = to; } void setPointer(bool to = true) { pointer = to; } diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 5d76e34259236..5366acd2321e7 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1564,10 +1564,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// point of the builder must be in the entry block, which is currently being /// constructed. mlir::Value createNewLocal(mlir::Location loc, - const Fortran::semantics::Symbol &sym, + const Fortran::lower::pft::Variable &var, llvm::ArrayRef shape = {}) { - auto ty = genType(sym); - auto nm = sym.name().ToString(); + auto nm = var.getSymbol().name().ToString(); + auto ty = genType(var.getSymbol()); + if (var.isPointer()) + ty = fir::PointerType::get(ty); + else if (var.isHeapAlloc()) + ty = fir::HeapType::get(ty); if (shape.size()) if (auto arrTy = ty.dyn_cast()) { // elide the constant dimensions before construction @@ -1577,9 +1581,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { for (unsigned i = 0, end = arrTy.getDimension(); i < end; ++i) if (typeShape[i] == fir::SequenceType::getUnknownExtent()) args.push_back(shape[i]); - return builder->allocateLocal(loc, ty, nm, args); + return builder->allocateLocal(loc, ty, nm, args, var.isTarget()); } - return builder->allocateLocal(loc, ty, nm, shape); + auto local = builder->allocateLocal(loc, ty, nm, shape, var.isTarget()); + // Set local pointer/allocatable to null. + if (var.isHeapAlloc() || var.isPointer()) { + auto zero = builder->createIntegerConstant(builder->getIndexType(), 0); + auto null = builder->createConvert(loc, ty, zero); + builder->create(loc, null, local); + } + return local; } /// Instantiate a local variable. Precondition: Each variable will be visited @@ -1604,7 +1615,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // to be handled as dummy parameters.) // Otherwise, it's a local variable. - auto local = createNewLocal(loc, sym); + auto local = createNewLocal(loc, var); addSymbol(sym, local); return; } @@ -1659,7 +1670,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { // if object is an array process the lower bound and extent values llvm::SmallVector extents; llvm::SmallVector lbounds; - mustBeDummy = !isExplicitShape(sym); + mustBeDummy = !isExplicitShape(sym) && + !Fortran::semantics::IsAllocatableOrPointer(sym); if (sia.staticSize) { // object shape is constant auto castTy = builder->getRefType(genType(sym)); @@ -1676,7 +1688,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { return; } // local CHARACTER array with constant size - auto local = createNewLocal(loc, sym); + auto local = createNewLocal(loc, var); localSymbols.addCharSymbolWithShape(sym, local, len, shape); return; } @@ -1685,7 +1697,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { return; } // local array with constant size - auto local = createNewLocal(loc, sym); + auto local = createNewLocal(loc, var); localSymbols.addSymbolWithShape(sym, local, shape); return; } @@ -1746,7 +1758,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::SmallVector shape; shape.push_back(len); shape.append(extents.begin(), extents.end()); - auto local = createNewLocal(loc, sym, shape); + auto local = createNewLocal(loc, var, shape); localSymbols.addCharSymbolWithBounds(sym, local, len, extents, lbounds); return; } @@ -1756,7 +1768,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // local array with computed bounds assert(!mustBeDummy); - auto local = createNewLocal(loc, sym, extents); + auto local = createNewLocal(loc, var, extents); localSymbols.addSymbolWithBounds(sym, local, extents, lbounds); return; } @@ -1779,7 +1791,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { addSymbol(sym, addr, true); return; } - auto local = createNewLocal(loc, sym); + auto local = createNewLocal(loc, var); addSymbol(sym, local); } diff --git a/flang/test/Lower/variable.f90 b/flang/test/Lower/variable.f90 new file mode 100644 index 0000000000000..35517a09a27d0 --- /dev/null +++ b/flang/test/Lower/variable.f90 @@ -0,0 +1,12 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPs() { +subroutine s + ! CHECK-DAG: fir.alloca !fir.heap {name = "ally"} + integer, allocatable :: ally + ! CHECK-DAG: fir.alloca !fir.ptr {name = "pointy"} + integer, pointer :: pointy + ! CHECK-DAG: fir.alloca i32 {name = "bullseye", target} + integer, target :: bullseye + ! CHECK: return +end subroutine s From fb10fb2640d01307ea72a3c6dd069bf2780acd50 Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 27 May 2020 13:35:18 -0700 Subject: [PATCH 0059/1017] finish pushing Variable down to the type converter/builder --- flang/lib/Lower/Bridge.cpp | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 5366acd2321e7..60f5828d6ea15 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -254,6 +254,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { return Fortran::lower::translateSomeExprToFIRType(&mlirContext, defaults, &expr); } + mlir::Type genType(const Fortran::lower::pft::Variable &var) override final { + return Fortran::lower::translateVariableToFIRType(&mlirContext, defaults, + var); + } mlir::Type genType(Fortran::lower::SymbolRef sym) override final { return Fortran::lower::translateSymbolToFIRType(&mlirContext, defaults, sym); @@ -1509,7 +1513,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (!sym.GetType()->AsIntrinsic()) { TODO(); // Derived type / polymorphic } - auto symTy = genType(sym); + auto symTy = genType(var); auto loc = toLocation(); global = builder->createGlobal( loc, symTy, globalName, isConst, @@ -1519,7 +1523,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder.create(loc, castTo); }); } else { - global = builder->createGlobal(toLocation(), genType(sym), globalName); + global = builder->createGlobal(toLocation(), genType(var), globalName); } auto addrOf = builder->create( toLocation(), global.resultType(), global.getSymbol()); @@ -1567,11 +1571,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::lower::pft::Variable &var, llvm::ArrayRef shape = {}) { auto nm = var.getSymbol().name().ToString(); - auto ty = genType(var.getSymbol()); - if (var.isPointer()) - ty = fir::PointerType::get(ty); - else if (var.isHeapAlloc()) - ty = fir::HeapType::get(ty); + auto ty = genType(var); if (shape.size()) if (auto arrTy = ty.dyn_cast()) { // elide the constant dimensions before construction @@ -1674,7 +1674,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { !Fortran::semantics::IsAllocatableOrPointer(sym); if (sia.staticSize) { // object shape is constant - auto castTy = builder->getRefType(genType(sym)); + auto castTy = builder->getRefType(genType(var)); if (addr) addr = builder->createConvert(loc, castTy, addr); if (sia.lboundIsAllOnes()) { @@ -1703,7 +1703,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } else { // cast to the known constant parts from the declaration - auto castTy = builder->getRefType(genType(sym)); + auto castTy = builder->getRefType(genType(var)); if (addr) { // XXX: special handling for boxchar; see proviso above if (auto box = @@ -1780,7 +1780,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { return; } assert(!mustBeDummy); - auto charTy = genType(sym); + auto charTy = genType(var); auto c = sia.getCharLenConst(); mlir::Value local = c ? builder->createCharacterTemp(charTy, *c) : builder->createCharacterTemp(charTy, len); From 43cfe7ba10b536569319ffaae1e68e4e53fa2c21 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 28 May 2020 10:35:23 -0700 Subject: [PATCH 0060/1017] revert PR #98 compilation failures in InternalNamesTest.cpp add back Basic.cpp unit test to finish the revert --- flang/unittests/Optimizer/Basic.cpp | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 flang/unittests/Optimizer/Basic.cpp diff --git a/flang/unittests/Optimizer/Basic.cpp b/flang/unittests/Optimizer/Basic.cpp new file mode 100644 index 0000000000000..8dbb91eef33d3 --- /dev/null +++ b/flang/unittests/Optimizer/Basic.cpp @@ -0,0 +1,18 @@ +#include "flang/Optimizer/Support/InternalNames.h" +#include "gtest/gtest.h" +#include + +using namespace fir; +using namespace llvm; + +TEST(genericName, MyTest) { + NameUniquer obj; + std::string val = obj.doCommonBlock("hello"); + std::cout << val; +} + +int main(int argc, char **argv) { + testing::InitGoogleTest(&argc, argv); + return RUN_ALL_TESTS(); +} + From 5dccdbf1b7ac97af1ba5b1b3e7701b2e879d26d2 Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 27 May 2020 19:38:28 -0700 Subject: [PATCH 0061/1017] [refactoring] This refactors one of the extensions out of FirOpBuilder and turns it into its own standalone class. Some of the reasons to do this: 1. Ease upstreaming a bit so that the bridge isn't giant monolithic chunks of code that are hard on reviewers, etc. Let's things be upstreamed in smaller chunks. 2. Get rid of the arguably gratuitous use of CRTP here. That eliminates a significant percentage of boilerplate fluff that just made the code difficult to read and maintain. Since the extension was really only used with exactly one class, the template machinery merely logically partitioned a monolithic interface, which can be done more directly with a simple class, as shown in this patch. 3. Moves in the direction of making FirOpBuilder a more principled class that helps solve one problem: the creation/insertion of Ops into the IR of a FuncOp. respond to review comments --- flang/lib/Lower/Intrinsics.cpp | 39 ++++++++++++++++++++++++---------- 1 file changed, 28 insertions(+), 11 deletions(-) diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index 94335bd83c892..d1564cc47d5ff 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -14,6 +14,7 @@ //===----------------------------------------------------------------------===// #include "RTBuilder.h" +#include "flang/Lower/ComplexExpr.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/FIRBuilder.h" #include "flang/Lower/Runtime.h" @@ -84,6 +85,13 @@ enum class ExtremumBehavior { // TODO error handling -> return a code or directly emit messages ? struct IntrinsicLibrary { + // Constructors. + explicit IntrinsicLibrary(Fortran::lower::FirOpBuilder &builder, + mlir::Location loc) + : builder{builder}, loc{loc} {} + IntrinsicLibrary() = delete; + IntrinsicLibrary(const IntrinsicLibrary &) = delete; + /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg /// and expected result type \p resultType. mlir::Value genIntrinsicCall(llvm::StringRef name, mlir::Type resultType, @@ -132,6 +140,7 @@ struct IntrinsicLibrary { llvm::ArrayRef args); Fortran::lower::FirOpBuilder &builder; + mlir::Location loc; }; /// Table that drives the fir generation depending on the intrinsic. @@ -559,7 +568,6 @@ IntrinsicLibrary::outlineInWrapper(Generator generator, llvm::StringRef name, mlir::Type resultType, llvm::ArrayRef args) { auto module = builder.getModule(); - auto *mlirContext = module.getContext(); auto funcType = getFunctionType(resultType, args, builder); std::string wrapperName = getIntrinsicWrapperName(name, funcType); auto function = builder.getNamedFunction(wrapperName); @@ -581,14 +589,16 @@ IntrinsicLibrary::outlineInWrapper(Generator generator, llvm::StringRef name, // Location of code inside wrapper of the wrapper is independent from // the location of the intrinsic call. - auto localLoc = mlir::UnknownLoc::get(mlirContext); + auto savedLoc = loc; + auto localLoc = localBuilder->getUnknownLoc(); localBuilder->setLocation(localLoc); - IntrinsicLibrary localLib{*localBuilder}; + IntrinsicLibrary localLib{*localBuilder, localLoc}; mlir::Value result = generator ? std::invoke(generator, localLib, resultType, localArguments) : std::invoke(&IntrinsicLibrary::genRuntimeCall, localLib, name, resultType, localArguments); localBuilder->createHere(result); + loc = savedLoc; } else { // Wrapper was already built, ensure it has the sought type assert(function.getType() == funcType); @@ -667,7 +677,8 @@ mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType, } if (fir::isa_complex(type)) { // Use HYPOT to fulfill the no underflow/overflow requirement. - auto parts = builder.extractParts(arg); + auto parts = + Fortran::lower::ComplexExprHelper{builder, loc}.extractParts(arg); llvm::SmallVector args = {parts.first, parts.second}; return genIntrinsicCall("hypot", resultType, args); } @@ -678,7 +689,8 @@ mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType, mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType, llvm::ArrayRef args) { assert(args.size() == 1); - return builder.extractComplexPart(args[0], true /* isImagPart */); + return Fortran::lower::ComplexExprHelper{builder, loc}.extractComplexPart( + args[0], true /* isImagPart */); } // CEILING @@ -702,9 +714,12 @@ mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType, llvm_unreachable("argument type mismatch"); mlir::Value cplx = args[0]; - auto imag = builder.extractComplexPart(cplx, /*isImagPart=*/true); + auto imag = + Fortran::lower::ComplexExprHelper{builder, loc}.extractComplexPart( + cplx, /*isImagPart=*/true); auto negImag = builder.createHere(imag); - return builder.insertComplexPart(cplx, negImag, /*isImagPart=*/true); + return Fortran::lower::ComplexExprHelper{builder, loc}.insertComplexPart( + cplx, negImag, /*isImagPart=*/true); } // FLOOR @@ -870,7 +885,8 @@ template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genIntrinsicCall( llvm::StringRef name, mlir::Type resultType, llvm::ArrayRef args) { - return IntrinsicLibrary{impl()}.genIntrinsicCall(name, resultType, args); + return IntrinsicLibrary{impl(), impl().getLoc()}.genIntrinsicCall( + name, resultType, args); } template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder:: @@ -881,7 +897,7 @@ template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genMax( llvm::ArrayRef args) { assert(args.size() > 0 && "max requires at least one argument"); - return IntrinsicLibrary{impl()} + return IntrinsicLibrary{impl(), impl().getLoc()} .genExtremum(args[0].getType(), args); } @@ -892,7 +908,7 @@ template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genMin( llvm::ArrayRef args) { assert(args.size() > 0 && "min requires at least one argument"); - return IntrinsicLibrary{impl()} + return IntrinsicLibrary{impl(), impl().getLoc()} .genExtremum(args[0].getType(), args); } @@ -903,7 +919,8 @@ template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genPow(mlir::Type type, mlir::Value x, mlir::Value y) { - return IntrinsicLibrary{impl()}.genRuntimeCall("pow", type, {x, y}); + return IntrinsicLibrary{impl(), impl().getLoc()}.genRuntimeCall("pow", type, + {x, y}); } template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder< Fortran::lower::FirOpBuilder>::genPow(mlir::Type, mlir::Value, mlir::Value); From a91d35239db91f1ee179da5759433ec104c2fff0 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 28 May 2020 12:02:07 -0700 Subject: [PATCH 0062/1017] fix a bug in the parse of fir.if improve the builder method to reflect that we can now thread ssa-values rebase fallout remove the translation of fir.if to scf.if. Instead of going through the scf construct, we lower the the WhereOp directly to a primitive CFG. --- flang/lib/Optimizer/Transforms/CSE.cpp | 8 +- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 86 +++++++++++++------ 2 files changed, 68 insertions(+), 26 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp index df21ae29a1178..5c3f406c2fc0c 100644 --- a/flang/lib/Optimizer/Transforms/CSE.cpp +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -90,9 +90,13 @@ struct SimpleOperationInfo : public llvm::DenseMapInfo { return false; // Compare operands. if (lhs->isCommutative()) { - SmallVector lops(lhs->operand_begin(), lhs->operand_end()); + SmallVector lops; + for (const auto &lod : lhs->getOperands()) + lops.push_back(lod.getAsOpaquePointer()); llvm::sort(lops.begin(), lops.end()); - SmallVector rops(rhs->operand_begin(), rhs->operand_end()); + SmallVector rops; + for (const auto &rod : rhs->getOperands()) + rops.push_back(rod.getAsOpaquePointer()); llvm::sort(rops.begin(), rops.end()); if (!std::equal(lops.begin(), lops.end(), rops.begin())) return false; diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index cf199832b653a..c6cb2b0174762 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -25,17 +25,18 @@ using namespace fir; namespace { -// Conversion to the SCF dialect. +// Conversion of fir control ops to more primitive control-flow. // // FIR loops that cannot be converted to the affine dialect will remain as -// `fir.do_loop` operations. These can be converted to `scf.for` operations. -// MLIR includes a pass to lower `scf.for` operations to a CFG. +// `fir.do_loop` operations. These can be converted to control-flow operations. /// Convert `fir.do_loop` to `scf.for` class ScfLoopConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; + // FIXME: This should NOT be using scf.for. Instead, fir.do_loop should be + // lowered to a semantically correct CFG. mlir::LogicalResult matchAndRewrite(LoopOp loop, mlir::PatternRewriter &rewriter) const override { auto loc = loop.getLoc(); @@ -53,43 +54,80 @@ class ScfLoopConv : public mlir::OpRewritePattern { } }; -/// Convert `fir.if` to `scf.if` -class ScfIfConv : public mlir::OpRewritePattern { +/// Convert `fir.result` to `scf.yield` +class ScfResultConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; mlir::LogicalResult - matchAndRewrite(WhereOp where, + matchAndRewrite(fir::ResultOp op, mlir::PatternRewriter &rewriter) const override { - auto loc = where.getLoc(); - bool hasOtherRegion = !where.otherRegion().empty(); - auto cond = where.condition(); - auto ifOp = rewriter.create(loc, cond, hasOtherRegion); - rewriter.inlineRegionBefore(where.whereRegion(), &ifOp.thenRegion().back()); - ifOp.thenRegion().back().erase(); - if (hasOtherRegion) { - rewriter.inlineRegionBefore(where.otherRegion(), - &ifOp.elseRegion().back()); - ifOp.elseRegion().back().erase(); - } - rewriter.eraseOp(where); + rewriter.replaceOpWithNewOp(op); return success(); } }; -/// Convert `fir.result` to `scf.yield` -class ScfResultConv : public mlir::OpRewritePattern { +/// Convert `fir.if` to control-flow +class ScfIfConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; mlir::LogicalResult - matchAndRewrite(fir::ResultOp op, + matchAndRewrite(WhereOp where, mlir::PatternRewriter &rewriter) const override { - rewriter.replaceOpWithNewOp(op); + auto loc = where.getLoc(); + + // Split the block containing the 'fir.if' into two parts. The part before + // will contain the condition, the part after will be the continuation + // point. + auto *condBlock = rewriter.getInsertionBlock(); + auto opPosition = rewriter.getInsertionPoint(); + auto *remainingOpsBlock = rewriter.splitBlock(condBlock, opPosition); + mlir::Block *continueBlock; + if (where.getNumResults() == 0) { + continueBlock = remainingOpsBlock; + } else { + continueBlock = + rewriter.createBlock(remainingOpsBlock, where.getResultTypes()); + rewriter.create(loc, remainingOpsBlock); + } + + // Move blocks from the "then" region to the region containing 'fir.if', + // place it before the continuation block, and branch to it. + auto &whereRegion = where.whereRegion(); + auto *whereBlock = &whereRegion.front(); + mlir::Operation *whereTerminator = whereRegion.back().getTerminator(); + mlir::ValueRange whereTerminatorOperands = whereTerminator->getOperands(); + rewriter.setInsertionPointToEnd(&whereRegion.back()); + rewriter.create(loc, continueBlock, whereTerminatorOperands); + rewriter.eraseOp(whereTerminator); + rewriter.inlineRegionBefore(whereRegion, continueBlock); + + // Move blocks from the "else" region (if present) to the region containing + // 'fir.if', place it before the continuation block and branch to it. It + // will be placed after the "then" regions. + auto *otherwiseBlock = continueBlock; + auto &otherwiseRegion = where.otherRegion(); + if (!otherwiseRegion.empty()) { + otherwiseBlock = &otherwiseRegion.front(); + mlir::Operation *otherwiseTerm = otherwiseRegion.back().getTerminator(); + mlir::ValueRange otherwiseTermOperands = otherwiseTerm->getOperands(); + rewriter.setInsertionPointToEnd(&otherwiseRegion.back()); + rewriter.create(loc, continueBlock, otherwiseTermOperands); + rewriter.eraseOp(otherwiseTerm); + rewriter.inlineRegionBefore(otherwiseRegion, continueBlock); + } + + rewriter.setInsertionPointToEnd(condBlock); + rewriter.create( + loc, where.condition(), whereBlock, llvm::ArrayRef(), + otherwiseBlock, llvm::ArrayRef()); + rewriter.replaceOp(where, continueBlock->getArguments()); return success(); } }; +/// Convert `fir.iter_while` to control-flow. class ScfIterWhileConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -157,8 +195,8 @@ class ScfIterWhileConv : public mlir::OpRewritePattern { // Remember to AND in the early-exit bool. auto comparison = rewriter.create(loc, comp1, iterateVar); rewriter.create(loc, comparison, firstBodyBlock, - ArrayRef(), endBlock, - ArrayRef()); + llvm::ArrayRef(), endBlock, + llvm::ArrayRef()); // The result of the loop operation is the values of the condition block // arguments except the induction variable on the last iteration. rewriter.replaceOp(whileOp, conditionBlock->getArguments().drop_front()); From 5ddf08eedad83b504279157d63093a3a4e05172b Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Mon, 18 May 2020 09:59:10 -0700 Subject: [PATCH 0063/1017] Define and use a call interface utility common to caller and callee sides This patch groups three places that where dealing with function interfaces into a single place (there was a type utility, the callee and caller side). It introduces a CallInterface class utility that uses evaluate::characteristics::Procedure to decide what FIR signature must have the relater mlir::FuncOp. The decision logic (inside CallInterfaceImpl) is shared between caller and callee side. This utility is used in this patch to support implicit functions returning characters (that require a hidden argument). Conflicts: flang/lib/Lower/ConvertExpr.cpp Conflicts: flang/lib/Lower/CMakeLists.txt --- flang/include/flang/Lower/CallInterface.h | 270 +++++++++++++ flang/lib/Lower/Bridge.cpp | 142 ++++--- flang/lib/Lower/CallInterface.cpp | 455 ++++++++++++++++++++++ flang/test/Lower/implicit-interface.f90 | 17 + 4 files changed, 812 insertions(+), 72 deletions(-) create mode 100644 flang/include/flang/Lower/CallInterface.h create mode 100644 flang/lib/Lower/CallInterface.cpp create mode 100644 flang/test/Lower/implicit-interface.f90 diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h new file mode 100644 index 0000000000000..157b6f633bdee --- /dev/null +++ b/flang/include/flang/Lower/CallInterface.h @@ -0,0 +1,270 @@ +//===-- Lower/CallInterface.h -- Procedure call interface ------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Utility that defines fir call interface for procedure both on caller and +// and callee side and get the related FuncOp. +// It does not emit any FIR code but for the created mlir::FuncOp, instead it +// provides back a container of Symbol (callee side)/ActualArgument (caller +// side) with additional information for each element describing how it must be +// plugged with the mlir::FuncOp. +// It handles the fact that hidden arguments may be inserted for the result. +// while lowering. +// +// This utility uses the characteristic of Fortran procedures to operate, which +// is a term and concept used in Fortran to refer to the signature of a function +// or subroutine. +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_CALLINTERFACE_H +#define FORTRAN_LOWER_CALLINTERFACE_H + +#include "flang/Common/reference.h" +#include "mlir/IR/Function.h" +#include +#include +#include + +namespace Fortran::semantics { +class Symbol; +} + +namespace Fortran::evaluate { +class ProcedureRef; +class ActualArgument; +namespace characteristics { +struct Procedure; +} +} // namespace Fortran::evaluate + +namespace Fortran::lower { +class AbstractConverter; +class SymMap; +namespace pft { +struct FunctionLikeUnit; +} + +/// PassedEntityTypes helps abstract whether CallInterface is mapping a +/// Symbol to mlir::Value (callee side) or an ActualArgument to a position +/// inside the input vector for the CallOp (caller side. It will be up to the +/// CallInterface user to produce the mlir::Value that will go in this input +/// vector). +class CallerInterface; +class CalleeInterface; +template +struct PassedEntityTypes {}; +template <> +struct PassedEntityTypes { + using FortranEntity = const Fortran::evaluate::ActualArgument *; + using FirValue = int; +}; +template <> +struct PassedEntityTypes { + using FortranEntity = common::Reference; + using FirValue = mlir::Value; +}; + +/// Implementation helper +template +class CallInterfaceImpl; + +/// CallInterface defines all the logic to determine FIR function interfaces +/// from a characteristic, build the mlir::FuncOp and describe back the argument +/// mapping to its user. +/// The logic is shared between the callee and caller sides that it accepts as +/// a curiously recursive template to handle the few things that cannot be +/// shared between both side (getting characteristics, mangled name, location). +/// It maps FIR arguments to front-end Symbol (callee side) or ActualArgument +/// (caller side) with the same code using the abstract FortranEntity type that +/// can be either a Symbol or an ActualArgument. +/// It works in two passes: a first pass over the characteristics that decides +/// how the interface must be. Then, the funcOp is created for it. Then a simple +/// pass over fir arguments finalize the interface information that must be +/// passed back to the user (and may require having the funcOp). All this +/// passes are driven from the CallInterface constructor. +template +class CallInterface { + friend CallInterfaceImpl; + +public: + /// Enum the different ways an entity can be passed-by + enum class PassEntityBy { + BaseAddress, + BoxChar, + Box, + AddressAndLength, + /// Value means passed by value at the mlir level, it is not necessarily + /// implied by Fortran Value attribute. + Value + }; + /// Different properties of an entity that can be passed/returned. + /// One-to-One mapping with PassEntityBy but for + /// PassEntityBy::AddressAndLength that has two properties. + enum class Property { + BaseAddress, + BoxChar, + CharAddress, + CharLength, + Box, + Value + }; + + using FortranEntity = typename PassedEntityTypes::FortranEntity; + using FirValue = typename PassedEntityTypes::FirValue; + /// FirPlaceHolder are place holders for the mlir inputs and outputs that are + /// created during the first pass before the mlir::FuncOp is created. + struct FirPlaceHolder { + /// Type for this input/output + mlir::Type type; + /// Position of related passedEntity in passedArguments. + /// (passedEntity is the passedResult this value is resultEntityPosition. + int passedEntityPosition; + static constexpr int resultEntityPosition = -1; + /// Indicate property of the entity passedEntityPosition that must be passed + /// through this argument. + Property property; + }; + + /// PassedEntity is what is provided back to the CallInterface user. + /// It describe how the entity is plugged in the interface + struct PassedEntity { + /// How entity is passed by. + PassEntityBy passBy; + /// What is the entity (SymbolRef for callee/ActualArgument* for caller) + /// What is the related mlir::FuncOp argument(s) (mlir::Value for callee / + /// index for the caller). + FortranEntity entity; + FirValue firArgument; + FirValue firLength; /* only for AddressAndLength */ + }; + + /// Return the mlir::FuncOp. Note that front block is added by this + /// utility if callee side. + mlir::FuncOp getFuncOp() const { return func; } + /// Number of MLIR inputs/outputs of the created FuncOp. + std::size_t getNumFIRArguments() const { return inputs.size(); } + std::size_t getNumFIRResults() const { return outputs.size(); } + /// Return the MLIR output types. + llvm::SmallVector getResultType() const; + + /// Return a container of Symbol/ActualArgument* and how they must + /// be plugged with the mlir::FuncOp. + llvm::ArrayRef getPassedArguments() const { + return passedArguments; + } + /// In case the result must be passed by the caller, indicate how. + /// nullopt if the result is not passed by the caller. + std::optional getPassedResult() const { return passedResult; } + +private: + /// CRTP handle. + T &side() { return *static_cast(this); } + /// buildImplicitInterface and buildExplicitInterface are the entry point + /// of the first pass that define the interface and is required to get + /// the mlir::FuncOp. + void + buildImplicitInterface(const Fortran::evaluate::characteristics::Procedure &); + void + buildExplicitInterface(const Fortran::evaluate::characteristics::Procedure &); + /// Helper to get type after the first pass. + mlir::FunctionType genFunctionType() const; + /// Second pass entry point, once the mlir::FuncOp is created + void mapBackInputToPassedEntity(const FirPlaceHolder &, FirValue); + + llvm::SmallVector outputs; + llvm::SmallVector inputs; + mlir::FuncOp func; + llvm::SmallVector passedArguments; + std::optional passedResult; + +protected: + CallInterface(Fortran::lower::AbstractConverter &c) : converter{c} {} + /// Entry point to be called by child ctor (childs need to be initialized + /// first). + void init(); + Fortran::lower::AbstractConverter &converter; + /// Store characteristic once created, it is required for further information + /// (e.g. getting the length of character result) + std::unique_ptr characteristic; +}; + +//===----------------------------------------------------------------------===// +// Caller side interface +//===----------------------------------------------------------------------===// + +/// The CallerInterface provides the helpers needed by CallInterface +/// (getting the characteristic...) and a safe way for the user to +/// place the mlir::Value arguments into the input vector +/// once they are lowered. +class CallerInterface : public CallInterface { +public: + CallerInterface(const Fortran::evaluate::ProcedureRef &p, + Fortran::lower::AbstractConverter &c) + : CallInterface{c}, procRef{p} { + init(); + actualInputs = llvm::SmallVector(getNumFIRArguments()); + } + /// CRTP callbacks + bool hasAlternateReturns() const; + std::string getMangledName() const; + mlir::Location getCalleeLocation() const; + Fortran::evaluate::characteristics::Procedure characterize() const; + const Fortran::evaluate::ProcedureRef &getCallDescription() const { + return procRef; + }; + bool isMainProgram() const { return false; } + + /// Helpers to place the lowered arguments at the right place once they + /// have been lowered. + void placeInput(const PassedEntity &passedEntity, mlir::Value arg); + void placeAddressAndLengthInput(const PassedEntity &passedEntity, + mlir::Value addr, mlir::Value len); + /// Get the input vector once it is complete. + const llvm::SmallVector &getInputs() const { + assert(verifyActualInputs() && "lowered arguments are incomplete"); + return actualInputs; + } + /// Return result length when the function return non + /// allocatable/pointer character. + mlir::Value getResultLength(); + +private: + /// Check that the input vector is complete. + bool verifyActualInputs() const; + const Fortran::evaluate::ProcedureRef &procRef; + llvm::SmallVector actualInputs; +}; + +//===----------------------------------------------------------------------===// +// Callee side interface +//===----------------------------------------------------------------------===// + +/// CalleeInterface only provides the helpers needed by CallInterface +/// to abstract the specificities of the callee side. +class CalleeInterface : public CallInterface { +public: + CalleeInterface(Fortran::lower::pft::FunctionLikeUnit &f, + Fortran::lower::AbstractConverter &c) + : CallInterface{c}, funit{f} { + init(); + } + bool hasAlternateReturns() const; + std::string getMangledName() const; + mlir::Location getCalleeLocation() const; + Fortran::evaluate::characteristics::Procedure characterize() const; + bool isMainProgram() const; + Fortran::lower::pft::FunctionLikeUnit &getCallDescription() const { + return funit; + }; + +private: + Fortran::lower::pft::FunctionLikeUnit &funit; +}; + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_FIRBUILDER_H diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 60f5828d6ea15..090a622abd4a6 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -9,6 +9,7 @@ #include "flang/Lower/Bridge.h" #include "../../runtime/iostat.h" #include "SymbolMap.h" +#include "flang/Lower/CallInterface.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/FIRBuilder.h" @@ -205,13 +206,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { public: explicit FirConverter(Fortran::lower::LoweringBridge &bridge, fir::NameUniquer &uniquer) - : mlirContext{bridge.getMLIRContext()}, cooked{bridge.getCookedSource()}, - module{bridge.getModule()}, defaults{bridge.getDefaultKinds()}, - kindMap{bridge.getKindMap()}, uniquer{uniquer}, - getShape{[&](const Fortran::lower::SomeExpr &expr) { - auto foldCtx = bridge.createFoldingContext(); - return Fortran::evaluate::GetShape(foldCtx, expr); - }} {} + : bridge{bridge}, uniquer{uniquer}, foldingContext{ + bridge.createFoldingContext()} {} virtual ~FirConverter() = default; /// Convert the PFT to FIR @@ -245,29 +241,34 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Location *loc = nullptr) override final { return createFIRExpr(loc ? *loc : toLocation(), &expr); } + Fortran::evaluate::FoldingContext &getFoldingContext() override final { + return foldingContext; + } mlir::Type genType(const Fortran::evaluate::DataRef &data) override final { - return Fortran::lower::translateDataRefToFIRType(&mlirContext, defaults, - data); + return Fortran::lower::translateDataRefToFIRType( + &getMLIRContext(), bridge.getDefaultKinds(), data); } mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final { - return Fortran::lower::translateSomeExprToFIRType(&mlirContext, defaults, - &expr); + return Fortran::lower::translateSomeExprToFIRType( + &getMLIRContext(), bridge.getDefaultKinds(), &expr); } mlir::Type genType(const Fortran::lower::pft::Variable &var) override final { - return Fortran::lower::translateVariableToFIRType(&mlirContext, defaults, - var); + return Fortran::lower::translateVariableToFIRType( + &getMLIRContext(), bridge.getDefaultKinds(), var); } mlir::Type genType(Fortran::lower::SymbolRef sym) override final { - return Fortran::lower::translateSymbolToFIRType(&mlirContext, defaults, - sym); + return Fortran::lower::translateSymbolToFIRType( + &getMLIRContext(), bridge.getDefaultKinds(), sym); } mlir::Type genType(Fortran::common::TypeCategory tc, int kind) override final { - return Fortran::lower::getFIRType(&mlirContext, defaults, tc, kind); + return Fortran::lower::getFIRType(&getMLIRContext(), + bridge.getDefaultKinds(), tc, kind); } mlir::Type genType(Fortran::common::TypeCategory tc) override final { - return Fortran::lower::getFIRType(&mlirContext, defaults, tc); + return Fortran::lower::getFIRType(&getMLIRContext(), + bridge.getDefaultKinds(), tc); } mlir::Location getCurrentLocation() override final { return toLocation(); } @@ -275,19 +276,19 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// Generate a dummy location. mlir::Location genLocation() override final { // Note: builder may not be instantiated yet - return mlir::UnknownLoc::get(&mlirContext); + return mlir::UnknownLoc::get(&getMLIRContext()); } /// Generate a `Location` from the `CharBlock`. mlir::Location genLocation(const Fortran::parser::CharBlock &block) override final { - if (cooked) { + if (const auto *cooked = bridge.getCookedSource()) { auto loc = cooked->GetSourcePositionRange(block); if (loc.has_value()) { // loc is a pair (begin, end); use the beginning position auto &filePos = loc->first; return mlir::FileLineColLoc::get(filePos.file.path(), filePos.line, - filePos.column, &mlirContext); + filePos.column, &getMLIRContext()); } } return genLocation(); @@ -297,8 +298,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { return *builder; } - mlir::ModuleOp &getModuleOp() override final { return module; } + mlir::ModuleOp &getModuleOp() override final { return bridge.getModule(); } + mlir::MLIRContext &getMLIRContext() override final { + return bridge.getMLIRContext(); + } std::string mangleName(const Fortran::semantics::Symbol &symbol) override final { return Fortran::lower::mangle::mangleName(uniquer, symbol); @@ -443,7 +447,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { const auto &details = functionSymbol.get(); auto resultRef = lookupSymbol(details.result()); - mlir::Value retval = builder->create(toLocation(), resultRef); + // TODO: This should probably look at the callee interface result instead + // to know what must be returned. + mlir::Value retval = resultRef; + if (!resultRef.getType().isa()) + retval = builder->create(toLocation(), resultRef); builder->create(toLocation(), retval); } @@ -1489,14 +1497,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } - mlir::FuncOp createNewFunction(mlir::Location loc, llvm::StringRef name, - const Fortran::semantics::Symbol *symbol) { - mlir::FunctionType ty = - symbol ? genFunctionType(*symbol) - : mlir::FunctionType::get(llvm::None, llvm::None, &mlirContext); - return Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty); - } - /// Instantiate a global variable. If it hasn't already been processed, add /// the global to the ModuleOp as a new uniqued symbol and initialize it with /// the correct value. It will be referenced on demand using `fir.addr_of`. @@ -1602,6 +1602,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->setLocation(loc); auto idxTy = builder->getIndexType(); const auto isDummy = Fortran::semantics::IsDummy(sym); + const auto isResult = Fortran::semantics::IsFunctionResult(sym); SymbolBoxAnalyzer sia(sym); sia.analyze(); @@ -1633,7 +1634,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (sia.isChar) { // if element type is a CHARACTER, determine the LEN value - if (isDummy) { + if (isDummy || isResult) { auto unboxchar = builder->createUnboxChar(addr); auto boxAddr = unboxchar.first; if (auto c = sia.getCharLenConst()) { @@ -1683,7 +1684,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { for (auto i : sia.staticShape) shape.push_back(builder->createIntegerConstant(idxTy, i)); if (sia.isChar) { - if (isDummy) { + if (isDummy || isResult) { localSymbols.addCharSymbolWithShape(sym, addr, len, shape, true); return; } @@ -1692,7 +1693,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { localSymbols.addCharSymbolWithShape(sym, local, len, shape); return; } - if (isDummy) { + if (isDummy || isResult) { localSymbols.addSymbolWithShape(sym, addr, shape, true); return; } @@ -1748,7 +1749,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } if (sia.isChar) { - if (isDummy) { + if (isDummy || isResult) { localSymbols.addCharSymbolWithBounds(sym, addr, len, extents, lbounds, true); return; @@ -1762,7 +1763,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { localSymbols.addCharSymbolWithBounds(sym, local, len, extents, lbounds); return; } - if (isDummy) { + if (isDummy || isResult) { localSymbols.addSymbolWithBounds(sym, addr, extents, lbounds, true); return; } @@ -1775,7 +1776,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // not an array, so process as scalar argument if (sia.isChar) { - if (isDummy) { + if (isDummy || isResult) { addCharSymbol(sym, addr, len, true); return; } @@ -1802,38 +1803,36 @@ class FirConverter : public Fortran::lower::AbstractConverter { instantiateLocal(var); } + void mapDummyAndResults(const Fortran::lower::CalleeInterface &callee) { + assert(builder && "need a builder at this point"); + using PassBy = Fortran::lower::CalleeInterface::PassEntityBy; + auto mapPassedEntity = [&](const auto arg) -> void { + if (arg.passBy == PassBy::AddressAndLength) { + auto box = builder->createEmboxChar(arg.firArgument, arg.firLength); + addSymbol(arg.entity.get(), box); + } else { + addSymbol(arg.entity.get(), arg.firArgument); + } + }; + for (const auto &arg : callee.getPassedArguments()) { + mapPassedEntity(arg); + } + if (auto passedResult = callee.getPassedResult()) { + mapPassedEntity(*passedResult); + } + } + /// Prepare to translate a new function void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { assert(!builder && "expected nullptr"); - // get mangled name - std::string name = funit.isMainProgram() - ? uniquer.doProgramEntry().str() - : mangleName(funit.getSubprogramSymbol()); - // FIXME: do NOT use unknown for the anonymous PROGRAM case. We probably - // should just stash the location in the funit regardless. - mlir::Location loc = toLocation(funit.getStartingSourceLoc()); - mlir::FuncOp func = - Fortran::lower::FirOpBuilder::getNamedFunction(module, name); - if (!func) - func = createNewFunction(loc, name, funit.symbol); - builder = new Fortran::lower::FirOpBuilder(func, kindMap); + Fortran::lower::CalleeInterface callee(funit, *this); + mlir::FuncOp func = callee.getFuncOp(); + builder = new Fortran::lower::FirOpBuilder(func, bridge.getKindMap()); assert(builder && "FirOpBuilder did not instantiate"); - func.addEntryBlock(); builder->setInsertionPointToStart(&func.front()); - bool hasAlternateReturns = false; - - auto *entryBlock = &func.front(); - if (funit.symbol && !funit.isMainProgram()) { - const auto &details = - funit.symbol->get(); - auto blockIter = entryBlock->getArguments().begin(); - for (const auto &dummy : details.dummyArgs()) { - if (dummy) - addSymbol(*dummy, *blockIter++); - else - hasAlternateReturns = true; - } - } + + mapDummyAndResults(callee); + for (const auto &var : funit.getOrderedSymbolTable()) instantiateVar(var); @@ -1843,7 +1842,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Reinstate entry block as the current insertion point. builder->setInsertionPointToEnd(&func.front()); - if (hasAlternateReturns) { + if (callee.hasAlternateReturns()) { // Create a local temp to hold the alternate return index. // Give it an integer index type and the subroutine name (for dumps). // Attach it to the subroutine symbol in the localSymbols map. @@ -1960,15 +1959,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { return *evalPtr; } - mlir::MLIRContext &mlirContext; - const Fortran::parser::CookedSource *cooked; - mlir::ModuleOp &module; - const Fortran::common::IntrinsicTypeDefaultKinds &defaults; - const fir::KindMapping &kindMap; + std::optional + getShape(const Fortran::lower::SomeExpr &expr) { + return Fortran::evaluate::GetShape(foldingContext, expr); + } + + Fortran::lower::LoweringBridge &bridge; fir::NameUniquer &uniquer; - std::function( - const Fortran::lower::SomeExpr &)> - getShape; + Fortran::evaluate::FoldingContext foldingContext; Fortran::lower::FirOpBuilder *builder = nullptr; Fortran::lower::pft::Evaluation *evalPtr = nullptr; Fortran::lower::SymMap localSymbols; diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp new file mode 100644 index 0000000000000..c00c0797d2f17 --- /dev/null +++ b/flang/lib/Lower/CallInterface.cpp @@ -0,0 +1,455 @@ +//===-- CallInterface.cpp -- Procedure call interface ------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/CallInterface.h" +#include "flang/Evaluate/characteristics.h" +#include "flang/Evaluate/fold.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/FIRBuilder.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Semantics/symbol.h" +#include "flang/Semantics/tools.h" + +//===----------------------------------------------------------------------===// +// Caller side interface implementation +//===----------------------------------------------------------------------===// + +bool Fortran::lower::CallerInterface::hasAlternateReturns() const { + return procRef.HasAlternateReturns(); +} + +std::string Fortran::lower::CallerInterface::getMangledName() const { + const auto &proc = procRef.proc(); + if (const auto *symbol = proc.GetSymbol()) + return converter.mangleName(*symbol); + assert(proc.GetSpecificIntrinsic() && + "expected intrinsic procedure in designator"); + return proc.GetName(); +} + +mlir::Location Fortran::lower::CallerInterface::getCalleeLocation() const { + const auto &proc = procRef.proc(); + if (const auto *symbol = proc.GetSymbol()) { + // FIXME: If the callee is defined in the same file but after the current + // unit we do cannot get its location here and the funcOp is created at the + // wrong location (i.e, the caller location). + if (const auto *details = + symbol->detailsIf()) + if (const auto *interfaceSymbol = details->interface().symbol()) + symbol = interfaceSymbol; + return converter.genLocation(symbol->name()); + } + // Unknown location for intrinsics. + return converter.genLocation(); +} + +Fortran::evaluate::characteristics::Procedure +Fortran::lower::CallerInterface::characterize() const { + auto &foldingContext = converter.getFoldingContext(); + auto characteristic = + Fortran::evaluate::characteristics::Procedure::Characterize( + procRef.proc(), foldingContext.intrinsics()); + assert(characteristic && "Failed to get characteristic from procRef"); + // The characteristic may not contain the argument characteristic if no + // the ProcedureDesignator has no interface. + if (!characteristic->HasExplicitInterface()) { + for (const auto &arg : procRef.arguments()) { + // Argument cannot be optional with implicit interface + const auto *expr = arg.value().UnwrapExpr(); + assert(expr && + "argument in call with implicit interface cannot be assumed type"); + auto argCharacteristic = + Fortran::evaluate::characteristics::DummyArgument::FromActual( + "actual", *expr, foldingContext); + assert(argCharacteristic && + "failed to characterize argument in implicit call"); + characteristic->dummyArguments.emplace_back( + std::move(*argCharacteristic)); + } + } + return *characteristic; +} + +void Fortran::lower::CallerInterface::placeInput( + const PassedEntity &passedEntity, mlir::Value arg) { + assert(static_cast(actualInputs.size()) > passedEntity.firArgument && + passedEntity.firArgument >= 0 && + passedEntity.passBy != CallInterface::PassEntityBy::AddressAndLength && + "bad arg position"); + actualInputs[passedEntity.firArgument] = arg; +} + +void Fortran::lower::CallerInterface::placeAddressAndLengthInput( + const PassedEntity &passedEntity, mlir::Value addr, mlir::Value len) { + assert(static_cast(actualInputs.size()) > passedEntity.firArgument && + static_cast(actualInputs.size()) > passedEntity.firLength && + passedEntity.firArgument >= 0 && passedEntity.firLength >= 0 && + passedEntity.passBy == CallInterface::PassEntityBy::AddressAndLength && + "bad arg position"); + actualInputs[passedEntity.firArgument] = addr; + actualInputs[passedEntity.firLength] = len; +} + +bool Fortran::lower::CallerInterface::verifyActualInputs() const { + if (getNumFIRArguments() != actualInputs.size()) + return false; + for (auto arg : actualInputs) { + if (!arg) + return false; + } + return true; +} + +template +static inline auto AsGenericExpr(T e) { + return Fortran::evaluate::AsGenericExpr(Fortran::common::Clone(e)); +} + +mlir::Value Fortran::lower::CallerInterface::getResultLength() { + // FIXME: technically, this is a specification expression, + // so it should be evaluated on entry of the region we are + // in, it can go wrong if the specification expression + // uses a symbol that may have change. + // + // The characteristic has to be explicit for such + // cases, so the allocation could also be handled on callee side, in such + // case. For now, protect with an unreachable. + assert(characteristic && "characteristic was not computed"); + const auto *typeAndShape = + characteristic->functionResult.value().GetTypeAndShape(); + assert(typeAndShape && "no result type"); + auto expr = AsGenericExpr(typeAndShape->LEN().value()); + if (Fortran::evaluate::IsConstantExpr(expr)) + return converter.genExprValue(expr); + llvm_unreachable( + "non constant result length on caller side not yet safely handled"); +} + +//===----------------------------------------------------------------------===// +// Callee side interface implementation +//===----------------------------------------------------------------------===// + +bool Fortran::lower::CalleeInterface::hasAlternateReturns() const { + return !funit.isMainProgram() && + Fortran::semantics::HasAlternateReturns(funit.getSubprogramSymbol()); +} + +std::string Fortran::lower::CalleeInterface::getMangledName() const { + return funit.isMainProgram() + ? fir::NameUniquer::doProgramEntry().str() + : converter.mangleName(funit.getSubprogramSymbol()); +} + +mlir::Location Fortran::lower::CalleeInterface::getCalleeLocation() const { + // FIXME: do NOT use unknown for the anonymous PROGRAM case. We probably + // should just stash the location in the funit regardless. + return converter.genLocation(funit.getStartingSourceLoc()); +} + +Fortran::evaluate::characteristics::Procedure +Fortran::lower::CalleeInterface::characterize() const { + auto &foldingContext = converter.getFoldingContext(); + auto characteristic = + Fortran::evaluate::characteristics::Procedure::Characterize( + funit.getSubprogramSymbol(), foldingContext.intrinsics()); + assert(characteristic && "Fail to get characteristic from symbol"); + return *characteristic; +} + +bool Fortran::lower::CalleeInterface::isMainProgram() const { + return funit.isMainProgram(); +} + +//===----------------------------------------------------------------------===// +// CallInterface implementation: this part is common to both caller and caller +// sides. +//===----------------------------------------------------------------------===// + +/// Init drives the different actions to be performed while building a +/// CallInterface, it does not decide anything about the interface. +template +void Fortran::lower::CallInterface::init() { + if (!side().isMainProgram()) { + characteristic = + std::make_unique( + side().characterize()); + if (characteristic->CanBeCalledViaImplicitInterface()) + buildImplicitInterface(*characteristic); + else + buildExplicitInterface(*characteristic); + } + // No input/output for main program + + auto name = side().getMangledName(); + auto module = converter.getModuleOp(); + func = Fortran::lower::FirOpBuilder::getNamedFunction(module, name); + if (!func) { + mlir::Location loc = side().getCalleeLocation(); + mlir::FunctionType ty = genFunctionType(); + func = Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty); + } + + // map back fir inputs to passed entities + if constexpr (std::is_same_v) { + // On the callee side, directly map the mlir::value argument of + // the function block to the Fortran symbols. + func.addEntryBlock(); + assert(inputs.size() == func.front().getArguments().size() && + "function previously created with different number of arguments"); + for (const auto &pair : llvm::zip(inputs, func.front().getArguments())) + mapBackInputToPassedEntity(std::get<0>(pair), std::get<1>(pair)); + } else { + // On the caller side, map the index of the mlir argument position + // to Fortran ActualArguments. + auto firPosition = 0; + for (const auto &placeHolder : inputs) + mapBackInputToPassedEntity(placeHolder, firPosition++); + } +} + +template +void Fortran::lower::CallInterface::mapBackInputToPassedEntity( + const FirPlaceHolder &placeHolder, FirValue firValue) { + auto &passedEntity = + placeHolder.passedEntityPosition == FirPlaceHolder::resultEntityPosition + ? passedResult.value() + : passedArguments[placeHolder.passedEntityPosition]; + if (placeHolder.property == Property::CharLength) + passedEntity.firLength = firValue; + else + passedEntity.firArgument = firValue; +} + +/// Helpers to access ActualArgument/Symbols +static const Fortran::evaluate::ActualArguments & +getEntityContainer(const Fortran::evaluate::ProcedureRef &proc) { + return proc.arguments(); +} + +static const std::vector & +getEntityContainer(Fortran::lower::pft::FunctionLikeUnit &funit) { + return funit.getSubprogramSymbol() + .get() + .dummyArgs(); +} + +static const Fortran::evaluate::ActualArgument *getDataObjectEntity( + const std::optional &arg) { + if (arg) + return &*arg; + return nullptr; +} + +static const Fortran::semantics::Symbol & +getDataObjectEntity(const Fortran::semantics::Symbol *arg) { + assert(arg && "expect symbol for data object entity"); + return *arg; +} + +static const Fortran::evaluate::ActualArgument * +getResultEntity(const Fortran::evaluate::ProcedureRef &) { + return nullptr; +} + +static const Fortran::semantics::Symbol & +getResultEntity(Fortran::lower::pft::FunctionLikeUnit &funit) { + const auto &details = + funit.getSubprogramSymbol().get(); + return details.result(); +} + +/// This is the actual part that defines the FIR interface based on the +/// charcteristic. It directly mutates the CallInterface members. +template +class Fortran::lower::CallInterfaceImpl { + using CallInterface = Fortran::lower::CallInterface; + using PassEntityBy = typename CallInterface::PassEntityBy; + using PassedEntity = typename CallInterface::PassedEntity; + using FirValue = typename CallInterface::FirValue; + using FortranEntity = typename CallInterface::FortranEntity; + using FirPlaceHolder = typename CallInterface::FirPlaceHolder; + using Property = typename CallInterface::Property; + using TypeAndShape = Fortran::evaluate::characteristics::TypeAndShape; + +public: + CallInterfaceImpl(CallInterface &i) + : interface{i}, mlirContext{i.converter.getMLIRContext()} {} + + void buildImplicitInterface( + const Fortran::evaluate::characteristics::Procedure &procedure) { + // Handle result + auto resultPosition = FirPlaceHolder::resultEntityPosition; + if (const auto &result = procedure.functionResult) { + if (result->IsProcedurePointer()) // TODO + llvm_unreachable("procedure pointer result not yet handled"); + const auto *typeAndShape = result->GetTypeAndShape(); + assert(typeAndShape && "expect type for non proc pointer result"); + auto dynamicType = typeAndShape->type(); + // Character result allocated by caller and passed has hidden arguments + if (dynamicType.category() == Fortran::common::TypeCategory::Character) { + handleImplicitCharacterResult(dynamicType); + } else { + // All result other than characters are simply returned by value in + // implicit interfaces + auto mlirType = + getConverter().genType(dynamicType.category(), dynamicType.kind()); + addFirOutput(mlirType, resultPosition, Property::Value); + } + } else if (interface.side().hasAlternateReturns()) { + addFirOutput(mlir::IndexType::get(&mlirContext), resultPosition, + Property::Value); + } + // Handle arguments + const auto &argumentEntities = + getEntityContainer(interface.side().getCallDescription()); + for (const auto &pair : + llvm::zip(procedure.dummyArguments, argumentEntities)) { + const auto &dummy = std::get<0>(pair); + std::visit( + Fortran::common::visitors{ + [&](const Fortran::evaluate::characteristics::DummyDataObject + &obj) { + handleImplicitDataDummy(obj, + getDataObjectEntity(std::get<1>(pair))); + }, + [&](const Fortran::evaluate::characteristics::DummyProcedure &) { + // TODO + llvm_unreachable("dummy procedure pointer not yet handled"); + }, + [&](const Fortran::evaluate::characteristics::AlternateReturn &) { + // nothing to do + }, + }, + dummy.u); + } + } + void buildExplicitInterface( + const Fortran::evaluate::characteristics::Procedure &procedure) { + // TODO + llvm_unreachable("Explicit interface lowering TODO"); + } + +private: + void + handleImplicitCharacterResult(const Fortran::evaluate::DynamicType &type) { + auto resultPosition = FirPlaceHolder::resultEntityPosition; + setPassedResult(PassEntityBy::AddressAndLength, + getResultEntity(interface.side().getCallDescription())); + auto lenTy = mlir::IndexType::get(&mlirContext); + auto charRefTy = fir::ReferenceType::get( + fir::CharacterType::get(&mlirContext, type.kind())); + auto boxCharTy = fir::BoxCharType::get(&mlirContext, type.kind()); + addFirInput(charRefTy, resultPosition, Property::CharAddress); + addFirInput(lenTy, resultPosition, Property::CharLength); + /// For now, still also return it by boxchar + addFirOutput(boxCharTy, resultPosition, Property::BoxChar); + } + + void handleImplicitDataDummy( + const Fortran::evaluate::characteristics::DummyDataObject &obj, + const FortranEntity &entity) { + auto dynamicType = obj.type.type(); + if (dynamicType.category() == Fortran::common::TypeCategory::Character) { + auto boxCharTy = fir::BoxCharType::get(&mlirContext, dynamicType.kind()); + addFirInput(boxCharTy, nextPassedArgPosition(), Property::BoxChar); + addPassedArg(PassEntityBy::BoxChar, entity); + } else { + mlir::Type type = + getConverter().genType(dynamicType.category(), dynamicType.kind()); + fir::SequenceType::Shape bounds = getBounds(obj.type.shape()); + if (!bounds.empty()) + type = fir::SequenceType::get(bounds, type); + auto refType = fir::ReferenceType::get(type); + + addFirInput(refType, nextPassedArgPosition(), Property::BaseAddress); + addPassedArg(PassEntityBy::BaseAddress, entity); + } + } + + fir::SequenceType::Shape getBounds(const Fortran::evaluate::Shape &shape) { + fir::SequenceType::Shape bounds; + for (const auto &extent : shape) { + auto bound = fir::SequenceType::getUnknownExtent(); + if (extent) + if (auto i = Fortran::evaluate::ToInt64(Fortran::evaluate::Fold( + getConverter().getFoldingContext(), AsGenericExpr(*extent)))) + bound = *i; + bounds.emplace_back(bound); + } + return bounds; + } + void addFirInput(mlir::Type type, int entityPosition, Property p) { + interface.inputs.emplace_back(FirPlaceHolder{type, entityPosition, p}); + } + void addFirOutput(mlir::Type type, int entityPosition, Property p) { + interface.outputs.emplace_back(FirPlaceHolder{type, entityPosition, p}); + } + void addPassedArg(PassEntityBy p, FortranEntity entity) { + interface.passedArguments.emplace_back( + PassedEntity{p, entity, emptyValue(), emptyValue()}); + } + void setPassedResult(PassEntityBy p, FortranEntity entity) { + interface.passedResult = + PassedEntity{p, entity, emptyValue(), emptyValue()}; + } + int nextPassedArgPosition() { return interface.passedArguments.size(); } + + static FirValue emptyValue() { + if constexpr (std::is_same_v) { + return {}; + } else { + return -1; + } + } + + Fortran::lower::AbstractConverter &getConverter() { + return interface.converter; + } + CallInterface &interface; + mlir::MLIRContext &mlirContext; +}; + +template +void Fortran::lower::CallInterface::buildImplicitInterface( + const Fortran::evaluate::characteristics::Procedure &procedure) { + CallInterfaceImpl impl(*this); + impl.buildImplicitInterface(procedure); +} + +template +void Fortran::lower::CallInterface::buildExplicitInterface( + const Fortran::evaluate::characteristics::Procedure &procedure) { + CallInterfaceImpl impl(*this); + impl.buildExplicitInterface(procedure); +} + +template +mlir::FunctionType Fortran::lower::CallInterface::genFunctionType() const { + llvm::SmallVector returnTys; + llvm::SmallVector inputTys; + for (const auto &placeHolder : outputs) + returnTys.emplace_back(placeHolder.type); + for (const auto &placeHolder : inputs) + inputTys.emplace_back(placeHolder.type); + return mlir::FunctionType::get(inputTys, returnTys, + &converter.getMLIRContext()); +} + +template +llvm::SmallVector +Fortran::lower::CallInterface::getResultType() const { + llvm::SmallVector types; + for (const auto &out : outputs) + types.emplace_back(out.type); + return types; +} + +template class Fortran::lower::CallInterface; +template class Fortran::lower::CallInterface; diff --git a/flang/test/Lower/implicit-interface.f90 b/flang/test/Lower/implicit-interface.f90 new file mode 100644 index 0000000000000..cf32ac8badd95 --- /dev/null +++ b/flang/test/Lower/implicit-interface.f90 @@ -0,0 +1,17 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPchar_return_callee(%arg0: !fir.ref>, %arg1: index, %arg2: !fir.ref) -> !fir.boxchar<1> +function char_return_callee(i) + character(10) :: char_return_callee + integer :: i +end function + +! FIXME: the mangling is incorrect. +! CHECK-LABEL: func @_QFtest_char_return_callerPchar_return_caller(!fir.ref>, index, !fir.ref) -> !fir.boxchar<1> +subroutine test_char_return_caller + character(10) :: char_return_caller + print *, char_return_caller(5) +end subroutine + +! TODO more implicit interface cases with/without explicit interface + From be4d1b8c85c6e7e08f6327066b9fac73e1f8989a Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Mon, 18 May 2020 10:22:47 -0700 Subject: [PATCH 0064/1017] Remove unsused translateSymbolToFIRFunctionType (replaced by CallInterface) Conflicts: flang/lib/Lower/ConvertType.cpp --- flang/lib/Lower/Bridge.cpp | 5 ----- 1 file changed, 5 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 090a622abd4a6..39e2c922eac85 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -224,11 +224,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } - mlir::FunctionType genFunctionType(Fortran::lower::SymbolRef sym) { - return Fortran::lower::translateSymbolToFIRFunctionType(&mlirContext, - defaults, sym); - } - //===--------------------------------------------------------------------===// // AbstractConverter overrides //===--------------------------------------------------------------------===// From 5236657ba2fa2af718d6ab67bf06cbc2dbfeee43 Mon Sep 17 00:00:00 2001 From: Rajan Walia Date: Fri, 29 May 2020 10:08:03 -0700 Subject: [PATCH 0065/1017] using mlir declarative pass definition currently only for promote to affine fixed registration of mlir passes --- .../flang/Optimizer/Dialect/FIRDialect.h | 10 ++++++++ flang/lib/Optimizer/Transforms/CMakeLists.txt | 1 + flang/lib/Optimizer/Transforms/PassDetail.h | 22 ++++++++++++++++ .../Optimizer/Transforms/RaiseToAffine.cpp | 3 ++- flang/tools/bbc/bbc.cpp | 25 ++++++++++++------- 5 files changed, 51 insertions(+), 10 deletions(-) create mode 100644 flang/lib/Optimizer/Transforms/PassDetail.h diff --git a/flang/include/flang/Optimizer/Dialect/FIRDialect.h b/flang/include/flang/Optimizer/Dialect/FIRDialect.h index fb828716d45a1..87da129b5bb16 100644 --- a/flang/include/flang/Optimizer/Dialect/FIRDialect.h +++ b/flang/include/flang/Optimizer/Dialect/FIRDialect.h @@ -50,6 +50,16 @@ class FIRCodeGenDialect final : public mlir::Dialect { static llvm::StringRef getDialectNamespace() { return "fircg"; } }; +/// The FIR codegen dialect is a dialect containing a small set of transient +/// operations used exclusively during code generation. +class FIRCodeGenDialect final : public mlir::Dialect { +public: + explicit FIRCodeGenDialect(mlir::MLIRContext *ctx); + virtual ~FIRCodeGenDialect(); + + static llvm::StringRef getDialectNamespace() { return "fircg"; } +}; + } // namespace fir #endif // FORTRAN_OPTIMIZER_DIALECT_FIRDIALECT_H diff --git a/flang/lib/Optimizer/Transforms/CMakeLists.txt b/flang/lib/Optimizer/Transforms/CMakeLists.txt index 9512c5818add7..c144f7c4af1f9 100644 --- a/flang/lib/Optimizer/Transforms/CMakeLists.txt +++ b/flang/lib/Optimizer/Transforms/CMakeLists.txt @@ -10,6 +10,7 @@ add_flang_library(FIRTransforms DEPENDS FIROpsIncGen + FIROptTransformsPassIncGen ${dialect_libs} LINK_LIBS diff --git a/flang/lib/Optimizer/Transforms/PassDetail.h b/flang/lib/Optimizer/Transforms/PassDetail.h new file mode 100644 index 0000000000000..528cff34a3f51 --- /dev/null +++ b/flang/lib/Optimizer/Transforms/PassDetail.h @@ -0,0 +1,22 @@ +//===- PassDetail.h - Optimizer Transforms Pass class details ---*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef OPTMIZER_TRANSFORMS_PASSDETAIL_H_ +#define OPTMIZER_TRANSFORMS_PASSDETAIL_H_ + +#include "mlir/Pass/Pass.h" +#include "mlir/Pass/PassRegistry.h" + +namespace fir { + +#define GEN_PASS_CLASSES +#include "flang/Optimizer/Transforms/Passes.h.inc" + +} // end namespace mlir + +#endif // OPTMIZER_TRANSFORMS_PASSDETAIL_H_ diff --git a/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp b/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp index 0f53b12c5a616..2be2b3457d3a9 100644 --- a/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp +++ b/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp @@ -6,6 +6,7 @@ // //===----------------------------------------------------------------------===// +#include "PassDetail.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Transforms/Passes.h" @@ -47,7 +48,7 @@ class AffineWhereConv : public OpRewrite { /// Promote fir.loop and fir.where to affine.for and affine.if, in the cases /// where such a promotion is possible. class AffineDialectPromotion - : public mlir::PassWrapper { + : public AffineDialectPromotionBase { public: void runOnFunction() override { if (disableAffinePromo) diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 6d2a50dfe74f9..7044e22a24217 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -38,6 +38,7 @@ #include "mlir/Parser.h" #include "mlir/Pass/Pass.h" #include "mlir/Pass/PassManager.h" +#include "mlir/Pass/PassRegistry.h" #include "mlir/Transforms/Passes.h" #include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorOr.h" @@ -132,7 +133,8 @@ static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) { static void convertFortranSourceToMLIR( std::string path, Fortran::parser::Options options, const ProgramName &programPrefix, - Fortran::semantics::SemanticsContext &semanticsContext) { + Fortran::semantics::SemanticsContext &semanticsContext, + const mlir::PassPipelineCLParser &passPipeline) { if (!(fixedForm || freeForm)) { auto dot = path.rfind("."); if (dot != std::string::npos) { @@ -225,13 +227,17 @@ static void convertFortranSourceToMLIR( // Otherwise run the default passes. mlir::PassManager pm(mlirModule.getContext()); mlir::applyPassManagerCLOptions(pm); - pm.addPass(fir::createPromoteToAffinePass()); - pm.addPass(fir::createLowerToScfPass()); - pm.addPass(fir::createControlFlowLoweringPass()); - pm.addPass(mlir::createLowerToCFGPass()); - // pm.addPass(fir::createMemToRegPass()); - pm.addPass(fir::createCSEPass()); - pm.addPass(mlir::createCanonicalizerPass()); + if (passPipeline.hasAnyOccurrences()) { + passPipeline.addToPipeline(pm); + } else { + pm.addPass(fir::createPromoteToAffinePass()); + pm.addPass(fir::createLowerToScfPass()); + pm.addPass(fir::createControlFlowLoweringPass()); + pm.addPass(mlir::createLowerToCFGPass()); + // pm.addPass(fir::createMemToRegPass()); + pm.addPass(fir::createCSEPass()); + pm.addPass(mlir::createCanonicalizerPass()); + } if (emitLLVM) { // Continue to lower from MLIR down to LLVM IR. Emit LLVM and MLIR. @@ -265,6 +271,7 @@ static void convertFortranSourceToMLIR( int main(int argc, char **argv) { fir::registerFIR(); fir::registerFIRPasses(); + fir::registerOptTransformPasses(); [[maybe_unused]] llvm::InitLLVM y(argc, argv); mlir::registerPassManagerCLOptions(); @@ -301,6 +308,6 @@ int main(int argc, char **argv) { .set_warningsAreErrors(warnIsError); convertFortranSourceToMLIR(inputFilename, options, programPrefix, - semanticsContext); + semanticsContext, passPipe); return exitStatus; } From d429db7397685b96fa0b4ffd5e290fabe30660f9 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 29 May 2020 15:13:14 -0700 Subject: [PATCH 0066/1017] [refactor] This converts the CharacterOpBuilder CRTP to its own helper class outside of the FirOpBuilder. This removes all the CRTP boilerplate code and simplifies the code in the helper. Additionally, this removes the hidden Char data structure that was used and replaces it with fir::CharBoxValue. This change eliminates the need for a pair of classes to provide and interface and an implementation around this hidden structure. By using fir::CharBoxValue, it is hoped that other aspects of lowering CHARACTER expressions can be simplified further in the bridge. --- flang/lib/Lower/Bridge.cpp | 23 ++++++++++++++--------- flang/lib/Lower/CharRT.cpp | 6 ++++-- flang/lib/Lower/Intrinsics.cpp | 10 ++++++---- 3 files changed, 24 insertions(+), 15 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 39e2c922eac85..a1951fafece58 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -10,6 +10,7 @@ #include "../../runtime/iostat.h" #include "SymbolMap.h" #include "flang/Lower/CallInterface.h" +#include "flang/Lower/CharacterExpr.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/FIRBuilder.h" @@ -1315,7 +1316,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Generating value for lhs to get fir.boxchar. auto lhs = genExprValue(assign.lhs); auto rhs = genExprValue(assign.rhs); - builder->createAssign(lhs, rhs); + Fortran::lower::CharacterExprHelper{*builder, loc}.createAssign( + lhs, rhs); return; } if (lhsType->category() == @@ -1593,11 +1595,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// depends will already have been visited. void instantiateLocal(const Fortran::lower::pft::Variable &var) { const auto &sym = var.getSymbol(); - const auto loc = toLocation(); + const auto loc = genLocation(sym.name()); builder->setLocation(loc); auto idxTy = builder->getIndexType(); const auto isDummy = Fortran::semantics::IsDummy(sym); const auto isResult = Fortran::semantics::IsFunctionResult(sym); + Fortran::lower::CharacterExprHelper charHelp{*builder, loc}; SymbolBoxAnalyzer sia(sym); sia.analyze(); @@ -1630,16 +1633,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (sia.isChar) { // if element type is a CHARACTER, determine the LEN value if (isDummy || isResult) { - auto unboxchar = builder->createUnboxChar(addr); + auto unboxchar = charHelp.createUnboxChar(addr); auto boxAddr = unboxchar.first; if (auto c = sia.getCharLenConst()) { // Set/override LEN with a constant - len = builder->createIntegerConstant(idxTy, *c); - addr = builder->createEmboxChar(boxAddr, len); + len = builder->createIntegerConstant(loc, idxTy, *c); + addr = charHelp.createEmboxChar(boxAddr, len); } else if (auto e = sia.getCharLenExpr()) { // Set/override LEN with an expression len = genExprValue(*e); - addr = builder->createEmboxChar(boxAddr, len); + addr = charHelp.createEmboxChar(boxAddr, len); } else { // LEN is from the boxchar len = unboxchar.second; @@ -1778,8 +1781,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(!mustBeDummy); auto charTy = genType(var); auto c = sia.getCharLenConst(); - mlir::Value local = c ? builder->createCharacterTemp(charTy, *c) - : builder->createCharacterTemp(charTy, len); + mlir::Value local = c ? charHelp.createCharacterTemp(charTy, *c) + : charHelp.createCharacterTemp(charTy, len); addCharSymbol(sym, local, len); return; } @@ -1803,7 +1806,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { using PassBy = Fortran::lower::CalleeInterface::PassEntityBy; auto mapPassedEntity = [&](const auto arg) -> void { if (arg.passBy == PassBy::AddressAndLength) { - auto box = builder->createEmboxChar(arg.firArgument, arg.firLength); + auto loc = toLocation(); + Fortran::lower::CharacterExprHelper charHelp{*builder, loc}; + auto box = charHelp.createEmboxChar(arg.firArgument, arg.firLength); addSymbol(arg.entity.get(), box); } else { addSymbol(arg.entity.get(), arg.firArgument); diff --git a/flang/lib/Lower/CharRT.cpp b/flang/lib/Lower/CharRT.cpp index b11326a8711c3..1ff31b37605df 100644 --- a/flang/lib/Lower/CharRT.cpp +++ b/flang/lib/Lower/CharRT.cpp @@ -10,6 +10,7 @@ #include "../../runtime/character.h" #include "RTBuilder.h" #include "flang/Lower/Bridge.h" +#include "flang/Lower/CharacterExpr.h" #include "flang/Lower/FIRBuilder.h" #include "mlir/Dialect/StandardOps/IR/Ops.h" @@ -123,8 +124,9 @@ Fortran::lower::genBoxCharCompare(Fortran::lower::AbstractConverter &converter, mlir::Value lhs, mlir::Value rhs) { auto &builder = converter.getFirOpBuilder(); builder.setLocation(loc); - auto lhsPair = builder.materializeCharacter(lhs); - auto rhsPair = builder.materializeCharacter(rhs); + Fortran::lower::CharacterExprHelper helper{builder, loc}; + auto lhsPair = helper.materializeCharacter(lhs); + auto rhsPair = helper.materializeCharacter(rhs); return genRawCharCompare(converter, loc, cmp, lhsPair.first, lhsPair.second, rhsPair.first, rhsPair.second); } diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index d1564cc47d5ff..296922b323d38 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -14,6 +14,7 @@ //===----------------------------------------------------------------------===// #include "RTBuilder.h" +#include "flang/Lower/CharacterExpr.h" #include "flang/Lower/ComplexExpr.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/FIRBuilder.h" @@ -567,7 +568,6 @@ mlir::Value IntrinsicLibrary::outlineInWrapper(Generator generator, llvm::StringRef name, mlir::Type resultType, llvm::ArrayRef args) { - auto module = builder.getModule(); auto funcType = getFunctionType(resultType, args, builder); std::string wrapperName = getIntrinsicWrapperName(name, funcType); auto function = builder.getNamedFunction(wrapperName); @@ -740,9 +740,10 @@ mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, assert(args.size() >= 1); auto arg = args[0]; - auto dataAndLen = builder.createUnboxChar(arg); + Fortran::lower::CharacterExprHelper helper{builder, loc}; + auto dataAndLen = helper.createUnboxChar(arg); auto charType = fir::CharacterType::get( - builder.getContext(), builder.getCharacterKind(arg.getType())); + builder.getContext(), helper.getCharacterKind(arg.getType())); auto refType = builder.getRefType(charType); auto charAddr = builder.createHere(refType, dataAndLen.first); auto charVal = builder.createHere(charType, charAddr); @@ -754,7 +755,8 @@ mlir::Value IntrinsicLibrary::genLenTrim(mlir::Type resultType, llvm::ArrayRef args) { // Optional KIND argument reflected in result type. assert(args.size() >= 1); - auto len = builder.createLenTrim(args[0]); + Fortran::lower::CharacterExprHelper helper{builder, loc}; + auto len = helper.createLenTrim(args[0]); return builder.createHere(resultType, len); } From b79a4dd7fdc5367a2c8966404a9e43f0aea5d94a Mon Sep 17 00:00:00 2001 From: Sameeran joshi Date: Wed, 27 May 2020 00:58:32 +0530 Subject: [PATCH 0067/1017] Unittest for InternalNamesTest.h Add some more deconstruct unit tests and fix a bug in readName and readInt git-clang-formatted code --- flang/unittests/Optimizer/Basic.cpp | 18 ------------------ 1 file changed, 18 deletions(-) delete mode 100644 flang/unittests/Optimizer/Basic.cpp diff --git a/flang/unittests/Optimizer/Basic.cpp b/flang/unittests/Optimizer/Basic.cpp deleted file mode 100644 index 8dbb91eef33d3..0000000000000 --- a/flang/unittests/Optimizer/Basic.cpp +++ /dev/null @@ -1,18 +0,0 @@ -#include "flang/Optimizer/Support/InternalNames.h" -#include "gtest/gtest.h" -#include - -using namespace fir; -using namespace llvm; - -TEST(genericName, MyTest) { - NameUniquer obj; - std::string val = obj.doCommonBlock("hello"); - std::cout << val; -} - -int main(int argc, char **argv) { - testing::InitGoogleTest(&argc, argv); - return RUN_ALL_TESTS(); -} - From af2f7b3ebb0e08828b7d38069748346c075f757c Mon Sep 17 00:00:00 2001 From: zachary-selk Date: Fri, 29 May 2020 17:46:23 -0600 Subject: [PATCH 0068/1017] Replaced fir loop lowering to scf.loop with lower to CFG --- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 124 +++++++++++++++--- 1 file changed, 105 insertions(+), 19 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index c6cb2b0174762..0c8e32080db09 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -25,12 +25,7 @@ using namespace fir; namespace { -// Conversion of fir control ops to more primitive control-flow. -// -// FIR loops that cannot be converted to the affine dialect will remain as -// `fir.do_loop` operations. These can be converted to control-flow operations. - -/// Convert `fir.do_loop` to `scf.for` +// Conversion to CFG class ScfLoopConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -39,23 +34,114 @@ class ScfLoopConv : public mlir::OpRewritePattern { // lowered to a semantically correct CFG. mlir::LogicalResult matchAndRewrite(LoopOp loop, mlir::PatternRewriter &rewriter) const override { - auto loc = loop.getLoc(); - auto low = loop.lowerBound(); - auto high = loop.upperBound(); - auto step = loop.step(); - assert(low && high && step); - // ForOp has different bounds semantics. Adjust upper bound. - auto adjustUp = rewriter.create(loc, high, step); - auto f = rewriter.create(loc, low, adjustUp, step); - f.region().getBlocks().clear(); - rewriter.inlineRegionBefore(loop.region(), f.region(), f.region().end()); - rewriter.eraseOp(loop); + Location loc = loop.getLoc(); + + // Create the start and end blocks that will wrap the LoopOp with an + // initalizer and an end point + mlir::Block *initBlock = rewriter.getInsertionBlock(); + auto initPos = rewriter.getInsertionPoint(); + mlir::Block *endBlock = rewriter.splitBlock(initBlock, initPos); + + // Split the first LoopOp block in two parts. The part before will be the + // conditional block since it already has the induction variable and + // loop-carried values as arguments. + mlir::Block *conditionalBlock = &loop.region().front(); + mlir::Block *firstBlock = rewriter.splitBlock(conditionalBlock, + conditionalBlock->begin()); + mlir::Block *lastBlock = &loop.region().back(); + + // Move the blocks from the LoopOp between initBlock and endBlock + rewriter.inlineRegionBefore(loop.region(), endBlock); + + // Get loop values from the LoopOp + mlir::Value low = loop.lowerBound(); + mlir::Value high = loop.upperBound(); + mlir::Value step = loop.step(); + if (!low || !high) { + return failure(); + } + + + // Initalization block + rewriter.setInsertionPointToEnd(initBlock); + mlir::Value zero = rewriter.create(loc, 0); + mlir::Value one = rewriter.create(loc, 1); + mlir::Value diff = rewriter.create(loc, high, low); + mlir::Value distance = rewriter.create(loc, diff, step); + mlir::Value normalizedDistance = + rewriter.create(loc, distance, step); + mlir::Type storeType = normalizedDistance.getType(); + mlir::Value tripCounter = + rewriter.create(loc, storeType, llvm::None); + rewriter.create(loc, normalizedDistance, tripCounter); + + SmallVector loopOperands; + loopOperands.push_back(low); + mlir::ValueRange operands = loop.getIterOperands(); + loopOperands.append(operands.begin(), operands.end()); + + // TODO: replace with a command line flag + // onetrip flag determines whether loop should be executed once, before + // conditionals are checked + static const bool onetrip = false; + if (onetrip) { + rewriter.create(loc, firstBlock, ArrayRef()); + } else { + rewriter.create(loc, conditionalBlock, loopOperands); + } + + + // Last loop block + mlir::Operation *terminator = lastBlock->getTerminator(); + rewriter.setInsertionPointToEnd(lastBlock); + mlir::Value index = conditionalBlock->getArgument(0); + mlir::Value steppedIndex = + rewriter.create(loc, index, step).getResult(); + mlir::Value tripCount = rewriter.create(loc, tripCounter); + mlir::Value steppedTripCount = + rewriter.create(loc, tripCount, one); + rewriter.create(loc, steppedTripCount, tripCounter); + + SmallVector loopCarried; + loopCarried.push_back(steppedIndex); + loopCarried.append(terminator->operand_begin(), terminator->operand_end()); + rewriter.create(loc, conditionalBlock, loopCarried); + rewriter.eraseOp(terminator); + + if (!steppedIndex) { + return failure(); + } + + + // Conditional block + rewriter.setInsertionPointToEnd(conditionalBlock); + mlir::Value tripCountValue = + rewriter.create(loc, tripCounter); + mlir::Value comparison = + rewriter.create(loc, CmpIPredicate::sgt, tripCountValue, zero); + + rewriter.create(loc, comparison, firstBlock, + ArrayRef(), endBlock, + ArrayRef()); + + + // The result of the loop operation is the values of the condition block + // arguments except the induction variable on the last iteration. + rewriter.replaceOp(loop, conditionalBlock->getArguments().drop_front()); + return success(); } }; -/// Convert `fir.result` to `scf.yield` -class ScfResultConv : public mlir::OpRewritePattern { + +// Conversion to the SCF dialect. +// +// FIR loops that cannot be converted to the affine dialect will remain as +// `fir.do_loop` operations. These can be converted to `scf.for` operations. +// MLIR includes a pass to lower `scf.for` operations to a CFG. + +/// Convert `fir.if` to `scf.if` +class ScfIfConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; From 572c3b03319a8ade1050db90e19e98e39c368909 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Fri, 29 May 2020 09:40:31 -0700 Subject: [PATCH 0069/1017] Harden access to Evaluation::evaluationList --- flang/lib/Lower/Bridge.cpp | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index a1951fafece58..d8e9d89c7a692 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -683,7 +683,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::DoConstruct &) { auto &eval = getEval(); bool unstructuredContext = eval.lowerAsUnstructured(); - Fortran::lower::pft::Evaluation &doStmtEval = eval.evaluationList->front(); + Fortran::lower::pft::Evaluation &doStmtEval = + eval.getFirstNestedEvaluation(); auto *doStmt = doStmtEval.getIf(); assert(doStmt && "missing DO statement"); const auto &loopControl = @@ -728,7 +729,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { genFIRIncrementLoopBegin(incrementLoopInfo[i]); // Generate loop body code. - for (auto &e : *eval.evaluationList) + for (auto &e : eval.getNestedEvaluations()) genFIR(e, unstructuredContext); setCurrentEval(eval); @@ -826,7 +827,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Structured fir.where nest. fir::WhereOp underWhere; mlir::OpBuilder::InsertPoint insPt; - for (auto &e : *eval.evaluationList) { + for (auto &e : eval.getNestedEvaluations()) { if (auto *s = e.getIf()) { // fir.where op std::tie(insPt, underWhere) = genWhereCondition(s); @@ -848,7 +849,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // Unstructured branch sequence. - for (auto &e : *eval.evaluationList) { + for (auto &e : eval.getNestedEvaluations()) { const Fortran::parser::ScalarLogicalExpr *cond = nullptr; if (auto *s = e.getIf()) { maybeStartBlock(e.block); @@ -872,7 +873,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(const Fortran::parser::CaseConstruct &) { - for (auto &e : *getEval().evaluationList) + for (auto &e : getEval().getNestedEvaluations()) genFIR(e); } @@ -1471,7 +1472,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // When transitioning from unstructured to structured code, // the structured code could be a target that starts a new block. maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured() - ? eval.evaluationList->front().block + ? eval.getFirstNestedEvaluation().block : eval.block); } @@ -1483,11 +1484,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::lower::pft::Evaluation *successor{}; if (eval.isActionStmt()) { successor = eval.controlSuccessor; - } else if (eval.isConstruct()) { - assert(!eval.evaluationList->empty() && "empty construct eval list"); - if (eval.evaluationList->back() - .lexicalSuccessor->isIntermediateConstructStmt()) - successor = eval.constructExit; + } else if (eval.isConstruct() && + eval.getLastNestedEvaluation() + .lexicalSuccessor->isIntermediateConstructStmt()) { + successor = eval.constructExit; } if (successor && successor->block) genBranch(successor->block); @@ -1867,11 +1867,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { eval.localBlocks[i] = builder->createBlock(&builder->getRegion()); if (eval.isConstruct() || eval.isDirective()) { if (eval.lowerAsUnstructured()) { - createEmptyBlocks(*eval.evaluationList); - } else { + createEmptyBlocks(eval.getNestedEvaluations()); + } else if (eval.hasNestedEvaluations()) { // A structured construct that is a target starts a new block. - Fortran::lower::pft::Evaluation &constructStmt = - eval.evaluationList->front(); + auto &constructStmt = eval.getFirstNestedEvaluation(); if (constructStmt.isNewBlock) constructStmt.block = builder->createBlock(&builder->getRegion()); } From 9f2afe9ef90ae5d6d2f7a8a668d73632799ed067 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 1 Jun 2020 12:08:15 -0700 Subject: [PATCH 0070/1017] rename CharRT to use longer names --- flang/include/flang/Lower/CharRT.h | 36 -------- flang/lib/Lower/CharRT.cpp | 132 ----------------------------- 2 files changed, 168 deletions(-) delete mode 100644 flang/include/flang/Lower/CharRT.h delete mode 100644 flang/lib/Lower/CharRT.cpp diff --git a/flang/include/flang/Lower/CharRT.h b/flang/include/flang/Lower/CharRT.h deleted file mode 100644 index 4be9480dbfb31..0000000000000 --- a/flang/include/flang/Lower/CharRT.h +++ /dev/null @@ -1,36 +0,0 @@ -//===-- Lower/CharRT.h -- lower CHARACTER operations ------------*- C++ -*-===// -// -// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -// See https://llvm.org/LICENSE.txt for license information. -// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -// -//===----------------------------------------------------------------------===// - -#ifndef FORTRAN_LOWER_CHARRT_H -#define FORTRAN_LOWER_CHARRT_H - -#include "mlir/Dialect/StandardOps/IR/Ops.h" - -namespace Fortran { -namespace lower { -class AbstractConverter; - -/// Generate call to a character comparison for two ssa-values of type -/// `boxchar`. -mlir::Value genBoxCharCompare(AbstractConverter &converter, mlir::Location loc, - mlir::CmpIPredicate cmp, mlir::Value lhs, - mlir::Value rhs); - -/// Generate call to a character comparison op for two unboxed variables. There -/// are 4 arguments, 2 for the lhs and 2 for the rhs. Each CHARACTER must pass a -/// reference to its buffer (`ref>`) and its LEN type parameter (some -/// integral type). -mlir::Value genRawCharCompare(AbstractConverter &converter, mlir::Location loc, - mlir::CmpIPredicate cmp, mlir::Value lhsBuff, - mlir::Value lhsLen, mlir::Value rhsBuff, - mlir::Value rhsLen); - -} // namespace lower -} // namespace Fortran - -#endif // FORTRAN_LOWER_CHARRT_H diff --git a/flang/lib/Lower/CharRT.cpp b/flang/lib/Lower/CharRT.cpp deleted file mode 100644 index 1ff31b37605df..0000000000000 --- a/flang/lib/Lower/CharRT.cpp +++ /dev/null @@ -1,132 +0,0 @@ -//===-- CharRT.cpp -- runtime support for CHARACTER type entities ---------===// -// -// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -// See https://llvm.org/LICENSE.txt for license information. -// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -// -//===----------------------------------------------------------------------===// - -#include "flang/Lower/CharRT.h" -#include "../../runtime/character.h" -#include "RTBuilder.h" -#include "flang/Lower/Bridge.h" -#include "flang/Lower/CharacterExpr.h" -#include "flang/Lower/FIRBuilder.h" -#include "mlir/Dialect/StandardOps/IR/Ops.h" - -#define TODO() llvm_unreachable("not yet implemented") - -using namespace Fortran::runtime; - -#define NAMIFY_HELPER(X) #X -#define NAMIFY(X) NAMIFY_HELPER(IONAME(X)) -#define mkRTKey(X) mkKey(RTNAME(X)) - -namespace Fortran::lower { -/// Static table of CHARACTER runtime calls -/// -/// This logical map contains the name and type builder function for each -/// runtime function listed in the tuple. This table is fully constructed at -/// compile-time. Use the `mkRTKey` macro to access the table. -static constexpr std::tuple< - mkRTKey(CharacterCompareScalar), mkRTKey(CharacterCompareScalar1), - mkRTKey(CharacterCompareScalar2), mkRTKey(CharacterCompareScalar4), - mkRTKey(CharacterCompare)> - newCharRTTable; -} // namespace Fortran::lower - -using namespace Fortran::lower; - -/// Helper function to retrieve the name of the IO function given the key `A` -template -static constexpr const char *getName() { - return std::get(newCharRTTable).name; -} - -/// Helper function to retrieve the type model signature builder of the IO -/// function as defined by the key `A` -template -static constexpr FuncTypeBuilderFunc getTypeModel() { - return std::get(newCharRTTable).getTypeModel(); -} - -inline int64_t getLength(mlir::Type argTy) { - return argTy.cast().getShape()[0]; -} - -/// Get (or generate) the MLIR FuncOp for a given runtime function. -template -static mlir::FuncOp getRuntimeFunc(Fortran::lower::FirOpBuilder &builder) { - auto name = getName(); - auto func = builder.getNamedFunction(name); - if (func) - return func; - auto funTy = getTypeModel()(builder.getContext()); - func = builder.createFunction(name, funTy); - func.setAttr("fir.runtime", builder.getUnitAttr()); - return func; -} - -/// Helper function to recover the KIND from the FIR type. -static int discoverKind(mlir::Type ty) { - if (auto charTy = ty.dyn_cast()) - return charTy.getFKind(); - if (auto eleTy = fir::dyn_cast_ptrEleTy(ty)) - return discoverKind(eleTy); - if (auto arrTy = ty.dyn_cast()) - return discoverKind(arrTy.getEleTy()); - if (auto boxTy = ty.dyn_cast()) - return discoverKind(boxTy.getEleTy()); - if (auto boxTy = ty.dyn_cast()) - return discoverKind(boxTy.getEleTy()); - llvm_unreachable("unexpected character type"); -} - -//===----------------------------------------------------------------------===// -// Lower character operations -//===----------------------------------------------------------------------===// - -mlir::Value -Fortran::lower::genRawCharCompare(Fortran::lower::AbstractConverter &converter, - mlir::Location loc, mlir::CmpIPredicate cmp, - mlir::Value lhsBuff, mlir::Value lhsLen, - mlir::Value rhsBuff, mlir::Value rhsLen) { - auto &builder = converter.getFirOpBuilder(); - builder.setLocation(loc); - mlir::FuncOp beginFunc; - switch (discoverKind(lhsBuff.getType())) { - case 1: - beginFunc = getRuntimeFunc(builder); - break; - case 2: - beginFunc = getRuntimeFunc(builder); - break; - case 4: - beginFunc = getRuntimeFunc(builder); - break; - default: - llvm_unreachable("runtime does not support CHARACTER KIND"); - } - auto fTy = beginFunc.getType(); - auto lptr = builder.createConvert(loc, fTy.getInput(0), lhsBuff); - auto llen = builder.createConvert(loc, fTy.getInput(2), lhsLen); - auto rptr = builder.createConvert(loc, fTy.getInput(1), rhsBuff); - auto rlen = builder.createConvert(loc, fTy.getInput(3), rhsLen); - llvm::SmallVector args = {lptr, rptr, llen, rlen}; - auto tri = builder.create(loc, beginFunc, args).getResult(0); - auto zero = builder.createIntegerConstant(tri.getType(), 0); - return builder.create(loc, cmp, tri, zero); -} - -mlir::Value -Fortran::lower::genBoxCharCompare(Fortran::lower::AbstractConverter &converter, - mlir::Location loc, mlir::CmpIPredicate cmp, - mlir::Value lhs, mlir::Value rhs) { - auto &builder = converter.getFirOpBuilder(); - builder.setLocation(loc); - Fortran::lower::CharacterExprHelper helper{builder, loc}; - auto lhsPair = helper.materializeCharacter(lhs); - auto rhsPair = helper.materializeCharacter(rhs); - return genRawCharCompare(converter, loc, cmp, lhsPair.first, lhsPair.second, - rhsPair.first, rhsPair.second); -} From 813f82a9601c1d66bd47e7b993eef60daf23d769 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 1 Jun 2020 13:27:21 -0700 Subject: [PATCH 0071/1017] more cleanup --- flang/lib/Lower/Bridge.cpp | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index d8e9d89c7a692..ef8f9c782900a 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -19,8 +19,10 @@ #include "flang/Lower/OpenMP.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" +#include "flang/Lower/Support/BoxValue.h" #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/tools.h" @@ -750,11 +752,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); auto upperValue = genFIRLoopIndex(info.upperExpr, type); info.stepValue = - info.stepExpr.has_value() - ? genFIRLoopIndex(*info.stepExpr, type) - : info.isStructured() - ? builder->create(location, 1) - : builder->createIntegerConstant(info.loopVariableType, 1); + info.stepExpr.has_value() ? genFIRLoopIndex(*info.stepExpr, type) + : info.isStructured() + ? builder->create(location, 1) + : builder->createIntegerConstant(info.loopVariableType, 1); assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(location, *info.loopVariableSym); From 2398f1a89c5299e669784f8f41523efdde4a161b Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 1 Jun 2020 15:52:12 -0700 Subject: [PATCH 0072/1017] fallout changes fix tests use block arguments instead of a temp --- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 115 ++++++------------ flang/test/Fir/embox-write.fir | 5 +- flang/test/Fir/loop.fir | 2 +- flang/test/Fir/loop10.fir | 14 +-- flang/tools/bbc/bbc.cpp | 2 +- 5 files changed, 50 insertions(+), 88 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 0c8e32080db09..ff09252e5549e 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -45,40 +45,32 @@ class ScfLoopConv : public mlir::OpRewritePattern { // Split the first LoopOp block in two parts. The part before will be the // conditional block since it already has the induction variable and // loop-carried values as arguments. - mlir::Block *conditionalBlock = &loop.region().front(); - mlir::Block *firstBlock = rewriter.splitBlock(conditionalBlock, - conditionalBlock->begin()); - mlir::Block *lastBlock = &loop.region().back(); + auto *conditionalBlock = &loop.region().front(); + conditionalBlock->addArgument(rewriter.getIndexType()); + auto *firstBlock = + rewriter.splitBlock(conditionalBlock, conditionalBlock->begin()); + auto *lastBlock = &loop.region().back(); // Move the blocks from the LoopOp between initBlock and endBlock rewriter.inlineRegionBefore(loop.region(), endBlock); // Get loop values from the LoopOp - mlir::Value low = loop.lowerBound(); - mlir::Value high = loop.upperBound(); - mlir::Value step = loop.step(); - if (!low || !high) { - return failure(); - } - + auto low = loop.lowerBound(); + auto high = loop.upperBound(); + assert(low && high && "must be a Value"); + auto step = loop.step(); // Initalization block rewriter.setInsertionPointToEnd(initBlock); - mlir::Value zero = rewriter.create(loc, 0); - mlir::Value one = rewriter.create(loc, 1); - mlir::Value diff = rewriter.create(loc, high, low); - mlir::Value distance = rewriter.create(loc, diff, step); - mlir::Value normalizedDistance = - rewriter.create(loc, distance, step); - mlir::Type storeType = normalizedDistance.getType(); - mlir::Value tripCounter = - rewriter.create(loc, storeType, llvm::None); - rewriter.create(loc, normalizedDistance, tripCounter); + auto diff = rewriter.create(loc, high, low); + auto distance = rewriter.create(loc, diff, step); + auto iters = rewriter.create(loc, distance, step); SmallVector loopOperands; loopOperands.push_back(low); mlir::ValueRange operands = loop.getIterOperands(); loopOperands.append(operands.begin(), operands.end()); + loopOperands.push_back(iters); // TODO: replace with a command line flag // onetrip flag determines whether loop should be executed once, before @@ -90,65 +82,36 @@ class ScfLoopConv : public mlir::OpRewritePattern { rewriter.create(loc, conditionalBlock, loopOperands); } - // Last loop block mlir::Operation *terminator = lastBlock->getTerminator(); rewriter.setInsertionPointToEnd(lastBlock); - mlir::Value index = conditionalBlock->getArgument(0); - mlir::Value steppedIndex = - rewriter.create(loc, index, step).getResult(); - mlir::Value tripCount = rewriter.create(loc, tripCounter); - mlir::Value steppedTripCount = - rewriter.create(loc, tripCount, one); - rewriter.create(loc, steppedTripCount, tripCounter); + auto iv = conditionalBlock->getArgument(0); + mlir::Value steppedIndex = rewriter.create(loc, iv, step); + assert(steppedIndex && "must be a Value"); + auto lastArg = conditionalBlock->getNumArguments() - 1; + auto itersLeft = conditionalBlock->getArgument(lastArg); + auto one = rewriter.create(loc, 1); + mlir::Value itersMinusOne = + rewriter.create(loc, itersLeft, one); SmallVector loopCarried; loopCarried.push_back(steppedIndex); loopCarried.append(terminator->operand_begin(), terminator->operand_end()); - rewriter.create(loc, conditionalBlock, loopCarried); + loopCarried.push_back(itersMinusOne); + rewriter.create(loc, conditionalBlock, loopCarried); rewriter.eraseOp(terminator); - if (!steppedIndex) { - return failure(); - } - - // Conditional block rewriter.setInsertionPointToEnd(conditionalBlock); - mlir::Value tripCountValue = - rewriter.create(loc, tripCounter); - mlir::Value comparison = - rewriter.create(loc, CmpIPredicate::sgt, tripCountValue, zero); - - rewriter.create(loc, comparison, firstBlock, - ArrayRef(), endBlock, - ArrayRef()); + auto zero = rewriter.create(loc, 0); + auto comparison = + rewriter.create(loc, CmpIPredicate::sgt, itersLeft, zero); // The result of the loop operation is the values of the condition block // arguments except the induction variable on the last iteration. - rewriter.replaceOp(loop, conditionalBlock->getArguments().drop_front()); - - return success(); - } -}; - - -// Conversion to the SCF dialect. -// -// FIR loops that cannot be converted to the affine dialect will remain as -// `fir.do_loop` operations. These can be converted to `scf.for` operations. -// MLIR includes a pass to lower `scf.for` operations to a CFG. - -/// Convert `fir.if` to `scf.if` -class ScfIfConv : public mlir::OpRewritePattern { -public: - using OpRewritePattern::OpRewritePattern; - - mlir::LogicalResult - matchAndRewrite(fir::ResultOp op, - mlir::PatternRewriter &rewriter) const override { - rewriter.replaceOpWithNewOp(op); + rewriter.replaceOp( + loop, conditionalBlock->getArguments().drop_front().drop_back()); return success(); } }; @@ -182,8 +145,8 @@ class ScfIfConv : public mlir::OpRewritePattern { // place it before the continuation block, and branch to it. auto &whereRegion = where.whereRegion(); auto *whereBlock = &whereRegion.front(); - mlir::Operation *whereTerminator = whereRegion.back().getTerminator(); - mlir::ValueRange whereTerminatorOperands = whereTerminator->getOperands(); + auto *whereTerminator = whereRegion.back().getTerminator(); + auto whereTerminatorOperands = whereTerminator->getOperands(); rewriter.setInsertionPointToEnd(&whereRegion.back()); rewriter.create(loc, continueBlock, whereTerminatorOperands); rewriter.eraseOp(whereTerminator); @@ -196,8 +159,8 @@ class ScfIfConv : public mlir::OpRewritePattern { auto &otherwiseRegion = where.otherRegion(); if (!otherwiseRegion.empty()) { otherwiseBlock = &otherwiseRegion.front(); - mlir::Operation *otherwiseTerm = otherwiseRegion.back().getTerminator(); - mlir::ValueRange otherwiseTermOperands = otherwiseTerm->getOperands(); + auto *otherwiseTerm = otherwiseRegion.back().getTerminator(); + auto otherwiseTermOperands = otherwiseTerm->getOperands(); rewriter.setInsertionPointToEnd(&otherwiseRegion.back()); rewriter.create(loc, continueBlock, otherwiseTermOperands); rewriter.eraseOp(otherwiseTerm); @@ -246,12 +209,11 @@ class ScfIterWhileConv : public mlir::OpRewritePattern { // Append the induction variable stepping logic to the last body block and // branch back to the condition block. Loop-carried values are taken from // operands of the loop terminator. - mlir::Operation *terminator = lastBodyBlock->getTerminator(); + auto *terminator = lastBodyBlock->getTerminator(); rewriter.setInsertionPointToEnd(lastBodyBlock); auto step = whileOp.step(); - auto stepped = rewriter.create(loc, iv, step).getResult(); - if (!stepped) - return failure(); + mlir::Value stepped = rewriter.create(loc, iv, step); + assert(stepped && "must be a Value"); llvm::SmallVector loopCarried; loopCarried.push_back(stepped); @@ -261,10 +223,9 @@ class ScfIterWhileConv : public mlir::OpRewritePattern { // Compute loop bounds before branching to the condition. rewriter.setInsertionPointToEnd(initBlock); - mlir::Value lowerBound = whileOp.lowerBound(); - mlir::Value upperBound = whileOp.upperBound(); - if (!lowerBound || !upperBound) - return failure(); + auto lowerBound = whileOp.lowerBound(); + auto upperBound = whileOp.upperBound(); + assert(lowerBound && upperBound && "must be a Value"); // The initial values of loop-carried values is obtained from the operands // of the loop operation. diff --git a/flang/test/Fir/embox-write.fir b/flang/test/Fir/embox-write.fir index 6766f72c0eb2e..66d85d4179ad4 100644 --- a/flang/test/Fir/embox-write.fir +++ b/flang/test/Fir/embox-write.fir @@ -7,8 +7,9 @@ func @set_all_n(%n : index, %x : i32) { %c1 = constant 1 : index %aDim = fir.gendims %c1, %n, %c1 : (index, index, index) -> !fir.dims<1> %a = fir.embox %aMem, %aDim : (!fir.ref>, !fir.dims<1>) -> !fir.box> - // CHECK: phi i64 - // CHECK-NEXT: icmp + // CHECK-DAG: %[[IV:.*]] = phi i64 + // CHECK-DAG: %[[LCV:.*]] = phi i64 + // CHECK: icmp sgt i64 %[[LCV]], 0 fir.do_loop %i = %c1 to %n step %c1 unordered { %1 = fir.coordinate_of %a, %i : (!fir.box>, index) -> !fir.ref // CHECK: store i32 %{{.*}}, i32* %{{.*}} diff --git a/flang/test/Fir/loop.fir b/flang/test/Fir/loop.fir index 61b25a7880ff5..77026ed0ee571 100644 --- a/flang/test/Fir/loop.fir +++ b/flang/test/Fir/loop.fir @@ -5,7 +5,7 @@ // CHECK-LABEL: @x func @x(%lb : index, %ub : index, %step : index, %b : i1, %addr : !fir.ref) { // CHECK: [[LOOP:[0-9]+]]: - // CHECK: %[[COND:.*]] = icmp slt i64 + // CHECK: %[[COND:.*]] = icmp sgt i64 %{{.*}}, 0 // CHECK: br i1 %[[COND]] fir.do_loop %iv = %lb to %ub step %step unordered { // expect following conditional blocks to get fused diff --git a/flang/test/Fir/loop10.fir b/flang/test/Fir/loop10.fir index 9969dfee8be50..fe3c484521f23 100644 --- a/flang/test/Fir/loop10.fir +++ b/flang/test/Fir/loop10.fir @@ -1,5 +1,3 @@ -// Test lowering FIR to LLVM IR of fir.select{|_rank|_case} - // RUN: tco %s | FileCheck %s // CHECK: @x({{.*}} %[[ADDR:.*]]) @@ -7,13 +5,15 @@ func @x(%addr : !fir.ref>) -> index { %c0 = constant 0 : index %c10 = constant 10 : index %c1 = constant 1 : index - // CHECK: %[[ROW:.*]] = phi i64 - // CHECK: icmp slt i64 %[[ROW]], 11 + // CHECK-DAG: %[[R:.*]] = phi i64 {{.*}} [ 0, + // CHECK-DAG: %[[ROW:.*]] = phi i64 {{.*}} [ 11, + // CHECK: icmp sgt i64 %[[ROW]], 0 fir.do_loop %iv = %c0 to %c10 step %c1 { - // CHECK: %[[COL:.*]] = phi i64 - // CHECK: icmp slt i64 %[[COL]], 11 + // CHECK-DAG: %[[C:.*]] = phi i64 {{.*}} [ 0, + // CHECK-DAG: %[[COL:.*]] = phi i64 {{.*}} [ 11, + // CHECK: icmp sgt i64 %[[COL]], 0 fir.do_loop %jv = %c0 to %c10 step %c1 { - // CHECK: getelementptr {{.*}} %[[ADDR]], i64 0, i64 %[[ROW]], i64 %[[COL]] + // CHECK: getelementptr {{.*}} %[[ADDR]], i64 0, i64 %[[R]], i64 %[[C]] %ptr = fir.coordinate_of %addr, %jv, %iv : (!fir.ref>, index, index) -> !fir.ref %c22 = constant 22 : i32 // CHECK: store i32 22, diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 7044e22a24217..65389eda4a449 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -231,7 +231,7 @@ static void convertFortranSourceToMLIR( passPipeline.addToPipeline(pm); } else { pm.addPass(fir::createPromoteToAffinePass()); - pm.addPass(fir::createLowerToScfPass()); + pm.addPass(fir::createFirToCfgPass()); pm.addPass(fir::createControlFlowLoweringPass()); pm.addPass(mlir::createLowerToCFGPass()); // pm.addPass(fir::createMemToRegPass()); From ba593c3c2481fc186998be5b244bd077ccbf859d Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 2 Jun 2020 09:49:53 -0700 Subject: [PATCH 0073/1017] rebase fallout --- flang/lib/Evaluate/type.cpp | 8 -- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 103 +++++++++--------- 2 files changed, 50 insertions(+), 61 deletions(-) diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp index 8aabe5d6d44ec..fb82fbcd05ee4 100644 --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -38,13 +38,6 @@ static bool IsDescriptor(const ObjectEntityDetails &details) { return true; } // TODO: Automatic (adjustable) arrays - are they descriptors? - if (details.isDummy()) { - return details.IsAssumedShape() || details.IsDeferredShape() || - details.IsAssumedRank(); - } - return !details.shape().empty() && !details.shape().IsConstantShape(); -#if 0 - // FIXME: use this? for (const ShapeSpec &shapeSpec : details.shape()) { const auto &lb{shapeSpec.lbound().GetExplicit()}; const auto &ub{shapeSpec.ubound().GetExplicit()}; @@ -53,7 +46,6 @@ static bool IsDescriptor(const ObjectEntityDetails &details) { } } return false; -#endif } static bool IsDescriptor(const ProcEntityDetails &details) { diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index ff09252e5549e..ee2ba4551d314 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -17,30 +17,33 @@ /// disable FIR to scf dialect conversion static llvm::cl::opt - disableScfConversion("disable-scf-conversion", - llvm::cl::desc("disable FIR to SCF pass"), + disableCfgConversion("disable-cfg-conversion", + llvm::cl::desc("disable FIR to CFG pass"), llvm::cl::init(false)); using namespace fir; namespace { -// Conversion to CFG -class ScfLoopConv : public mlir::OpRewritePattern { +// Conversion of fir control ops to more primitive control-flow. +// +// FIR loops that cannot be converted to the affine dialect will remain as +// `fir.do_loop` operations. These can be converted to control-flow operations. + +/// Convert `fir.do_loop` to CFG +class CfgLoopConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; - // FIXME: This should NOT be using scf.for. Instead, fir.do_loop should be - // lowered to a semantically correct CFG. mlir::LogicalResult matchAndRewrite(LoopOp loop, mlir::PatternRewriter &rewriter) const override { - Location loc = loop.getLoc(); + auto loc = loop.getLoc(); // Create the start and end blocks that will wrap the LoopOp with an // initalizer and an end point - mlir::Block *initBlock = rewriter.getInsertionBlock(); + auto *initBlock = rewriter.getInsertionBlock(); auto initPos = rewriter.getInsertionPoint(); - mlir::Block *endBlock = rewriter.splitBlock(initBlock, initPos); + auto *endBlock = rewriter.splitBlock(initBlock, initPos); // Split the first LoopOp block in two parts. The part before will be the // conditional block since it already has the induction variable and @@ -66,9 +69,9 @@ class ScfLoopConv : public mlir::OpRewritePattern { auto distance = rewriter.create(loc, diff, step); auto iters = rewriter.create(loc, distance, step); - SmallVector loopOperands; + llvm::SmallVector loopOperands; loopOperands.push_back(low); - mlir::ValueRange operands = loop.getIterOperands(); + auto operands = loop.getIterOperands(); loopOperands.append(operands.begin(), operands.end()); loopOperands.push_back(iters); @@ -76,14 +79,13 @@ class ScfLoopConv : public mlir::OpRewritePattern { // onetrip flag determines whether loop should be executed once, before // conditionals are checked static const bool onetrip = false; - if (onetrip) { - rewriter.create(loc, firstBlock, ArrayRef()); - } else { - rewriter.create(loc, conditionalBlock, loopOperands); - } + if (onetrip) + rewriter.create(loc, firstBlock, ArrayRef()); + else + rewriter.create(loc, conditionalBlock, loopOperands); // Last loop block - mlir::Operation *terminator = lastBlock->getTerminator(); + auto *terminator = lastBlock->getTerminator(); rewriter.setInsertionPointToEnd(lastBlock); auto iv = conditionalBlock->getArgument(0); mlir::Value steppedIndex = rewriter.create(loc, iv, step); @@ -94,7 +96,7 @@ class ScfLoopConv : public mlir::OpRewritePattern { mlir::Value itersMinusOne = rewriter.create(loc, itersLeft, one); - SmallVector loopCarried; + llvm::SmallVector loopCarried; loopCarried.push_back(steppedIndex); loopCarried.append(terminator->operand_begin(), terminator->operand_end()); loopCarried.push_back(itersMinusOne); @@ -107,6 +109,9 @@ class ScfLoopConv : public mlir::OpRewritePattern { auto comparison = rewriter.create(loc, CmpIPredicate::sgt, itersLeft, zero); + rewriter.create(loc, comparison, firstBlock, + llvm::ArrayRef(), endBlock, + llvm::ArrayRef()); // The result of the loop operation is the values of the condition block // arguments except the induction variable on the last iteration. @@ -117,7 +122,7 @@ class ScfLoopConv : public mlir::OpRewritePattern { }; /// Convert `fir.if` to control-flow -class ScfIfConv : public mlir::OpRewritePattern { +class CfgIfConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -138,7 +143,7 @@ class ScfIfConv : public mlir::OpRewritePattern { } else { continueBlock = rewriter.createBlock(remainingOpsBlock, where.getResultTypes()); - rewriter.create(loc, remainingOpsBlock); + rewriter.create(loc, remainingOpsBlock); } // Move blocks from the "then" region to the region containing 'fir.if', @@ -148,7 +153,8 @@ class ScfIfConv : public mlir::OpRewritePattern { auto *whereTerminator = whereRegion.back().getTerminator(); auto whereTerminatorOperands = whereTerminator->getOperands(); rewriter.setInsertionPointToEnd(&whereRegion.back()); - rewriter.create(loc, continueBlock, whereTerminatorOperands); + rewriter.create(loc, continueBlock, + whereTerminatorOperands); rewriter.eraseOp(whereTerminator); rewriter.inlineRegionBefore(whereRegion, continueBlock); @@ -162,7 +168,8 @@ class ScfIfConv : public mlir::OpRewritePattern { auto *otherwiseTerm = otherwiseRegion.back().getTerminator(); auto otherwiseTermOperands = otherwiseTerm->getOperands(); rewriter.setInsertionPointToEnd(&otherwiseRegion.back()); - rewriter.create(loc, continueBlock, otherwiseTermOperands); + rewriter.create(loc, continueBlock, + otherwiseTermOperands); rewriter.eraseOp(otherwiseTerm); rewriter.inlineRegionBefore(otherwiseRegion, continueBlock); } @@ -177,14 +184,14 @@ class ScfIfConv : public mlir::OpRewritePattern { }; /// Convert `fir.iter_while` to control-flow. -class ScfIterWhileConv : public mlir::OpRewritePattern { +class CfgIterWhileConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; mlir::LogicalResult matchAndRewrite(fir::IterWhileOp whileOp, mlir::PatternRewriter &rewriter) const override { - mlir::Location loc = whileOp.getLoc(); + auto loc = whileOp.getLoc(); // Start by splitting the block containing the 'fir.do_loop' into two parts. // The part before will get the init code, the part after will be the end @@ -218,7 +225,7 @@ class ScfIterWhileConv : public mlir::OpRewritePattern { llvm::SmallVector loopCarried; loopCarried.push_back(stepped); loopCarried.append(terminator->operand_begin(), terminator->operand_end()); - rewriter.create(loc, conditionBlock, loopCarried); + rewriter.create(loc, conditionBlock, loopCarried); rewriter.eraseOp(terminator); // Compute loop bounds before branching to the condition. @@ -233,17 +240,17 @@ class ScfIterWhileConv : public mlir::OpRewritePattern { destOperands.push_back(lowerBound); auto iterOperands = whileOp.getIterOperands(); destOperands.append(iterOperands.begin(), iterOperands.end()); - rewriter.create(loc, conditionBlock, destOperands); + rewriter.create(loc, conditionBlock, destOperands); // With the body block done, we can fill in the condition block. rewriter.setInsertionPointToEnd(conditionBlock); auto comp1 = - rewriter.create(loc, CmpIPredicate::slt, iv, upperBound); + rewriter.create(loc, CmpIPredicate::slt, iv, upperBound); // Remember to AND in the early-exit bool. - auto comparison = rewriter.create(loc, comp1, iterateVar); - rewriter.create(loc, comparison, firstBodyBlock, - llvm::ArrayRef(), endBlock, - llvm::ArrayRef()); + auto comparison = rewriter.create(loc, comp1, iterateVar); + rewriter.create(loc, comparison, firstBodyBlock, + llvm::ArrayRef(), endBlock, + llvm::ArrayRef()); // The result of the loop operation is the values of the condition block // arguments except the induction variable on the last iteration. rewriter.replaceOp(whileOp, conditionBlock->getArguments().drop_front()); @@ -251,46 +258,36 @@ class ScfIterWhileConv : public mlir::OpRewritePattern { } }; -/// Convert FIR structured control flow ops to SCF ops. -class ScfDialectConversion - : public mlir::PassWrapper { +/// Convert FIR structured control flow ops to CFG ops. +class CfgConversion + : public mlir::PassWrapper { public: void runOnFunction() override { - if (disableScfConversion) + if (disableCfgConversion) return; auto *context = &getContext(); - mlir::OwningRewritePatternList patterns1; - patterns1.insert(context); - - mlir::OwningRewritePatternList patterns2; - patterns2.insert(context); + mlir::OwningRewritePatternList patterns; + patterns.insert(context); mlir::ConversionTarget target = *context; target.addLegalDialect(); + mlir::StandardOpsDialect>(); // apply the patterns - target.addIllegalOp(); + target.addIllegalOp(); if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, - std::move(patterns1)))) { + std::move(patterns)))) { mlir::emitError(mlir::UnknownLoc::get(context), "error in converting to CFG\n"); signalPassFailure(); } - target.addIllegalOp(); - if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, - std::move(patterns2)))) { - mlir::emitError(mlir::UnknownLoc::get(context), - "error in converting to scf dialect\n"); - signalPassFailure(); - } } }; } // namespace -/// Convert FIR's structured control flow ops to SCF ops. This +/// Convert FIR's structured control flow ops to CFG ops. This /// conversion enables the `createLowerToCFGPass` to transform these to CFG /// form. -std::unique_ptr fir::createLowerToScfPass() { - return std::make_unique(); +std::unique_ptr fir::createFirToCfgPass() { + return std::make_unique(); } From 293acf9c7d16b8e519ae05df4b1128983e56adca Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 2 Jun 2020 10:28:30 -0700 Subject: [PATCH 0074/1017] add a clear message that ENTRY is not supported yet --- flang/lib/Lower/Bridge.cpp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index ef8f9c782900a..bed286ba1ee78 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1401,7 +1401,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { // data transfer statement. } - void genFIR(const Fortran::parser::EntryStmt &) { TODO(); } + void genFIR(const Fortran::parser::EntryStmt &) { + // FIXME: Need to lower this for F77. + mlir::emitError(toLocation(), "ENTRY statement is not handled."); + exit(1); + } void genFIR(const Fortran::parser::PauseStmt &stmt) { genPauseStatement(*this, stmt); From d7a34b887332626e1356dba6ab93a3b5ef119e07 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 2 Jun 2020 12:26:58 -0700 Subject: [PATCH 0075/1017] [NFC] change comments to reflect what the code actually does. --- flang/lib/Lower/Bridge.cpp | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index bed286ba1ee78..0459081617831 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -637,9 +637,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto selectExpr = builder->create(toLocation(), variable); auto iter = symbolLabelMap.find(symbol); if (iter == symbolLabelMap.end()) { - // This "assert" will fail for a nonconforming program unit that does not - // have any ASSIGN statements. The front end should check for this. - // If asserts are inactive, the assigned GOTO statement will be a nop. + // Fail for a nonconforming program unit that does not have any ASSIGN + // statements. The front end should check for this. llvm_unreachable("no assigned goto targets"); return; } @@ -653,10 +652,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Add labels from an explicit list. The list may have duplicates. for (auto &label : std::get>(stmt.t)) { if (labelSet.count(label) == 0) { - // This "assert" will fail for a nonconforming program unit that never - // ASSIGNs this label to the selector variable. The front end should - // check that there is at least one such ASSIGN statement. If asserts - // are inactive, the label will be ignored. + // Fail for a nonconforming program unit that never ASSIGNs this label + // to the selector variable. The front end should check that there is + // at least one such ASSIGN statement. llvm_unreachable("invalid assigned goto target"); continue; } From 5ce002b435b90861b88c1c3d9b99e001f81860a1 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 3 Jun 2020 13:56:10 -0700 Subject: [PATCH 0076/1017] fix for hollerith constants --- flang/runtime/format-implementation.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/runtime/format-implementation.h b/flang/runtime/format-implementation.h index 91d80a7336019..f29e69a5f000d 100644 --- a/flang/runtime/format-implementation.h +++ b/flang/runtime/format-implementation.h @@ -237,10 +237,10 @@ int FormatControl::CueUpNextDataEdit(Context &context, bool stop) { } if (ch == '-' || ch == '+' || (ch >= '0' && ch <= '9')) { repeat = GetIntField(context, ch); - ch = GetNextChar(context); + ch = Capitalize(GetNextChar(context)); } else if (ch == '*') { unlimited = true; - ch = GetNextChar(context); + ch = Capitalize(GetNextChar(context)); if (ch != '(') { context.SignalError(IostatErrorInFormat, "Invalid FORMAT: '*' may appear only before '('"); From a7441be98cc52dd79da5296d4b2bb28b04eb60a2 Mon Sep 17 00:00:00 2001 From: zachary-selk Date: Wed, 3 Jun 2020 12:15:01 -0600 Subject: [PATCH 0077/1017] Added bit-wise intrinsics --- flang/lib/Lower/Intrinsics.cpp | 24 ++++++++++++++++++++++++ flang/test/Lower/intrinsics.f90 | 24 ++++++++++++++++++++++++ 2 files changed, 48 insertions(+) diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index 296922b323d38..57a01adb62365 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -733,6 +733,14 @@ mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType, return builder.createHere(resultType, floor); } +// IAND +mlir::Value IntrinsicLibrary::genIAnd(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + + return builder.createHere(args[0], args[1]); +} + // ICHAR mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, llvm::ArrayRef args) { @@ -750,6 +758,22 @@ mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, return builder.createHere(resultType, charVal); } +// IEOR +mlir::Value IntrinsicLibrary::genIEOr(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + + return builder.createHere(args[0], args[1]); +} + +// IOR +mlir::Value IntrinsicLibrary::genIOr(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + + return builder.createHere(args[0], args[1]); +} + // LEN_TRIM mlir::Value IntrinsicLibrary::genLenTrim(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index b074e23073cd9..4cfede5158772 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -91,6 +91,14 @@ subroutine floor_test2(i, a) ! CHECK: fir.convert %[[f]] : (f32) -> i64 end subroutine +! IAND +! CHECK-LABEL: iand_test +subroutine iand_test(a, b) + integer :: a, b + print *, iand(a, b) + ! CHECK: %{{[0-9]+}} = and %{{[0-9]+}}, %{{[0-9]+}} : i{{(8|16|32|64|128)}} +end subroutine iand_test + ! ICHAR ! CHECK-LABEL: ichar_test subroutine ichar_test(c) @@ -99,6 +107,22 @@ subroutine ichar_test(c) print *, ichar(c) end subroutine +! IEOR +! CHECK-LABEL: ieor_test +subroutine ieor_test(a, b) + integer :: a, b + print *, ieor(a, b) + ! CHECK: %{{[0-9]+}} = xor %{{[0-9]+}}, %{{[0-9]+}} : i{{(8|16|32|64|128)}} +end subroutine ieor_test + +! IOR +! CHECK-LABEL: ior_test +subroutine ior_test(a, b) + integer :: a, b + print *, ior(a, b) + ! CHECK: %{{[0-9]+}} = or %{{[0-9]+}}, %{{[0-9]+}} : i{{(8|16|32|64|128)}} +end subroutine ior_test + ! LEN ! CHECK-LABEL: len_test subroutine len_test(i, c) From fb36b7bdbd704b61e2d4c125e6f327548b892337 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 3 Jun 2020 14:48:59 -0700 Subject: [PATCH 0078/1017] Revert "Added bit-wise intrinsics" --- flang/lib/Lower/Intrinsics.cpp | 24 ------------------------ flang/test/Lower/intrinsics.f90 | 24 ------------------------ 2 files changed, 48 deletions(-) diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index 57a01adb62365..296922b323d38 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -733,14 +733,6 @@ mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType, return builder.createHere(resultType, floor); } -// IAND -mlir::Value IntrinsicLibrary::genIAnd(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - - return builder.createHere(args[0], args[1]); -} - // ICHAR mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, llvm::ArrayRef args) { @@ -758,22 +750,6 @@ mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, return builder.createHere(resultType, charVal); } -// IEOR -mlir::Value IntrinsicLibrary::genIEOr(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - - return builder.createHere(args[0], args[1]); -} - -// IOR -mlir::Value IntrinsicLibrary::genIOr(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - - return builder.createHere(args[0], args[1]); -} - // LEN_TRIM mlir::Value IntrinsicLibrary::genLenTrim(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index 4cfede5158772..b074e23073cd9 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -91,14 +91,6 @@ subroutine floor_test2(i, a) ! CHECK: fir.convert %[[f]] : (f32) -> i64 end subroutine -! IAND -! CHECK-LABEL: iand_test -subroutine iand_test(a, b) - integer :: a, b - print *, iand(a, b) - ! CHECK: %{{[0-9]+}} = and %{{[0-9]+}}, %{{[0-9]+}} : i{{(8|16|32|64|128)}} -end subroutine iand_test - ! ICHAR ! CHECK-LABEL: ichar_test subroutine ichar_test(c) @@ -107,22 +99,6 @@ subroutine ichar_test(c) print *, ichar(c) end subroutine -! IEOR -! CHECK-LABEL: ieor_test -subroutine ieor_test(a, b) - integer :: a, b - print *, ieor(a, b) - ! CHECK: %{{[0-9]+}} = xor %{{[0-9]+}}, %{{[0-9]+}} : i{{(8|16|32|64|128)}} -end subroutine ieor_test - -! IOR -! CHECK-LABEL: ior_test -subroutine ior_test(a, b) - integer :: a, b - print *, ior(a, b) - ! CHECK: %{{[0-9]+}} = or %{{[0-9]+}}, %{{[0-9]+}} : i{{(8|16|32|64|128)}} -end subroutine ior_test - ! LEN ! CHECK-LABEL: len_test subroutine len_test(i, c) From faeb3efe8033d3b4d2de8832219376a517190e46 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 3 Jun 2020 16:30:36 -0700 Subject: [PATCH 0079/1017] fix for lowering of fir.array with an runtime sized interior dimension. --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 11 +++++++++-- flang/test/Fir/types-to-llvm.fir | 15 +++++++++++++++ 2 files changed, 24 insertions(+), 2 deletions(-) create mode 100644 flang/test/Fir/types-to-llvm.fir diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index e14c142443bce..e83f311f9b1c0 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -235,9 +235,16 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { template mlir::LLVM::LLVMType convertPointerLike(A &ty) { mlir::Type eleTy = ty.getEleTy(); + // A sequence type is a special case. A sequence of runtime size on its + // interior dimensions lowers to a memory reference. In that case, we + // degenerate the array and do not want a the type to become `T**` but + // merely `T*`. if (auto seqTy = eleTy.dyn_cast()) { - if (!seqTy.hasConstantShape() && seqTy.hasConstantInterior()) - return unwrap(convertType(seqTy)); + if (!seqTy.hasConstantShape()) { + if (seqTy.hasConstantInterior()) + return unwrap(convertType(seqTy)); + eleTy = seqTy.getEleTy(); + } } return unwrap(convertType(eleTy)).getPointerTo(); } diff --git a/flang/test/Fir/types-to-llvm.fir b/flang/test/Fir/types-to-llvm.fir new file mode 100644 index 0000000000000..d870aaa160d4a --- /dev/null +++ b/flang/test/Fir/types-to-llvm.fir @@ -0,0 +1,15 @@ +// RUN: tco %s | FileCheck %s + +// CHECK-LABEL: declare void @foo0([20 x [10 x [5 x i32]]]*) +func @foo0(%arg0: !fir.ref>) +// CHECK-LABEL: declare void @foo1(i32*) +func @foo1(%arg0: !fir.ref>) +// CHECK-LABEL: declare void @foo2(i32*) +func @foo2(%arg0: !fir.ref>) +// CHECK-LABEL: declare void @foo3([10 x [5 x i32]]*) +func @foo3(%arg0: !fir.ref>) +// CHECK-LABEL: declare void @foo4(i32*) +func @foo4(%arg0: !fir.ref>) + +// CHECK-LABEL: declare void @byval5(i32*) +func @byval5(%arg0: !fir.array) From 927f3f5b4b5830d5140f4418760489a64c9dd766 Mon Sep 17 00:00:00 2001 From: V Donaldson Date: Wed, 3 Jun 2020 11:01:25 -0700 Subject: [PATCH 0080/1017] I/O implied do loops. Use know bool values in makeNextConditionalOn. review update tests combine new tests into a single test --- flang/lib/Lower/Bridge.cpp | 14 ++++---- flang/test/Lower/io-stmt02.f90 | 6 ++-- flang/test/Lower/io-stmt03.f90 | 60 ++++++++++++++++++++++++++++++++++ 3 files changed, 69 insertions(+), 11 deletions(-) create mode 100644 flang/test/Lower/io-stmt03.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 0459081617831..56fea1f2f85a3 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -231,6 +231,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { // AbstractConverter overrides //===--------------------------------------------------------------------===// + /// Find the symbol in the local map or return null. + mlir::Value lookupSymbol(const Fortran::semantics::Symbol &sym) { + if (auto v = localSymbols.lookupSymbol(sym)) + return v; + return {}; + } + mlir::Value genExprAddr(const Fortran::lower::SomeExpr &expr, mlir::Location *loc = nullptr) override final { return createFIRAddr(loc ? *loc : toLocation(), &expr); @@ -344,13 +351,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { return createSomeExpression(loc, *this, *expr, localSymbols); } - /// Find the symbol in the local map or return null. - mlir::Value lookupSymbol(const Fortran::semantics::Symbol &sym) { - if (auto v = localSymbols.lookupSymbol(sym)) - return v; - return {}; - } - /// Add the symbol to the local map. If the symbol is already in the map, it /// is not updated. Instead the value `false` is returned. bool addSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val, diff --git a/flang/test/Lower/io-stmt02.f90 b/flang/test/Lower/io-stmt02.f90 index 431c756eb3c18..9e261386fc8ee 100644 --- a/flang/test/Lower/io-stmt02.f90 +++ b/flang/test/Lower/io-stmt02.f90 @@ -1,21 +1,19 @@ ! RUN: bbc -emit-fir -o - %s | FileCheck %s character*10 :: exx - character*20 :: c character*30 :: m integer*2 :: s exx = 'AA' - c = 'BBBB' m = 'CCCCCC' s = -13 ! CHECK: call {{.*}}BeginExternalFormattedInput ! CHECK: call {{.*}}EnableHandlers ! CHECK: call {{.*}}SetAdvance - ! CHECK: call {{.*}}InputAscii + ! CHECK: call {{.*}}InputReal ! CHECK: call {{.*}}GetIoMsg ! CHECK: call {{.*}}EndIoStatement ! CHECK: fir.select %{{.*}} : index [-2, ^bb4, -1, ^bb3, 0, ^bb1, unit, ^bb2] - read(*, '(A)', ADVANCE='NO', ERR=10, END=20, EOR=30, IOSTAT=s, IOMSG=m) c + read(*, '(A)', ADVANCE='NO', ERR=10, END=20, EOR=30, IOSTAT=s, IOMSG=m) f ! CHECK-LABEL: ^bb1: exx = 'Zip'; goto 90 10 exx = 'Err'; goto 90 diff --git a/flang/test/Lower/io-stmt03.f90 b/flang/test/Lower/io-stmt03.f90 new file mode 100644 index 0000000000000..238188ad604e8 --- /dev/null +++ b/flang/test/Lower/io-stmt03.f90 @@ -0,0 +1,60 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +! CHECK-LABEL: func @_QPcontrol0 +subroutine control0(n) ! no I/O condition specifier control flow +dimension c(n), d(n,n), e(n,n), f(n) +! CHECK-NOT: fir.if +! CHECK: BeginExternalFormattedInput +! CHECK-NOT: fir.if +! CHECK: SetAdvance +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: fir.do_loop +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: fir.do_loop +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: EndIoStatement +! CHECK-NOT: fir.if +read(*,'(F7.2)', advance='no') a, b, (c(j), (d(k,j), e(k,j), k=1,n), f(j), j=1,n), g +end + +! CHECK-LABEL: func @_QPcontrol1 +subroutine control1(n) ! I/O condition specifier control flow +! CHECK: BeginExternalFormattedInput +! CHECK: EnableHandlers +! CHECK: SetAdvance +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: fir.iterate_while +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: fir.iterate_while +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: EndIoStatement +dimension c(n), d(n,n), e(n,n), f(n) +read(*,'(F7.2)', iostat=mm, advance='no') a, b, (c(j), (d(k,j), e(k,j), k=1,n), f(j), j=1,n), g +end From e6e675bb0d21cb853db364664629accec2d906f0 Mon Sep 17 00:00:00 2001 From: zachary-selk Date: Thu, 4 Jun 2020 08:00:43 -0600 Subject: [PATCH 0081/1017] Fixed missing function declarations Revert "Revert "Added bit-wise intrinsics"" This reverts commit 7ddff247379e69cd901572f1485752bdff77d0f9. Revert "Revert "Added bit-wise intrinsics"" This reverts commit 7ddff247379e69cd901572f1485752bdff77d0f9. Added bitwise intrinsics Revert "Revert "Added bit-wise intrinsics"" This reverts commit 7ddff247379e69cd901572f1485752bdff77d0f9. Revert "Revert "Added bit-wise intrinsics"" This reverts commit 7ddff247379e69cd901572f1485752bdff77d0f9. Added bitwise intrinsics --- flang/lib/Lower/Intrinsics.cpp | 30 ++++++++++++++++++++++++++++++ flang/test/Lower/intrinsics.f90 | 24 ++++++++++++++++++++++++ 2 files changed, 54 insertions(+) diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp index 296922b323d38..41876a2873c05 100644 --- a/flang/lib/Lower/Intrinsics.cpp +++ b/flang/lib/Lower/Intrinsics.cpp @@ -115,7 +115,10 @@ struct IntrinsicLibrary { template mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); mlir::Value genFloor(mlir::Type, llvm::ArrayRef); + mlir::Value genIAnd(mlir::Type, llvm::ArrayRef); mlir::Value genIchar(mlir::Type, llvm::ArrayRef); + mlir::Value genIEOr(mlir::Type, llvm::ArrayRef); + mlir::Value genIOr(mlir::Type, llvm::ArrayRef); mlir::Value genLenTrim(mlir::Type, llvm::ArrayRef); mlir::Value genMerge(mlir::Type, llvm::ArrayRef); mlir::Value genMod(mlir::Type, llvm::ArrayRef); @@ -165,7 +168,10 @@ static constexpr IntrinsicHanlder handlers[]{ {"conjg", &I::genConjg}, {"dble", &I::genConversion}, {"floor", &I::genFloor}, + {"iand", &I::genIAnd}, {"ichar", &I::genIchar}, + {"ieor", &I::genIEOr}, + {"ior", &I::genIOr}, {"len_trim", &I::genLenTrim}, {"max", &I::genExtremum}, {"min", &I::genExtremum}, @@ -733,6 +739,14 @@ mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType, return builder.createHere(resultType, floor); } +// IAND +mlir::Value IntrinsicLibrary::genIAnd(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + + return builder.createHere(args[0], args[1]); +} + // ICHAR mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, llvm::ArrayRef args) { @@ -750,6 +764,22 @@ mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, return builder.createHere(resultType, charVal); } +// IEOR +mlir::Value IntrinsicLibrary::genIEOr(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + + return builder.createHere(args[0], args[1]); +} + +// IOR +mlir::Value IntrinsicLibrary::genIOr(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + + return builder.createHere(args[0], args[1]); +} + // LEN_TRIM mlir::Value IntrinsicLibrary::genLenTrim(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index b074e23073cd9..4cfede5158772 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -91,6 +91,14 @@ subroutine floor_test2(i, a) ! CHECK: fir.convert %[[f]] : (f32) -> i64 end subroutine +! IAND +! CHECK-LABEL: iand_test +subroutine iand_test(a, b) + integer :: a, b + print *, iand(a, b) + ! CHECK: %{{[0-9]+}} = and %{{[0-9]+}}, %{{[0-9]+}} : i{{(8|16|32|64|128)}} +end subroutine iand_test + ! ICHAR ! CHECK-LABEL: ichar_test subroutine ichar_test(c) @@ -99,6 +107,22 @@ subroutine ichar_test(c) print *, ichar(c) end subroutine +! IEOR +! CHECK-LABEL: ieor_test +subroutine ieor_test(a, b) + integer :: a, b + print *, ieor(a, b) + ! CHECK: %{{[0-9]+}} = xor %{{[0-9]+}}, %{{[0-9]+}} : i{{(8|16|32|64|128)}} +end subroutine ieor_test + +! IOR +! CHECK-LABEL: ior_test +subroutine ior_test(a, b) + integer :: a, b + print *, ior(a, b) + ! CHECK: %{{[0-9]+}} = or %{{[0-9]+}}, %{{[0-9]+}} : i{{(8|16|32|64|128)}} +end subroutine ior_test + ! LEN ! CHECK-LABEL: len_test subroutine len_test(i, c) From 55bd181a34faab4fa9a27710e8cc1086a2d8f33e Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 4 Jun 2020 12:23:51 -0700 Subject: [PATCH 0082/1017] [NFC] merge two tests revert changes to Runtime/format.cpp test. It doesn't compile on MacOS. revert rename change that snuck in --- flang/test/Lower/io-stmt02.f90 | 59 +++++++++++++++++++++++++++++++++ flang/test/Lower/io-stmt03.f90 | 60 ---------------------------------- 2 files changed, 59 insertions(+), 60 deletions(-) delete mode 100644 flang/test/Lower/io-stmt03.f90 diff --git a/flang/test/Lower/io-stmt02.f90 b/flang/test/Lower/io-stmt02.f90 index 9e261386fc8ee..fbe2457c894bb 100644 --- a/flang/test/Lower/io-stmt02.f90 +++ b/flang/test/Lower/io-stmt02.f90 @@ -21,3 +21,62 @@ 30 exx = 'Eor'; goto 90 90 print*, exx, c, m, s end + +! CHECK-LABEL: func @_QPcontrol0 +subroutine control0(n) ! no I/O condition specifier control flow +dimension c(n), d(n,n), e(n,n), f(n) +! CHECK-NOT: fir.if +! CHECK: BeginExternalFormattedInput +! CHECK-NOT: fir.if +! CHECK: SetAdvance +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: fir.do_loop +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: fir.do_loop +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: EndIoStatement +! CHECK-NOT: fir.if +read(*,'(F7.2)', advance='no') a, b, (c(j), (d(k,j), e(k,j), k=1,n), f(j), j=1,n), g +end + +! CHECK-LABEL: func @_QPcontrol1 +subroutine control1(n) ! I/O condition specifier control flow +! CHECK: BeginExternalFormattedInput +! CHECK: EnableHandlers +! CHECK: SetAdvance +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: fir.iterate_while +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: fir.iterate_while +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: EndIoStatement +dimension c(n), d(n,n), e(n,n), f(n) +read(*,'(F7.2)', iostat=mm, advance='no') a, b, (c(j), (d(k,j), e(k,j), k=1,n), f(j), j=1,n), g +end diff --git a/flang/test/Lower/io-stmt03.f90 b/flang/test/Lower/io-stmt03.f90 deleted file mode 100644 index 238188ad604e8..0000000000000 --- a/flang/test/Lower/io-stmt03.f90 +++ /dev/null @@ -1,60 +0,0 @@ -! RUN: bbc -emit-fir -o - %s | FileCheck %s - -! CHECK-LABEL: func @_QPcontrol0 -subroutine control0(n) ! no I/O condition specifier control flow -dimension c(n), d(n,n), e(n,n), f(n) -! CHECK-NOT: fir.if -! CHECK: BeginExternalFormattedInput -! CHECK-NOT: fir.if -! CHECK: SetAdvance -! CHECK-NOT: fir.if -! CHECK: InputReal32 -! CHECK-NOT: fir.if -! CHECK: InputReal32 -! CHECK-NOT: fir.if -! CHECK: fir.do_loop -! CHECK-NOT: fir.if -! CHECK: InputReal32 -! CHECK-NOT: fir.if -! CHECK: fir.do_loop -! CHECK-NOT: fir.if -! CHECK: InputReal32 -! CHECK-NOT: fir.if -! CHECK: InputReal32 -! CHECK-NOT: fir.if -! CHECK: InputReal32 -! CHECK-NOT: fir.if -! CHECK: InputReal32 -! CHECK-NOT: fir.if -! CHECK: EndIoStatement -! CHECK-NOT: fir.if -read(*,'(F7.2)', advance='no') a, b, (c(j), (d(k,j), e(k,j), k=1,n), f(j), j=1,n), g -end - -! CHECK-LABEL: func @_QPcontrol1 -subroutine control1(n) ! I/O condition specifier control flow -! CHECK: BeginExternalFormattedInput -! CHECK: EnableHandlers -! CHECK: SetAdvance -! CHECK: fir.if -! CHECK: InputReal32 -! CHECK: fir.if -! CHECK: InputReal32 -! CHECK: fir.if -! CHECK: fir.iterate_while -! CHECK: fir.if -! CHECK: InputReal32 -! CHECK: fir.if -! CHECK: fir.iterate_while -! CHECK: fir.if -! CHECK: InputReal32 -! CHECK: fir.if -! CHECK: InputReal32 -! CHECK: fir.if -! CHECK: InputReal32 -! CHECK: fir.if -! CHECK: InputReal32 -! CHECK: EndIoStatement -dimension c(n), d(n,n), e(n,n), f(n) -read(*,'(F7.2)', iostat=mm, advance='no') a, b, (c(j), (d(k,j), e(k,j), k=1,n), f(j), j=1,n), g -end From ad09ff0780bdce15df8af826c5e1c580c5bdedc2 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 4 Jun 2020 14:58:01 -0700 Subject: [PATCH 0083/1017] [refactor] More partitioning of code for upstreaming effort. --- flang/lib/Lower/Intrinsics.cpp | 958 --------------------------------- 1 file changed, 958 deletions(-) delete mode 100644 flang/lib/Lower/Intrinsics.cpp diff --git a/flang/lib/Lower/Intrinsics.cpp b/flang/lib/Lower/Intrinsics.cpp deleted file mode 100644 index 41876a2873c05..0000000000000 --- a/flang/lib/Lower/Intrinsics.cpp +++ /dev/null @@ -1,958 +0,0 @@ -//===-- Intrinsics.cpp ----------------------------------------------------===// -// -// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -// See https://llvm.org/LICENSE.txt for license information. -// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -// -//===----------------------------------------------------------------------===// -// -// Builder routines for constructing the FIR dialect of MLIR. As FIR is a -// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding -// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this -// module. -// -//===----------------------------------------------------------------------===// - -#include "RTBuilder.h" -#include "flang/Lower/CharacterExpr.h" -#include "flang/Lower/ComplexExpr.h" -#include "flang/Lower/ConvertType.h" -#include "flang/Lower/FIRBuilder.h" -#include "flang/Lower/Runtime.h" -#include "llvm/Support/CommandLine.h" -#include "llvm/Support/ErrorHandling.h" -#include -#include - -#define PGMATH_DECLARE -#include "../runtime/pgmath.h.inc" - -/// This file implements lowering of Fortran intrinsic procedures. -/// Intrinsics are lowered to a mix of FIR and MLIR operations as -/// well as call to runtime functions or LLVM intrinsics. - -/// Lowering of intrinsic procedure calls is based on a map that associates -/// Fortran intrinsic generic names to FIR generator functions. -/// All generator functions are member functions of the IntrinsicLibrary class -/// and have the same interface. -/// If no generator is given for an intrinsic name, a math runtime library -/// is searched for an implementation and, if a runtime function is found, -/// a call is generated for it. LLVM intrinsics are handled as a math -/// runtime library here. - -/// Enums used to templatize and share lowering of MIN and MAX. -enum class Extremum { Min, Max }; - -// There are different ways to deal with NaNs in MIN and MAX. -// Known existing behaviors are listed below and can be selected for -// f18 MIN/MAX implementation. -enum class ExtremumBehavior { - // Note: the Signaling/quiet aspect of NaNs in the behaviors below are - // not described because there is no way to control/observe such aspect in - // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this - // aspect that are therefore currently not enforced. In the descriptions - // below, NaNs can be signaling or quite. Returned NaNs may be signaling - // if one of the input NaN was signaling but it cannot be guaranteed either. - // Existing compilers using an IEEE behavior (gfortran) also do not fulfill - // signaling/quiet requirements. - IeeeMinMaximumNumber, - // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6): - // If one of the argument is and number and the other is NaN, return the - // number. If both arguements are NaN, return NaN. - // Compilers: gfortran. - IeeeMinMaximum, - // IEEE minimum/maximum behavior (754-2019, section 9.6): - // If one of the argument is NaN, return NaN. - MinMaxss, - // x86 minss/maxss behavior: - // If the second argument is a number and the other is NaN, return the number. - // In all other cases where at least one operand is NaN, return NaN. - // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor. - PgfortranLlvm, - // "Opposite of" x86 minss/maxss behavior: - // If the first argument is a number and the other is NaN, return the - // number. - // In all other cases where at least one operand is NaN, return NaN. - // Compilers: xlf (only for MIN), and pgfortran (with llvm). - IeeeMinMaxNum - // IEEE minNum/maxNum behavior (754-2008, section 5.3.1): - // TODO: Not implemented. - // It is the only behavior where the signaling/quiet aspect of a NaN argument - // impacts if the result should be NaN or the argument that is a number. - // LLVM/MLIR do not provide ways to observe this aspect, so it is not - // possible to implement it without some target dependent runtime. -}; - -// TODO error handling -> return a code or directly emit messages ? -struct IntrinsicLibrary { - - // Constructors. - explicit IntrinsicLibrary(Fortran::lower::FirOpBuilder &builder, - mlir::Location loc) - : builder{builder}, loc{loc} {} - IntrinsicLibrary() = delete; - IntrinsicLibrary(const IntrinsicLibrary &) = delete; - - /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg - /// and expected result type \p resultType. - mlir::Value genIntrinsicCall(llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef arg); - - /// Search a runtime function that is associated to the generic intrinsic name - /// and whose signature matches the intrinsic arguments and result types. - /// If no such runtime function is found but a runtime function associated - /// with the Fortran generic exists and has the same number of arguments, - /// conversions will be inserted before and/or after the call. This is to - /// mainly to allow 16 bits float support even-though little or no math - /// runtime is currently available for it. - mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type, - llvm::ArrayRef); - - mlir::Value genAbs(mlir::Type, llvm::ArrayRef); - mlir::Value genAimag(mlir::Type, llvm::ArrayRef); - mlir::Value genConjg(mlir::Type, llvm::ArrayRef); - mlir::Value genCeiling(mlir::Type, llvm::ArrayRef); - template - mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); - mlir::Value genFloor(mlir::Type, llvm::ArrayRef); - mlir::Value genIAnd(mlir::Type, llvm::ArrayRef); - mlir::Value genIchar(mlir::Type, llvm::ArrayRef); - mlir::Value genIEOr(mlir::Type, llvm::ArrayRef); - mlir::Value genIOr(mlir::Type, llvm::ArrayRef); - mlir::Value genLenTrim(mlir::Type, llvm::ArrayRef); - mlir::Value genMerge(mlir::Type, llvm::ArrayRef); - mlir::Value genMod(mlir::Type, llvm::ArrayRef); - mlir::Value genNint(mlir::Type, llvm::ArrayRef); - mlir::Value genSign(mlir::Type, llvm::ArrayRef); - /// Implement all conversion functions like DBLE, the first argument is - /// the value to convert. There may be an additional KIND arguments that - /// is ignored because this is already reflected in the result type. - mlir::Value genConversion(mlir::Type, llvm::ArrayRef); - - /// Define the different FIR generators that can be mapped to intrinsic to - /// generate the related code. - using Generator = decltype(&IntrinsicLibrary::genAbs); - - /// All generators can be outlined. This will build a function named - /// "fir."+ + "." + and generate the - /// intrinsic implementation inside instead of at the intrinsic call sites. - /// This can be used to keep the FIR more readable. Only one function will - /// be generated for all the similar calls in a program. - /// If the Generator is nullptr, the wrapper uses genRuntimeCall. - mlir::Value outlineInWrapper(Generator, llvm::StringRef name, - mlir::Type resultType, - llvm::ArrayRef args); - - Fortran::lower::FirOpBuilder &builder; - mlir::Location loc; -}; - -/// Table that drives the fir generation depending on the intrinsic. -/// one to one mapping with Fortran arguments. If no mapping is -/// defined here for a generic intrinsic, genRuntimeCall will be called -/// to look for a match in the runtime a emit a call. -struct IntrinsicHanlder { - const char *name; - IntrinsicLibrary::Generator generator; - /// Code heavy intrinsic can be outlined to make FIR - /// more readable. - bool outline = false; -}; -using I = IntrinsicLibrary; -static constexpr IntrinsicHanlder handlers[]{ - {"abs", &I::genAbs}, - {"achar", &I::genConversion}, - {"aimag", &I::genAimag}, - {"ceiling", &I::genCeiling}, - {"char", &I::genConversion}, - {"conjg", &I::genConjg}, - {"dble", &I::genConversion}, - {"floor", &I::genFloor}, - {"iand", &I::genIAnd}, - {"ichar", &I::genIchar}, - {"ieor", &I::genIEOr}, - {"ior", &I::genIOr}, - {"len_trim", &I::genLenTrim}, - {"max", &I::genExtremum}, - {"min", &I::genExtremum}, - {"merge", &I::genMerge}, - {"mod", &I::genMod}, - {"nint", &I::genNint}, - {"sign", &I::genSign}, -}; - -/// To make fir output more readable for debug, one can outline all intrinsic -/// implementation in wrappers (overrides the IntrinsicHanlder::outline flag). -static llvm::cl::opt outlineAllIntrinsics( - "outline-intrinsics", - llvm::cl::desc( - "Lower all intrinsic procedure implementation in their own functions"), - llvm::cl::init(false)); - -/// Generate a function name for function where intrinsic implementation -/// are outlined. It is not a legal Fortran name and could therefore -/// safely be matched later if needed. -static std::string getIntrinsicWrapperName(const llvm::StringRef &intrinsic, - mlir::FunctionType funTy); -/// Search runtime for the best runtime function given an intrinsic name -/// and interface. The interface may not be a perfect match in which case -/// the caller is responsible to insert argument and return value conversions. -static llvm::Optional -getRuntimeFunction(Fortran::lower::FirOpBuilder &builder, llvm::StringRef name, - mlir::FunctionType funcType); - -//===----------------------------------------------------------------------===// -// Math runtime description and matching utility -//===----------------------------------------------------------------------===// - -/// Command line option to modify math runtime version used to implement -/// intrinsics. -enum MathRuntimeVersion { - fastVersion, - relaxedVersion, - preciseVersion, - llvmOnly -}; -llvm::cl::opt mathRuntimeVersion( - "math-runtime", llvm::cl::desc("Select math runtime version:"), - llvm::cl::values( - clEnumValN(fastVersion, "fast", "use pgmath fast runtime"), - clEnumValN(relaxedVersion, "relaxed", "use pgmath relaxed runtime"), - clEnumValN(preciseVersion, "precise", "use pgmath precise runtime"), - clEnumValN(llvmOnly, "llvm", - "only use LLVM intrinsics (may be incomplete)")), - llvm::cl::init(fastVersion)); - -struct RuntimeFunction { - using Key = llvm::StringRef; - Key key; - llvm::StringRef symbol; - Fortran::lower::FuncTypeBuilderFunc typeGenerator; -}; - -#define RUNTIME_STATIC_DESCRIPTION(name, func) \ - {#name, #func, \ - Fortran::lower::RuntimeTableKey::getTypeModel()}, -static constexpr RuntimeFunction pgmathFast[] = { -#define PGMATH_FAST -#define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func) -#include "../runtime/pgmath.h.inc" -}; -static constexpr RuntimeFunction pgmathRelaxed[] = { -#define PGMATH_RELAXED -#define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func) -#include "../runtime/pgmath.h.inc" -}; -static constexpr RuntimeFunction pgmathPrecise[] = { -#define PGMATH_PRECISE -#define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func) -#include "../runtime/pgmath.h.inc" -}; - -static mlir::FunctionType genF32F32FuncType(mlir::MLIRContext *context) { - auto t = mlir::FloatType::getF32(context); - return mlir::FunctionType::get({t}, {t}, context); -} -static mlir::FunctionType genF64F64FuncType(mlir::MLIRContext *context) { - auto t = mlir::FloatType::getF64(context); - return mlir::FunctionType::get({t}, {t}, context); -} - -template -static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) { - auto t = mlir::FloatType::getF64(context); - auto r = mlir::IntegerType::get(Bits, context); - return mlir::FunctionType::get({t}, {r}, context); -} -template -static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) { - auto t = mlir::FloatType::getF32(context); - auto r = mlir::IntegerType::get(Bits, context); - return mlir::FunctionType::get({t}, {r}, context); -} - -// TODO : Fill-up this table with more intrinsic. -// Note: These are also defined as operations in LLVM dialect. See if this -// can be use and has advantages. -static constexpr RuntimeFunction llvmIntrinsics[] = { - {"abs", "llvm.fabs.f32", genF32F32FuncType}, - {"abs", "llvm.fabs.f64", genF64F64FuncType}, - // ceil is used for CEILING but is different, it returns a real. - {"ceil", "llvm.ceil.f32", genF32F32FuncType}, - {"ceil", "llvm.ceil.f64", genF64F64FuncType}, - {"cos", "llvm.cos.f32", genF32F32FuncType}, - {"cos", "llvm.cos.f64", genF64F64FuncType}, - // llvm.floor is used for FLOOR, but returns real. - {"floor", "llvm.floor.f32", genF32F32FuncType}, - {"floor", "llvm.floor.f64", genF64F64FuncType}, - {"log", "llvm.log.f32", genF32F32FuncType}, - {"log", "llvm.log.f64", genF64F64FuncType}, - {"log10", "llvm.log10.f32", genF32F32FuncType}, - {"log10", "llvm.log10.f64", genF64F64FuncType}, - {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>}, - {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>}, - {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>}, - {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>}, - {"sin", "llvm.sin.f32", genF32F32FuncType}, - {"sin", "llvm.sin.f64", genF64F64FuncType}, - {"sqrt", "llvm.sqrt.f32", genF32F32FuncType}, - {"sqrt", "llvm.sqrt.f64", genF64F64FuncType}, -}; - -// This helper class computes a "distance" between two function types. -// The distance measures how many narrowing conversions of actual arguments -// and result of "from" must be made in order to use "to" instead of "from". -// For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is -// greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means -// if no implementation of ACOS(REAL(10)) is available, it is better to use -// ACOS(REAL(16)) with casts rather than ACOS(REAL(8)). -// Note that this is not a symmetric distance and the order of "from" and "to" -// arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it -// may be safe to replace foo by bar, but not the opposite. -class FunctionDistance { -public: - FunctionDistance() : infinite{true} {} - FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) { - auto nInputs = from.getNumInputs(); - auto nResults = from.getNumResults(); - if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) { - infinite = true; - } else { - for (decltype(nInputs) i{0}; i < nInputs && !infinite; ++i) - addArgumentDistance(from.getInput(i), to.getInput(i)); - for (decltype(nResults) i{0}; i < nResults && !infinite; ++i) - addResultDistance(to.getResult(i), from.getResult(i)); - } - } - /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be - /// false if both d1 and d2 are infinite. This implies that - /// d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1) - bool isSmallerThan(const FunctionDistance &d) const { - return !infinite && - (d.infinite || std::lexicographical_compare( - conversions.begin(), conversions.end(), - d.conversions.begin(), d.conversions.end())); - } - bool isLosingPrecision() const { - return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0; - } - bool isInfinite() const { return infinite; } - -private: - enum class Conversion { Forbidden, None, Narrow, Extend }; - - void addArgumentDistance(mlir::Type from, mlir::Type to) { - switch (conversionBetweenTypes(from, to)) { - case Conversion::Forbidden: - infinite = true; - break; - case Conversion::None: - break; - case Conversion::Narrow: - conversions[narrowingArg]++; - break; - case Conversion::Extend: - conversions[nonNarrowingArg]++; - break; - } - } - void addResultDistance(mlir::Type from, mlir::Type to) { - switch (conversionBetweenTypes(from, to)) { - case Conversion::Forbidden: - infinite = true; - break; - case Conversion::None: - break; - case Conversion::Narrow: - conversions[nonExtendingResult]++; - break; - case Conversion::Extend: - conversions[extendingResult]++; - break; - } - } - // Floating point can be mlir::FloatType or fir::real - static unsigned getFloatingPointWidth(mlir::Type t) { - if (auto f{t.dyn_cast()}) - return f.getWidth(); - // FIXME: Get width another way for fir.real/complex - // - use fir/KindMapping.h and llvm::Type - // - or use evaluate/type.h - if (auto r{t.dyn_cast()}) - return r.getFKind() * 4; - if (auto cplx{t.dyn_cast()}) - return cplx.getFKind() * 4; - llvm_unreachable("not a floating-point type"); - } - static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) { - if (from == to) { - return Conversion::None; - } - if (auto fromIntTy{from.dyn_cast()}) { - if (auto toIntTy{to.dyn_cast()}) { - return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow - : Conversion::Extend; - } - } - if (fir::isa_real(from) && fir::isa_real(to)) { - return getFloatingPointWidth(from) > getFloatingPointWidth(to) - ? Conversion::Narrow - : Conversion::Extend; - } - if (auto fromCplxTy{from.dyn_cast()}) { - if (auto toCplxTy{to.dyn_cast()}) { - return getFloatingPointWidth(fromCplxTy) > - getFloatingPointWidth(toCplxTy) - ? Conversion::Narrow - : Conversion::Extend; - } - } - // Notes: - // - No conversion between character types, specialization of runtime - // functions should be made instead. - // - It is not clear there is a use case for automatic conversions - // around Logical and it may damage hidden information in the physical - // storage so do not do it. - return Conversion::Forbidden; - } - - // Below are indexes to access data in conversions. - // The order in data does matter for lexicographical_compare - enum { - narrowingArg = 0, // usually bad - extendingResult, // usually bad - nonExtendingResult, // usually ok - nonNarrowingArg, // usually ok - dataSize - }; - std::array conversions{/* zero init*/}; - bool infinite{false}; // When forbidden conversion or wrong argument number -}; - -static mlir::FuncOp getFuncOp(Fortran::lower::FirOpBuilder &builder, - const RuntimeFunction &runtime) { - auto function = builder.addNamedFunction( - runtime.symbol, runtime.typeGenerator(builder.getContext())); - function.setAttr("fir.runtime", builder.getUnitAttr()); - return function; -} - -// Select runtime function that has the smallest distance to the intrinsic -// function type and that will not imply narrowing arguments or extending the -// result. -template -llvm::Optional -searchFunctionInLibrary(Fortran::lower::FirOpBuilder &builder, - const RuntimeFunction (&lib)[N], llvm::StringRef name, - mlir::FunctionType funcType, - const RuntimeFunction **bestNearMatch, - FunctionDistance &bestMatchDistance) { - auto map = Fortran::lower::StaticMultimapView(lib); - auto range = map.equal_range(name); - for (auto iter{range.first}; iter != range.second && iter; ++iter) { - const auto &impl = *iter; - auto implType = impl.typeGenerator(builder.getContext()); - if (funcType == implType) { - return getFuncOp(builder, impl); // exact match - } else { - FunctionDistance distance(funcType, implType); - if (distance.isSmallerThan(bestMatchDistance)) { - *bestNearMatch = &impl; - bestMatchDistance = std::move(distance); - } - } - } - return {}; -} - -static llvm::Optional -getRuntimeFunction(Fortran::lower::FirOpBuilder &builder, llvm::StringRef name, - mlir::FunctionType funcType) { - const RuntimeFunction *bestNearMatch = nullptr; - FunctionDistance bestMatchDistance{}; - llvm::Optional match; - if (mathRuntimeVersion == fastVersion) { - match = searchFunctionInLibrary(builder, pgmathFast, name, funcType, - &bestNearMatch, bestMatchDistance); - } else if (mathRuntimeVersion == relaxedVersion) { - match = searchFunctionInLibrary(builder, pgmathRelaxed, name, funcType, - &bestNearMatch, bestMatchDistance); - } else if (mathRuntimeVersion == preciseVersion) { - match = searchFunctionInLibrary(builder, pgmathPrecise, name, funcType, - &bestNearMatch, bestMatchDistance); - } else { - assert(mathRuntimeVersion == llvmOnly && "unknown math runtime"); - } - if (match) - return match; - - // Go through llvm intrinsics if not exact match in libpgmath or if - // mathRuntimeVersion == llvmOnly - if (auto exactMatch = - searchFunctionInLibrary(builder, llvmIntrinsics, name, funcType, - &bestNearMatch, bestMatchDistance)) - return exactMatch; - - if (bestNearMatch != nullptr) { - assert(!bestMatchDistance.isLosingPrecision() && - "runtime selection loses precision"); - return getFuncOp(builder, *bestNearMatch); - } - return {}; -} - -/// Helpers to get function type from arguments and result type. -static mlir::FunctionType -getFunctionType(mlir::Type resultType, llvm::ArrayRef arguments, - Fortran::lower::FirOpBuilder &builder) { - llvm::SmallVector argumentTypes; - for (auto &arg : arguments) { - if (arg) - argumentTypes.push_back(arg.getType()); - } - return mlir::FunctionType::get(argumentTypes, resultType, - builder.getModule().getContext()); -} - -/// Helper to encode type into string for intrinsic wrapper name. -// TODO find nicer type to string infra or move this in a mangling utility -// mlir as Type::dump(ostream) methods but it may adds ! -static std::string typeToString(mlir::Type t) { - if (auto i{t.dyn_cast()}) { - return "i" + std::to_string(i.getWidth()); - } - if (auto cplx{t.dyn_cast()}) { - return "z" + std::to_string(cplx.getFKind()); - } - if (auto real{t.dyn_cast()}) { - return "r" + std::to_string(real.getFKind()); - } - if (auto f{t.dyn_cast()}) { - return "f" + std::to_string(f.getWidth()); - } - if (auto logical{t.dyn_cast()}) { - return "l" + std::to_string(logical.getFKind()); - } - if (auto character{t.dyn_cast()}) { - return "c" + std::to_string(character.getFKind()); - } - llvm_unreachable("no mangling for type"); -} - -static std::string getIntrinsicWrapperName(const llvm::StringRef &intrinsic, - mlir::FunctionType funTy) { - std::string name{"fir." + intrinsic.str() + "."}; - assert(funTy.getNumResults() == 1 && "only function mangling supported"); - name += typeToString(funTy.getResult(0)); - auto e = funTy.getNumInputs(); - for (decltype(e) i = 0; i < e; ++i) { - name += "." + typeToString(funTy.getInput(i)); - } - return name; -} - -//===----------------------------------------------------------------------===// -// IntrinsicLibrary -//===----------------------------------------------------------------------===// - -mlir::Value -IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args) { - for (auto &handler : handlers) - if (name == handler.name) { - assert(handler.generator != nullptr); - return handler.outline || outlineAllIntrinsics - ? outlineInWrapper(handler.generator, name, resultType, args) - : std::invoke(handler.generator, *this, resultType, args); - } - // Try the runtime if no special handler was defined for the - // intrinsic being called. - return outlineInWrapper(nullptr, name, resultType, args); -} - -mlir::Value -IntrinsicLibrary::outlineInWrapper(Generator generator, llvm::StringRef name, - mlir::Type resultType, - llvm::ArrayRef args) { - auto funcType = getFunctionType(resultType, args, builder); - std::string wrapperName = getIntrinsicWrapperName(name, funcType); - auto function = builder.getNamedFunction(wrapperName); - if (!function) { - // First time this wrapper is needed, build it. - function = builder.createFunction(wrapperName, funcType); - function.setAttr("fir.intrinsic", builder.getUnitAttr()); - function.addEntryBlock(); - - // Create local context to emit code into the newly created function - // This new function is not linked to a source file location, only - // its calls will be. - auto localBuilder = std::make_unique( - function, builder.getKindMap()); - localBuilder->setInsertionPointToStart(&function.front()); - llvm::SmallVector localArguments; - for (mlir::BlockArgument bArg : function.front().getArguments()) - localArguments.push_back(bArg); - - // Location of code inside wrapper of the wrapper is independent from - // the location of the intrinsic call. - auto savedLoc = loc; - auto localLoc = localBuilder->getUnknownLoc(); - localBuilder->setLocation(localLoc); - IntrinsicLibrary localLib{*localBuilder, localLoc}; - mlir::Value result = - generator ? std::invoke(generator, localLib, resultType, localArguments) - : std::invoke(&IntrinsicLibrary::genRuntimeCall, localLib, - name, resultType, localArguments); - localBuilder->createHere(result); - loc = savedLoc; - } else { - // Wrapper was already built, ensure it has the sought type - assert(function.getType() == funcType); - } - auto call = builder.createHere(function, args); - return call.getResult(0); -} - -mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name, - mlir::Type resultType, - llvm::ArrayRef args) { - // Look up runtime - mlir::FunctionType soughtFuncType = - getFunctionType(resultType, args, builder); - if (auto funcOp = getRuntimeFunction(builder, name, soughtFuncType)) { - mlir::FunctionType actualFuncType = funcOp->getType(); - if (actualFuncType.getNumResults() != soughtFuncType.getNumResults() || - actualFuncType.getNumInputs() != soughtFuncType.getNumInputs() || - actualFuncType.getNumInputs() != args.size() || - actualFuncType.getNumResults() != 1) { - llvm_unreachable("Bad intrinsic match"); - } - llvm::SmallVector convertedArguments; - int i = 0; - for (mlir::Value arg : args) { - auto actualType = actualFuncType.getInput(i); - if (soughtFuncType.getInput(i) != actualType) { - auto castedArg = builder.createHere(actualType, arg); - convertedArguments.push_back(castedArg); - } else { - convertedArguments.push_back(arg); - } - ++i; - } - auto call = builder.createHere(*funcOp, convertedArguments); - mlir::Type soughtType = soughtFuncType.getResult(0); - mlir::Value res = call.getResult(0); - if (actualFuncType.getResult(0) != soughtType) { - auto castedRes = builder.createHere(soughtType, res); - return castedRes; - } else { - return res; - } - } else { - // could not find runtime function - llvm::report_fatal_error("missing intrinsic: " + llvm::Twine(name) + "\n"); - } - return {}; // gets rid of warnings -} - -mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType, - llvm::ArrayRef args) { - // There can be an optional kind in second argument. - assert(args.size() >= 1); - return builder.convertWithSemantics(builder.getLoc(), resultType, args[0]); -} - -// ABS -mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 1); - auto arg = args[0]; - auto type = arg.getType(); - if (fir::isa_real(type)) { - // Runtime call to fp abs. An alternative would be to use mlir AbsFOp - // but it does not support all fir floating point types. - return genRuntimeCall("abs", resultType, args); - } - if (auto intType = type.dyn_cast()) { - // At the time of this implementation there is no abs op in mlir. - // So, implement abs here without branching. - auto shift = builder.createIntegerConstant(intType, intType.getWidth() - 1); - auto mask = builder.createHere(arg, shift); - auto xored = builder.createHere(arg, mask); - return builder.createHere(xored, mask); - } - if (fir::isa_complex(type)) { - // Use HYPOT to fulfill the no underflow/overflow requirement. - auto parts = - Fortran::lower::ComplexExprHelper{builder, loc}.extractParts(arg); - llvm::SmallVector args = {parts.first, parts.second}; - return genIntrinsicCall("hypot", resultType, args); - } - llvm_unreachable("unexpected type in ABS argument"); -} - -// AIMAG -mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 1); - return Fortran::lower::ComplexExprHelper{builder, loc}.extractComplexPart( - args[0], true /* isImagPart */); -} - -// CEILING -mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType, - llvm::ArrayRef args) { - // Optional KIND argument. - assert(args.size() >= 1); - auto arg = args[0]; - // Use ceil that is not an actual Fortran intrinsic but that is - // an llvm intrinsic that does the same, but return a floating - // point. - auto ceil = genRuntimeCall("ceil", arg.getType(), {arg}); - return builder.createHere(resultType, ceil); -} - -// CONJG -mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 1); - if (resultType != args[0].getType()) - llvm_unreachable("argument type mismatch"); - - mlir::Value cplx = args[0]; - auto imag = - Fortran::lower::ComplexExprHelper{builder, loc}.extractComplexPart( - cplx, /*isImagPart=*/true); - auto negImag = builder.createHere(imag); - return Fortran::lower::ComplexExprHelper{builder, loc}.insertComplexPart( - cplx, negImag, /*isImagPart=*/true); -} - -// FLOOR -mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType, - llvm::ArrayRef args) { - // Optional KIND argument. - assert(args.size() >= 1); - auto arg = args[0]; - // Use LLVM floor that returns real. - auto floor = genRuntimeCall("floor", arg.getType(), {arg}); - return builder.createHere(resultType, floor); -} - -// IAND -mlir::Value IntrinsicLibrary::genIAnd(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - - return builder.createHere(args[0], args[1]); -} - -// ICHAR -mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, - llvm::ArrayRef args) { - // There can be an optional kind in second argument. - assert(args.size() >= 1); - - auto arg = args[0]; - Fortran::lower::CharacterExprHelper helper{builder, loc}; - auto dataAndLen = helper.createUnboxChar(arg); - auto charType = fir::CharacterType::get( - builder.getContext(), helper.getCharacterKind(arg.getType())); - auto refType = builder.getRefType(charType); - auto charAddr = builder.createHere(refType, dataAndLen.first); - auto charVal = builder.createHere(charType, charAddr); - return builder.createHere(resultType, charVal); -} - -// IEOR -mlir::Value IntrinsicLibrary::genIEOr(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - - return builder.createHere(args[0], args[1]); -} - -// IOR -mlir::Value IntrinsicLibrary::genIOr(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - - return builder.createHere(args[0], args[1]); -} - -// LEN_TRIM -mlir::Value IntrinsicLibrary::genLenTrim(mlir::Type resultType, - llvm::ArrayRef args) { - // Optional KIND argument reflected in result type. - assert(args.size() >= 1); - Fortran::lower::CharacterExprHelper helper{builder, loc}; - auto len = helper.createLenTrim(args[0]); - return builder.createHere(resultType, len); -} - -// MERGE -mlir::Value IntrinsicLibrary::genMerge(mlir::Type, - llvm::ArrayRef args) { - assert(args.size() == 3); - - auto i1Type = mlir::IntegerType::get(1, builder.getContext()); - auto mask = builder.createHere(i1Type, args[2]); - return builder.createHere(mask, args[0], args[1]); -} - -// MOD -mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - if (resultType.isa()) - return builder.createHere(args[0], args[1]); - - // Use runtime. Note that mlir::RemFOp alos implement floating point - // remainder, but it does not work with fir::Real type. - return genRuntimeCall("mod", resultType, args); -} - -// MOD -mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() >= 1); - // Skip optional kind argument to search the runtime - return genRuntimeCall("nint", resultType, {args[0]}); -} - -// SIGN -mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType, - llvm::ArrayRef args) { - assert(args.size() == 2); - auto abs = genAbs(resultType, {args[0]}); - if (resultType.isa()) { - auto zero = builder.createIntegerConstant(resultType, 0); - auto neg = builder.createHere(zero, abs); - auto cmp = builder.createHere(mlir::CmpIPredicate::slt, - args[1], zero); - return builder.createHere(cmp, neg, abs); - } - // TODO: Requirements when second argument is +0./0. - auto zeroAttr = builder.getZeroAttr(resultType); - auto zero = builder.createHere(resultType, zeroAttr); - auto neg = builder.createHere(abs); - auto cmp = - builder.createHere(mlir::CmpFPredicate::OLT, args[1], zero); - return builder.createHere(cmp, neg, abs); -} - -// Compare two FIR values and return boolean result as i1. -template -static mlir::Value createExtremumCompare(Fortran::lower::FirOpBuilder &builder, - mlir::Value left, mlir::Value right) { - static constexpr auto integerPredicate = extremum == Extremum::Max - ? mlir::CmpIPredicate::sgt - : mlir::CmpIPredicate::slt; - static constexpr auto orderedCmp = extremum == Extremum::Max - ? mlir::CmpFPredicate::OGT - : mlir::CmpFPredicate::OLT; - auto type = left.getType(); - mlir::Value result; - if (type.isa() || type.isa()) { - // Note: the signaling/quit aspect of the result required by IEEE - // cannot currently be obtained with LLVM without ad-hoc runtime. - if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) { - // Return the number if one of the inputs is NaN and the other is - // a number. - auto leftIsResult = - builder.createHere(orderedCmp, left, right); - auto rightIsNan = builder.createHere( - mlir::CmpFPredicate::UNE, right, right); - result = builder.createHere(leftIsResult, rightIsNan); - } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) { - // Always return NaNs if one the input is NaNs - auto leftIsResult = - builder.createHere(orderedCmp, left, right); - auto leftIsNan = - builder.createHere(mlir::CmpFPredicate::UNE, left, left); - result = builder.createHere(leftIsResult, leftIsNan); - } else if constexpr (behavior == ExtremumBehavior::MinMaxss) { - // If the left is a NaN, return the right whatever it is. - result = builder.createHere(orderedCmp, left, right); - } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) { - // If one of the operand is a NaN, return left whatever it is. - static constexpr auto unorderedCmp = extremum == Extremum::Max - ? mlir::CmpFPredicate::UGT - : mlir::CmpFPredicate::ULT; - result = builder.createHere(unorderedCmp, left, right); - } else { - // TODO: ieeeMinNum/ieeeMaxNum - static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum, - "ieeeMinNum/ieeeMaxNum behavior not implemented"); - } - } else if (type.isa() || type.isa()) { - result = builder.createHere(integerPredicate, left, right); - } else if (type.isa()) { - // TODO: ! character min and max is tricky because the result - // length is the length of the longest argument! - // So we may need a temp. - } - assert(result); - return result; -} - -// MIN and MAX -template -mlir::Value IntrinsicLibrary::genExtremum(mlir::Type, - llvm::ArrayRef args) { - assert(args.size() >= 1); - mlir::Value result = args[0]; - for (auto arg : args.drop_front()) { - auto mask = createExtremumCompare(builder, result, arg); - result = builder.createHere(mask, result, arg); - } - return result; -} - -//===----------------------------------------------------------------------===// -// IntrinsicCallOpsBuilder -//===----------------------------------------------------------------------===// - -template -mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genIntrinsicCall( - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args) { - return IntrinsicLibrary{impl(), impl().getLoc()}.genIntrinsicCall( - name, resultType, args); -} -template mlir::Value - Fortran::lower::IntrinsicCallOpsBuilder:: - genIntrinsicCall(llvm::StringRef, mlir::Type, - llvm::ArrayRef); - -template -mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genMax( - llvm::ArrayRef args) { - assert(args.size() > 0 && "max requires at least one argument"); - return IntrinsicLibrary{impl(), impl().getLoc()} - .genExtremum(args[0].getType(), - args); -} -template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder< - Fortran::lower::FirOpBuilder>::genMax(llvm::ArrayRef); - -template -mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genMin( - llvm::ArrayRef args) { - assert(args.size() > 0 && "min requires at least one argument"); - return IntrinsicLibrary{impl(), impl().getLoc()} - .genExtremum(args[0].getType(), - args); -} -template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder< - Fortran::lower::FirOpBuilder>::genMin(llvm::ArrayRef); - -template -mlir::Value Fortran::lower::IntrinsicCallOpsBuilder::genPow(mlir::Type type, - mlir::Value x, - mlir::Value y) { - return IntrinsicLibrary{impl(), impl().getLoc()}.genRuntimeCall("pow", type, - {x, y}); -} -template mlir::Value Fortran::lower::IntrinsicCallOpsBuilder< - Fortran::lower::FirOpBuilder>::genPow(mlir::Type, mlir::Value, mlir::Value); From 97a10aad06368a107e6d43a9b1137f24ca995348 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 4 Jun 2020 18:19:11 -0700 Subject: [PATCH 0084/1017] [refactor] thread the location information properly from the converter through all of the builder. The current location is maintain as a SPOT in the converter. The helper classes are lightweight and ephemeral and often maintain a copy. The FirOpBuilder is long-lived (for the entirety of building a FuncOp) and should not maintain a on-the-side state of the location. These changes will fix all the bugs where location information was coming out incorrectly because of bad cached state. --- flang/lib/Lower/Bridge.cpp | 176 +++++++++++++++++++----------------- flang/lib/Lower/Runtime.cpp | 32 ++++--- 2 files changed, 111 insertions(+), 97 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 56fea1f2f85a3..33a9caff879e4 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -512,7 +512,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(func.getType() == ty); return func; } - return builder->createFunction(name, ty); + return builder->createFunction(toLocation(), name, ty); } /// Lowering of CALL statement @@ -580,6 +580,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Value expr = genExprValue( *Fortran::semantics::GetExpr(std::get(stmt.t))); auto exprType = expr.getType(); + auto loc = toLocation(); if (exprType.isSignlessInteger()) { // Arithmetic expression has Integer type. Generate a SelectCaseOp // with ranges {(-inf:-1], 0=default, [1:inf)}. @@ -588,31 +589,31 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::SmallVector valueList; llvm::SmallVector blockList; attrList.push_back(fir::UpperBoundAttr::get(context)); - valueList.push_back(builder->createIntegerConstant(exprType, -1)); + valueList.push_back(builder->createIntegerConstant(loc, exprType, -1)); blockList.push_back(blockOfLabel(eval, std::get<1>(stmt.t))); attrList.push_back(fir::LowerBoundAttr::get(context)); - valueList.push_back(builder->createIntegerConstant(exprType, 1)); + valueList.push_back(builder->createIntegerConstant(loc, exprType, 1)); blockList.push_back(blockOfLabel(eval, std::get<3>(stmt.t))); attrList.push_back(mlir::UnitAttr::get(context)); // 0 is the "default" blockList.push_back(blockOfLabel(eval, std::get<2>(stmt.t))); - builder->create(toLocation(), expr, attrList, - valueList, blockList); + builder->create(loc, expr, attrList, valueList, + blockList); return; } // Arithmetic expression has Real type. Generate // sum = expr + expr [ raise an exception if expr is a NaN ] // if (sum < 0.0) goto L1 else if (sum > 0.0) goto L3 else goto L2 assert(eval.localBlocks.size() == 1 && "missing arithmetic if block"); - mlir::Value sum = builder->create(toLocation(), expr, expr); + mlir::Value sum = builder->create(loc, expr, expr); mlir::Value zero = builder->create( - toLocation(), exprType, builder->getFloatAttr(exprType, 0.0)); - mlir::Value cond1 = builder->create( - toLocation(), mlir::CmpFPredicate::OLT, sum, zero); + loc, exprType, builder->getFloatAttr(exprType, 0.0)); + mlir::Value cond1 = + builder->create(loc, mlir::CmpFPredicate::OLT, sum, zero); genFIRConditionalBranch(cond1, blockOfLabel(eval, std::get<1>(stmt.t)), eval.localBlocks[0]); startBlock(eval.localBlocks[0]); - mlir::Value cond2 = builder->create( - toLocation(), mlir::CmpFPredicate::OGT, sum, zero); + mlir::Value cond2 = + builder->create(loc, mlir::CmpFPredicate::OGT, sum, zero); genFIRConditionalBranch(cond2, blockOfLabel(eval, std::get<3>(stmt.t)), blockOfLabel(eval, std::get<2>(stmt.t))); } @@ -632,9 +633,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { eval.getOwningProcedure()->assignSymbolLabelMap; const auto &symbol = *std::get(stmt.t).symbol; auto variable = lookupSymbol(symbol); + auto loc = toLocation(); if (!variable) - variable = createTemp(toLocation(), symbol); - auto selectExpr = builder->create(toLocation(), variable); + variable = createTemp(loc, symbol); + auto selectExpr = builder->create(loc, variable); auto iter = symbolLabelMap.find(symbol); if (iter == symbolLabelMap.end()) { // Fail for a nonconforming program unit that does not have any ASSIGN @@ -672,8 +674,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Add a nop/fallthrough branch to the switch for a nonconforming program // unit that violates the program requirement above. blockList.push_back(eval.lexicalSuccessor->block); // default - builder->create(toLocation(), selectExpr, indexList, - blockList); + builder->create(loc, selectExpr, indexList, blockList); } /// Generate FIR for a DO construct. There are six variants: @@ -744,58 +745,58 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// Generate FIR to begin a structured or unstructured increment loop. void genFIRIncrementLoopBegin(IncrementLoopInfo &info) { - auto location = toLocation(); + auto loc = toLocation(); mlir::Type type = info.isStructured() ? builder->getIndexType() : info.loopVariableType; auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); auto upperValue = genFIRLoopIndex(info.upperExpr, type); - info.stepValue = - info.stepExpr.has_value() ? genFIRLoopIndex(*info.stepExpr, type) - : info.isStructured() - ? builder->create(location, 1) - : builder->createIntegerConstant(info.loopVariableType, 1); + info.stepValue = info.stepExpr.has_value() + ? genFIRLoopIndex(*info.stepExpr, type) + : info.isStructured() + ? builder->create(loc, 1) + : builder->createIntegerConstant( + loc, info.loopVariableType, 1); assert(info.stepValue && "step value must be set"); - info.loopVariable = createTemp(location, *info.loopVariableSym); + info.loopVariable = createTemp(loc, *info.loopVariableSym); // Structured loop - generate fir.loop. if (info.isStructured()) { info.insertionPoint = builder->saveInsertionPoint(); - info.doLoop = builder->create(location, lowerValue, - upperValue, info.stepValue); + info.doLoop = builder->create(loc, lowerValue, upperValue, + info.stepValue); builder->setInsertionPointToStart(info.doLoop.getBody()); // Always store iteration ssa-value to the LCV to avoid missing any // aliasing of the LCV. - auto lcv = builder->createConvert(location, info.loopVariableType, + auto lcv = builder->createConvert(loc, info.loopVariableType, info.doLoop.getInductionVar()); - builder->create(location, lcv, info.loopVariable); + builder->create(loc, lcv, info.loopVariable); return; } // Unstructured loop preheader code - initialize tripVariable, loopVariable. - auto distance = - builder->create(location, upperValue, lowerValue); + auto distance = builder->create(loc, upperValue, lowerValue); auto adjusted = - builder->create(location, distance, info.stepValue); + builder->create(loc, distance, info.stepValue); auto tripCount = - builder->create(location, adjusted, info.stepValue); - info.tripVariable = - builder->createTemporary(location, info.loopVariableType); - builder->create(location, tripCount, info.tripVariable); - builder->create(location, lowerValue, info.loopVariable); + builder->create(loc, adjusted, info.stepValue); + info.tripVariable = builder->createTemporary(loc, info.loopVariableType); + builder->create(loc, tripCount, info.tripVariable); + builder->create(loc, lowerValue, info.loopVariable); // Unstructured loop header code - generate loop condition. startBlock(info.headerBlock); mlir::Value tripVariable = - builder->create(location, info.tripVariable); - mlir::Value zero = builder->createIntegerConstant(info.loopVariableType, 0); + builder->create(loc, info.tripVariable); + mlir::Value zero = + builder->createIntegerConstant(loc, info.loopVariableType, 0); mlir::Value cond = builder->create( - location, mlir::CmpIPredicate::sgt, tripVariable, zero); + loc, mlir::CmpIPredicate::sgt, tripVariable, zero); genFIRConditionalBranch(cond, info.bodyBlock, info.successorBlock); } /// Generate FIR to end a structured or unstructured increment loop. void genFIRIncrementLoopEnd(IncrementLoopInfo &info) { - mlir::Location location = toLocation(); + auto loc = toLocation(); if (info.isStructured()) { // End fir.loop. builder->restoreInsertionPoint(info.insertionPoint); @@ -804,18 +805,18 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Unstructured loop - increment loopVariable. mlir::Value loopVariable = - builder->create(location, info.loopVariable); + builder->create(loc, info.loopVariable); loopVariable = - builder->create(location, loopVariable, info.stepValue); - builder->create(location, loopVariable, info.loopVariable); + builder->create(loc, loopVariable, info.stepValue); + builder->create(loc, loopVariable, info.loopVariable); // Unstructured loop - decrement tripVariable. mlir::Value tripVariable = - builder->create(location, info.tripVariable); + builder->create(loc, info.tripVariable); mlir::Value one = builder->create( - location, builder->getIntegerAttr(info.loopVariableType, 1)); - tripVariable = builder->create(location, tripVariable, one); - builder->create(location, tripVariable, info.tripVariable); + loc, builder->getIntegerAttr(info.loopVariableType, 1)); + tripVariable = builder->create(loc, tripVariable, one); + builder->create(loc, tripVariable, info.tripVariable); genBranch(info.headerBlock); } @@ -945,12 +946,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::SmallVector blockList; auto *defaultBlock = eval.parentConstruct->constructExit->block; using CaseValue = Fortran::parser::Scalar; + auto loc = toLocation(); auto addValue = [&](const CaseValue &caseValue) { const auto *expr = Fortran::semantics::GetExpr(caseValue.thing); const auto v = Fortran::evaluate::ToInt64(*expr); - valueList.push_back(v ? builder->createIntegerConstant(selectType, *v) - : builder->createConvert(toLocation(), selectType, - genExprValue(*expr))); + valueList.push_back( + v ? builder->createIntegerConstant(loc, selectType, *v) + : builder->createConvert(loc, selectType, genExprValue(*expr))); }; for (Fortran::lower::pft::Evaluation *e = eval.controlSuccessor; e; e = e->controlSuccessor) { @@ -1105,8 +1107,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (!endBlock && !eorBlock && !errBlock) return; + auto loc = toLocation(); auto indexType = builder->getIndexType(); - auto selector = builder->createHere(indexType, iostat); + auto selector = builder->createConvert(loc, indexType, iostat); llvm::SmallVector indexList; llvm::SmallVector blockList; if (eorBlock) { @@ -1126,7 +1129,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Fallthrough successor statement is the default successor. blockList.push_back(eval.lexicalSuccessor->block); } - builder->createHere(selector, indexList, blockList); + builder->create(loc, selector, indexList, blockList); } //===--------------------------------------------------------------------===// @@ -1142,18 +1145,19 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// For each pointer object, reset the pointer to a disassociated status. /// We do this by setting each pointer to null. void genFIR(const Fortran::parser::NullifyStmt &stmt) { + auto loc = toLocation(); for (auto &po : stmt.v) { std::visit( Fortran::common::visitors{ [&](const Fortran::parser::Name &sym) { auto ty = genType(*sym.symbol); auto load = builder->create( - toLocation(), lookupSymbol(*sym.symbol)); + loc, lookupSymbol(*sym.symbol)); auto idxTy = builder->getIndexType(); auto zero = builder->create( - toLocation(), idxTy, builder->getIntegerAttr(idxTy, 0)); - auto cast = builder->createConvert(toLocation(), ty, zero); - builder->create(toLocation(), cast, load); + loc, idxTy, builder->getIntegerAttr(idxTy, 0)); + auto cast = builder->createConvert(loc, ty, zero); + builder->create(loc, cast, load); }, [&](const Fortran::parser::StructureComponent &) { TODO(); }, }, @@ -1185,11 +1189,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { fir::LoopOp createLoopNest(llvm::SmallVectorImpl &lcvs, const Fortran::evaluate::Shape &shape) { - llvm::SmallVector extents; - auto idxTy = builder->getIndexType(); - auto zero = builder->createIntegerConstant(idxTy, 0); - auto one = builder->createIntegerConstant(idxTy, 1); auto loc = toLocation(); + auto idxTy = builder->getIndexType(); + auto zero = builder->createIntegerConstant(loc, idxTy, 0); + auto one = builder->createIntegerConstant(loc, idxTy, 1); + llvm::SmallVector extents; + for (auto s : shape) { if (s.has_value()) { auto ub = builder->createConvert( @@ -1385,11 +1390,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::AssignStmt &stmt) { const auto &symbol = *std::get(stmt.t).symbol; auto variable = lookupSymbol(symbol); + auto loc = toLocation(); if (!variable) - variable = createTemp(toLocation(), symbol); + variable = createTemp(loc, symbol); const auto labelValue = builder->createIntegerConstant( - genType(symbol), std::get(stmt.t)); - builder->create(toLocation(), labelValue, variable); + loc, genType(symbol), std::get(stmt.t)); + builder->create(loc, labelValue, variable); } void genFIR(const Fortran::parser::FormatStmt &) { @@ -1436,13 +1442,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { genExitRoutine(); return; } + auto loc = toLocation(); if (stmt.v) { // Alternate return statement -- assign alternate return index. auto expr = Fortran::semantics::GetExpr(*stmt.v); assert(expr && "missing alternate return expression"); - auto altReturnIndex = builder->createConvert( - toLocation(), builder->getIndexType(), genExprValue(*expr)); - builder->create(toLocation(), altReturnIndex, + auto altReturnIndex = builder->createConvert(loc, builder->getIndexType(), + genExprValue(*expr)); + builder->create(loc, altReturnIndex, getAltReturnResult(*funit)); } // Branch to the last block of the SUBROUTINE, which has the actual return. @@ -1451,7 +1458,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { funit->finalBlock = builder->createBlock(&builder->getRegion()); builder->restoreInsertionPoint(insPt); } - builder->create(toLocation(), funit->finalBlock); + builder->create(loc, funit->finalBlock); } void genFIR(const Fortran::parser::CycleStmt &) { @@ -1505,6 +1512,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { std::string globalName = mangleName(sym); fir::GlobalOp global; bool isConst = sym.attrs().test(Fortran::semantics::Attr::PARAMETER); + auto loc = toLocation(); if (builder->getNamedGlobal(globalName)) return; if (const auto *details = @@ -1514,7 +1522,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { TODO(); // Derived type / polymorphic } auto symTy = genType(var); - auto loc = toLocation(); global = builder->createGlobal( loc, symTy, globalName, isConst, [&](Fortran::lower::FirOpBuilder &builder) { @@ -1523,10 +1530,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder.create(loc, castTo); }); } else { - global = builder->createGlobal(toLocation(), genType(var), globalName); + global = builder->createGlobal(loc, genType(var), globalName); } - auto addrOf = builder->create( - toLocation(), global.resultType(), global.getSymbol()); + auto addrOf = builder->create(loc, global.resultType(), + global.getSymbol()); SymbolBoxAnalyzer sia(sym); sia.analyze(); if (sia.isTrivial()) { @@ -1538,17 +1545,17 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (sia.isChar) { auto c = sia.getCharLenConst(); assert(c.hasValue()); - len = builder->createIntegerConstant(idxTy, *c); + len = builder->createIntegerConstant(loc, idxTy, *c); } llvm::SmallVector extents; llvm::SmallVector lbounds; if (sia.isArray) { assert(sia.staticSize); for (auto i : sia.staticShape) - extents.push_back(builder->createIntegerConstant(idxTy, i)); + extents.push_back(builder->createIntegerConstant(loc, idxTy, i)); if (!sia.lboundIsAllOnes()) for (auto i : sia.staticLBound) - lbounds.push_back(builder->createIntegerConstant(idxTy, i)); + lbounds.push_back(builder->createIntegerConstant(loc, idxTy, i)); } if (sia.isChar && sia.isArray) { localSymbols.addCharSymbolWithBounds(sym, addrOf, len, extents, @@ -1586,7 +1593,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto local = builder->allocateLocal(loc, ty, nm, shape, var.isTarget()); // Set local pointer/allocatable to null. if (var.isHeapAlloc() || var.isPointer()) { - auto zero = builder->createIntegerConstant(builder->getIndexType(), 0); + auto zero = + builder->createIntegerConstant(loc, builder->getIndexType(), 0); auto null = builder->createConvert(loc, ty, zero); builder->create(loc, null, local); } @@ -1594,12 +1602,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { } /// Instantiate a local variable. Precondition: Each variable will be visited - /// such that if it depends on other variables, the variables upon which it - /// depends will already have been visited. + /// such that if it's properties depend on other variables, the variables upon + /// which its properties depend will already have been visited. void instantiateLocal(const Fortran::lower::pft::Variable &var) { const auto &sym = var.getSymbol(); const auto loc = genLocation(sym.name()); - builder->setLocation(loc); auto idxTy = builder->getIndexType(); const auto isDummy = Fortran::semantics::IsDummy(sym); const auto isResult = Fortran::semantics::IsFunctionResult(sym); @@ -1658,7 +1665,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } else { // local CHARACTER variable if (auto c = sia.getCharLenConst()) { - len = builder->createIntegerConstant(idxTy, *c); + len = builder->createIntegerConstant(loc, idxTy, *c); } else { auto e = sia.getCharLenExpr(); assert(e && "CHARACTER variable must have LEN parameter"); @@ -1683,7 +1690,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // if lower bounds are all ones, build simple shaped object llvm::SmallVector shape; for (auto i : sia.staticShape) - shape.push_back(builder->createIntegerConstant(idxTy, i)); + shape.push_back(builder->createIntegerConstant(loc, idxTy, i)); if (sia.isChar) { if (isDummy || isResult) { localSymbols.addCharSymbolWithShape(sym, addr, len, shape, true); @@ -1717,8 +1724,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // construct constants and populate `bounds` for (const auto &i : llvm::zip(sia.staticLBound, sia.staticShape)) { - auto fst = builder->createIntegerConstant(idxTy, std::get<0>(i)); - auto snd = builder->createIntegerConstant(idxTy, std::get<1>(i)); + auto fst = builder->createIntegerConstant(loc, idxTy, std::get<0>(i)); + auto snd = builder->createIntegerConstant(loc, idxTy, std::get<1>(i)); lbounds.emplace_back(fst); extents.emplace_back(snd); } @@ -1733,7 +1740,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto ub = genExprValue(Fortran::semantics::SomeExpr{*high}); auto ty = ub.getType(); auto diff = builder->create(loc, ty, ub, lb); - auto one = builder->createIntegerConstant(ty, 1); + auto one = builder->createIntegerConstant(loc, ty, 1); auto sz = builder->create(loc, ty, diff, one); auto idx = builder->createConvert(loc, idxTy, sz); lbounds.emplace_back(lb); @@ -1851,12 +1858,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Attach it to the subroutine symbol in the localSymbols map. // Initialize it to zero, the "fallthrough" alternate return value. const auto &symbol = funit.getSubprogramSymbol(); + auto loc = toLocation(); const auto altResult = builder->createTemporary( - toLocation(), builder->getIndexType(), symbol.name().ToString()); + loc, builder->getIndexType(), symbol.name().ToString()); addSymbol(symbol, altResult); const auto zero = - builder->createIntegerConstant(builder->getIndexType(), 0); - builder->create(toLocation(), zero, altResult); + builder->createIntegerConstant(loc, builder->getIndexType(), 0); + builder->create(loc, zero, altResult); } } diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index a1dc0df6eea19..e3d08d0d8fad2 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -20,29 +20,34 @@ using Fortran::lower::operator""_rt_ident; #define MakeRuntimeEntry(X) mkKey(RTNAME(X)) template -static mlir::FuncOp genRuntimeFunction(Fortran::lower::FirOpBuilder &builder) { +static mlir::FuncOp genRuntimeFunction(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder) { auto func = builder.getNamedFunction(RuntimeEntry::name); if (func) return func; auto funTy = RuntimeEntry::getTypeModel()(builder.getContext()); - func = builder.createFunction(RuntimeEntry::name, funTy); + func = builder.createFunction(loc, RuntimeEntry::name, funTy); func.setAttr("fir.runtime", builder.getUnitAttr()); return func; } static mlir::FuncOp -genStopStatementRuntime(Fortran::lower::FirOpBuilder &builder) { - return genRuntimeFunction(builder); +genStopStatementRuntime(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder) { + return genRuntimeFunction(loc, builder); } static mlir::FuncOp -genStopStatementTextRuntime(Fortran::lower::FirOpBuilder &builder) { - return genRuntimeFunction(builder); +genStopStatementTextRuntime(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder) { + return genRuntimeFunction(loc, builder); } static mlir::FuncOp -genProgramEndStatementRuntime(Fortran::lower::FirOpBuilder &builder) { - return genRuntimeFunction(builder); +genProgramEndStatementRuntime(mlir::Location loc, + Fortran::lower::FirOpBuilder &builder) { + return genRuntimeFunction(loc, + builder); } // TODO: We don't have runtime library support for various features. When they @@ -62,7 +67,7 @@ void Fortran::lower::genStopStatement( const Fortran::parser::StopStmt &stmt) { auto &builder = converter.getFirOpBuilder(); auto loc = converter.getCurrentLocation(); - auto callee = genStopStatementRuntime(builder); + auto callee = genStopStatementRuntime(loc, builder); auto calleeType = callee.getType(); llvm::SmallVector operands; assert(calleeType.getNumInputs() == 3 && @@ -75,13 +80,13 @@ void Fortran::lower::genStopStatement( operands.push_back(converter.genExprValue(*expr)); } else { operands.push_back( - builder.createIntegerConstant(calleeType.getInput(0), 0)); + builder.createIntegerConstant(loc, calleeType.getInput(0), 0)); } // Second operand indicates ERROR STOP bool isError = std::get(stmt.t) == Fortran::parser::StopStmt::Kind::ErrorStop; operands.push_back( - builder.createIntegerConstant(calleeType.getInput(1), isError)); + builder.createIntegerConstant(loc, calleeType.getInput(1), isError)); // Third operand indicates QUIET (default to false). if (const auto &quiet = @@ -91,7 +96,7 @@ void Fortran::lower::genStopStatement( operands.push_back(converter.genExprValue(*expr)); } else { operands.push_back( - builder.createIntegerConstant(calleeType.getInput(2), 0)); + builder.createIntegerConstant(loc, calleeType.getInput(2), 0)); } // Cast operands in case they have different integer/logical types @@ -108,7 +113,8 @@ void Fortran::lower::genFailImageStatement( Fortran::lower::AbstractConverter &converter) { auto &bldr = converter.getFirOpBuilder(); auto loc = converter.getCurrentLocation(); - auto callee = genRuntimeFunction(bldr); + auto callee = + genRuntimeFunction(loc, bldr); bldr.create(loc, callee, llvm::None); } From 7fde8140d4ddc6325f8e77ba63cf92c459fbac14 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 4 Jun 2020 09:19:43 -0700 Subject: [PATCH 0085/1017] Add hard TODO in lowering for equivalences/stmt functions/common blocks Common blocks,equivalences, and statement functions are knwon TODOs, but the previous behaviour was to ignore and compile (leading to link/runtime errors). This patch catch these unhandled situations in lowering and crash at compile time with error messages. Lowering ANINT and AINT Lower DIM intrinsic Fix call site mangling of external procedures This addresses issue 138 of f18-llvm-project: - Symbol with ProcEntityDetails are always external procedures unless they are procedure pointers/dummy arguments. Add a check for pointers dummy and remove the IsExternal check that is only answering true if the procedure appeared in an explicit EXTERNAL statement. On top of issue 138: - Another issue was that when an external program is defined inside an interface, then the related Symbol has SubprogramDetails, so isExternal must be checked in this case. See bar3 in added tests for an example of what was failing. - Looking at ProcEntityDetails more closely, I understand that the related interface symbol has nothing to do with the actual definition, so remove this from the logic looking for the callee definition source location. --- flang/lib/Lower/Bridge.cpp | 5 +++ flang/lib/Lower/CallInterface.cpp | 13 +++----- flang/test/Lower/call-site-mangling.f90 | 43 ++++++++++++++++++++----- flang/test/Lower/implicit-interface.f90 | 3 +- flang/test/Lower/intrinsics.f90 | 42 ++++++++++++++++++++++++ 5 files changed, 87 insertions(+), 19 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 33a9caff879e4..907653a3cf909 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1805,6 +1805,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void instantiateVar(const Fortran::lower::pft::Variable &var) { + if (Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) { + mlir::emitError(toLocation(), + "Common blocks not yet handled in lowering"); + exit(1); + } if (var.isGlobal()) instantiateGlobal(var); else diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index c00c0797d2f17..87b3974a75cce 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -36,16 +36,11 @@ std::string Fortran::lower::CallerInterface::getMangledName() const { mlir::Location Fortran::lower::CallerInterface::getCalleeLocation() const { const auto &proc = procRef.proc(); - if (const auto *symbol = proc.GetSymbol()) { - // FIXME: If the callee is defined in the same file but after the current - // unit we do cannot get its location here and the funcOp is created at the - // wrong location (i.e, the caller location). - if (const auto *details = - symbol->detailsIf()) - if (const auto *interfaceSymbol = details->interface().symbol()) - symbol = interfaceSymbol; + // FIXME: If the callee is defined in the same file but after the current + // unit we do cannot get its location here and the funcOp is created at the + // wrong location (i.e, the caller location). + if (const auto *symbol = proc.GetSymbol()) return converter.genLocation(symbol->name()); - } // Unknown location for intrinsics. return converter.genLocation(); } diff --git a/flang/test/Lower/call-site-mangling.f90 b/flang/test/Lower/call-site-mangling.f90 index 29c34568e1e37..5320ef96d113d 100644 --- a/flang/test/Lower/call-site-mangling.f90 +++ b/flang/test/Lower/call-site-mangling.f90 @@ -2,9 +2,9 @@ subroutine sub() real :: x - ! CHECK-LABEL: fir.call @_QPasubroutine() + ! CHECK: fir.call @_QPasubroutine() call AsUbRoUtInE(); - ! CHECK-LABEL: fir.call @_QPfoo() + ! CHECK: fir.call @_QPfoo() x = foo() end subroutine @@ -20,18 +20,18 @@ function foo() subroutine sub1() use testMod real :: x - ! CHECK-LABEL: fir.call @_QMtestmodPsub() + ! CHECK: fir.call @_QMtestmodPsub() call Sub(); - ! CHECK-LABEL: fir.call @_QMtestmodPfoo() + ! CHECK: fir.call @_QMtestmodPfoo() x = foo() end subroutine subroutine sub2() use testMod, localfoo => foo, localsub => sub real :: x - ! CHECK-LABEL: fir.call @_QMtestmodPsub() + ! CHECK: fir.call @_QMtestmodPsub() call localsub(); - ! CHECK-LABEL: fir.call @_QMtestmodPfoo() + ! CHECK: fir.call @_QMtestmodPfoo() x = localfoo() end subroutine @@ -39,9 +39,9 @@ subroutine sub2() subroutine sub3() real :: x - ! CHECK-LABEL: fir.call @_QFsub3Psub() + ! CHECK: fir.call @_QFsub3Psub() call sub(); - ! CHECK-LABEL: fir.call @_QFsub3Pfoo() + ! CHECK: fir.call @_QFsub3Pfoo() x = foo() contains subroutine sub() @@ -50,3 +50,30 @@ subroutine sub() function foo() end function end subroutine + +function foo1() + real :: bar1 + ! CHECK: fir.call @_QPbar1() + foo1 = bar1() +end function + +function foo2() + ! CHECK: fir.call @_QPbar2() + foo2 = bar2() +end function + +function foo3() + interface + real function bar3() + end function + end interface + ! CHECK: fir.call @_QPbar3() + foo3 = bar3() +end function + +function foo4() + external :: bar4 + ! CHECK: fir.call @_QPbar4() + foo4 = bar4() +end function + diff --git a/flang/test/Lower/implicit-interface.f90 b/flang/test/Lower/implicit-interface.f90 index cf32ac8badd95..3cfb6301ee7fa 100644 --- a/flang/test/Lower/implicit-interface.f90 +++ b/flang/test/Lower/implicit-interface.f90 @@ -6,8 +6,7 @@ function char_return_callee(i) integer :: i end function -! FIXME: the mangling is incorrect. -! CHECK-LABEL: func @_QFtest_char_return_callerPchar_return_caller(!fir.ref>, index, !fir.ref) -> !fir.boxchar<1> +! CHECK-LABEL: func @_QPchar_return_caller(!fir.ref>, index, !fir.ref) -> !fir.boxchar<1> subroutine test_char_return_caller character(10) :: char_return_caller print *, char_return_caller(5) diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index 4cfede5158772..e5f703e7eb760 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -36,6 +36,22 @@ subroutine aimag_test(a, b) b = aimag(a) end subroutine +! AINT +! CHECK-LABEL: aint_test +subroutine aint_test(a, b) + real :: a, b + ! CHECK: call @llvm.trunc.f32 + b = aint(a) +end subroutine + +! ANINT +! CHECK-LABEL: anint_test +subroutine anint_test(a, b) + real :: a, b + ! CHECK: call @llvm.round.f32 + b = anint(a) +end subroutine + ! DBLE ! CHECK-LABEL: dble_test subroutine dble_test(a) @@ -44,6 +60,32 @@ subroutine dble_test(a) print *, dble(a) end subroutine +! DIM +! CHECK-LABEL: dim_testr +subroutine dim_testr(x, y, z) + real :: x, y, z + ! CHECK-DAG: %[[x:.*]] = fir.load %arg0 + ! CHECK-DAG: %[[y:.*]] = fir.load %arg1 + ! CHECK-DAG: %[[zero:.*]] = constant 0.0 + ! CHECK-DAG: %[[diff:.*]] = fir.subf %[[x]], %[[y]] + ! CHECK: %[[cmp:.*]] = fir.cmpf "ogt", %[[diff]], %[[zero]] + ! CHECK: %[[res:.*]] = select %[[cmp]], %[[diff]], %[[zero]] + ! CHECK: fir.store %[[res]] to %arg2 + z = dim(x, y) +end subroutine +! CHECK-LABEL: dim_testi +subroutine dim_testi(i, j, k) + integer :: i, j, k + ! CHECK-DAG: %[[i:.*]] = fir.load %arg0 + ! CHECK-DAG: %[[j:.*]] = fir.load %arg1 + ! CHECK-DAG: %[[zero:.*]] = constant 0 + ! CHECK-DAG: %[[diff:.*]] = subi %[[i]], %[[j]] + ! CHECK: %[[cmp:.*]] = cmpi "sgt", %[[diff]], %[[zero]] + ! CHECK: %[[res:.*]] = select %[[cmp]], %[[diff]], %[[zero]] + ! CHECK: fir.store %[[res]] to %arg2 + k = dim(i, j) +end subroutine + ! CEILING ! CHECK-LABEL: ceiling_test1 subroutine ceiling_test1(i, a) From cb83ddf417caf419cfaf4b0226a5f3fc1f30ddde Mon Sep 17 00:00:00 2001 From: V Donaldson Date: Thu, 4 Jun 2020 15:43:54 -0700 Subject: [PATCH 0086/1017] Relax requirements for assigned goto generation #134 Add some tests --- flang/lib/Lower/Bridge.cpp | 5 +--- flang/test/Lower/arithmetic-goto.f90 | 40 ++++++++++++++++++++++++++++ flang/test/Lower/assigned-goto.f90 | 35 ++++++++++++++++++++++++ flang/test/Lower/computed-goto.f90 | 18 +++++++++++++ 4 files changed, 94 insertions(+), 4 deletions(-) create mode 100644 flang/test/Lower/arithmetic-goto.f90 create mode 100644 flang/test/Lower/assigned-goto.f90 create mode 100644 flang/test/Lower/computed-goto.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 907653a3cf909..5a2e75889edc7 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -654,10 +654,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Add labels from an explicit list. The list may have duplicates. for (auto &label : std::get>(stmt.t)) { if (labelSet.count(label) == 0) { - // Fail for a nonconforming program unit that never ASSIGNs this label - // to the selector variable. The front end should check that there is - // at least one such ASSIGN statement. - llvm_unreachable("invalid assigned goto target"); + // Ignore labels with no ASSIGN statements for the selector variable. continue; } if (std::find(indexList.begin(), indexList.end(), label) == diff --git a/flang/test/Lower/arithmetic-goto.f90 b/flang/test/Lower/arithmetic-goto.f90 new file mode 100644 index 0000000000000..0bddf3635e7db --- /dev/null +++ b/flang/test/Lower/arithmetic-goto.f90 @@ -0,0 +1,40 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +! CHECK-LABEL: func @_QPkagi +function kagi(index) + ! CHECK: fir.select_case %{{.}} : i32 [#fir.upper, %c-1_i32, ^bb{{.}}, #fir.lower, %c1_i32, ^bb{{.}}, unit, ^bb{{.}}] + if (index) 7, 8, 9 + kagi = 0; return +7 kagi = 1; return +8 kagi = 2; return +9 kagi = 3; return +end + +! CHECK-LABEL: func @_QPkagf +function kagf(findex) + ! CHECK: [[zero:%.+]] = constant 0 + ! CHECK: %{{.}} = cmpf "olt", %{{.}}, [[zero]] : f32 + ! CHECK: cond_br % + ! CHECK: %{{.}} = cmpf "ogt", %{{.}}, [[zero]] : f32 + ! CHECK: cond_br % + ! CHECK: br ^ + if (findex+findex) 7, 8, 9 + kagf = 0; return +7 kagf = 1; return +8 kagf = 2; return +9 kagf = 3; return +end + +! CHECK-LABEL: func @_QQmain + do i = -2, 2 + print*, kagi(i) + enddo + + print*, kagf(-2.0) + print*, kagf(-1.0) + print*, kagf(-0.0) + print*, kagf( 0.0) + print*, kagf(+0.0) + print*, kagf(+1.0) + print*, kagf(+2.0) +end diff --git a/flang/test/Lower/assigned-goto.f90 b/flang/test/Lower/assigned-goto.f90 new file mode 100644 index 0000000000000..516d3e4f5a7b7 --- /dev/null +++ b/flang/test/Lower/assigned-goto.f90 @@ -0,0 +1,35 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + + ! CHECK-LABEL: func @_QPnolist + subroutine nolist + integer L, V + 11 V = 1 + ! CHECK: fir.store %c31{{.*}} to %{{.}} + assign 31 to L + ! CHECK: fir.select %{{.}} : i32 [31, ^bb{{.}}, unit, ^bb{{.}}] + goto L ! no list + 21 V = 2 + go to 41 + 31 V = 3 + 41 print*, 3, V + end + + ! CHECK-LABEL: func @_QPlist + subroutine list + integer L, V + ! CHECK: fir.store %c22{{.*}} to %{{.}} + assign 22 to L + 12 V = 100 + ! CHECK: fir.store %c32{{.*}} to %{{.}} + assign 32 to L + ! CHECK: fir.select %{{.}} : i32 [32, ^bb{{.}}, 22, ^bb{{.}}, unit, ^bb{{.}}] + goto L (42, 32, 22, 32, 32) ! duplicate labels are allowed + 22 V = 200 + go to 42 + 32 V = 300 + 42 print*, 300, V + end + + call nolist + call list + end diff --git a/flang/test/Lower/computed-goto.f90 b/flang/test/Lower/computed-goto.f90 new file mode 100644 index 0000000000000..49640390b6974 --- /dev/null +++ b/flang/test/Lower/computed-goto.f90 @@ -0,0 +1,18 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +! CHECK-LABEL: func @_QPm +function m(index) + ! CHECK: fir.select %{{.}} : i32 [1, ^bb{{.}}, 2, ^bb{{.}}, 3, ^bb{{.}}, 4, ^bb{{.}}, 5, ^bb{{.}}, unit, ^bb{{.}}] + goto (9,7,5,3,1) index ! + 1 + m = 0; return +1 m = 1; return +3 m = 3; return +5 m = 5; return +7 m = 7; return +9 m = 9; return +end + +! print*, m(-3); print*, m(0) +! print*, m(1); print*, m(2); print*, m(3); print*, m(4); print*, m(5) +! print*, m(6); print*, m(9) +end From b3db67ecf1b61038b04c024ec5a02d0155fa5ef3 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 5 Jun 2020 12:16:42 -0700 Subject: [PATCH 0087/1017] [TODO] cherry-pick a few TODOs to output hints and exit immediately --- flang/lib/Lower/Bridge.cpp | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 5a2e75889edc7..76232f320c129 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -221,7 +221,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::common::visitors{ [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); }, [&](Fortran::lower::pft::ModuleLikeUnit &m) { lowerMod(m); }, - [&](Fortran::lower::pft::BlockDataUnit &) { TODO(); }, + [&](Fortran::lower::pft::BlockDataUnit &) { + mlir::emitError(toLocation(), "BLOCK DATA not handled"); + exit(1); + }, }, u); } @@ -641,8 +644,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (iter == symbolLabelMap.end()) { // Fail for a nonconforming program unit that does not have any ASSIGN // statements. The front end should check for this. - llvm_unreachable("no assigned goto targets"); - return; + mlir::emitError(loc, "(semantics issue) no assigned goto targets"); + exit(1); } auto labelSet = iter->second; llvm::SmallVector indexList; From af08a33ef48ef7fb6d36a3472ac8725472a741ba Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 8 Jun 2020 12:35:48 -0700 Subject: [PATCH 0088/1017] [refactor] split out some of the image related lowering into its own file --- flang/include/flang/Lower/Image.h | 83 +++++++++++++++++++++++++++++++ flang/lib/Lower/Bridge.cpp | 17 +++++-- flang/lib/Lower/CMakeLists.txt | 1 + flang/lib/Lower/Image.cpp | 77 ++++++++++++++++++++++++++++ flang/lib/Lower/Runtime.cpp | 7 --- 5 files changed, 173 insertions(+), 12 deletions(-) create mode 100644 flang/include/flang/Lower/Image.h create mode 100644 flang/lib/Lower/Image.cpp diff --git a/flang/include/flang/Lower/Image.h b/flang/include/flang/Lower/Image.h new file mode 100644 index 0000000000000..76c748db621b4 --- /dev/null +++ b/flang/include/flang/Lower/Image.h @@ -0,0 +1,83 @@ +//===-- Lower/Image.h -- image related lowering -----------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Builder routines for constructing the FIR dialect of MLIR. As FIR is a +// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding +// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this +// module. +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_IMAGE_H +#define FORTRAN_LOWER_IMAGE_H + +#include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/Support/BoxValue.h" + +namespace Fortran { + +namespace parser { +struct ChangeTeamConstruct; +struct ChangeTeamStmt; +struct EndChangeTeamStmt; +struct FormTeamStmt; +} // namespace parser + +namespace evaluate { +class CoarrayRef; +} // namespace evaluate + +namespace lower { +class SymMap; +namespace pft { +struct Evaluation; +} // namespace pft + +//===----------------------------------------------------------------------===// +// TEAM constructs +//===----------------------------------------------------------------------===// + +void genChangeTeamConstruct(AbstractConverter &, pft::Evaluation &eval, + const parser::ChangeTeamConstruct &); +void genChangeTeamStmt(AbstractConverter &, pft::Evaluation &eval, + const parser::ChangeTeamStmt &); +void genEndChangeTeamStmt(AbstractConverter &, pft::Evaluation &eval, + const parser::EndChangeTeamStmt &); +void genFormTeamStatement(AbstractConverter &, pft::Evaluation &eval, + const parser::FormTeamStmt &); + +//===----------------------------------------------------------------------===// +// COARRAY expressions +//===----------------------------------------------------------------------===// + +/// Coarray expression lowering helper. A coarray expression is expected to be +/// lowered into runtime support calls. For example, expressions may use a +/// message-passing runtime to access another image's data. +class CoarrayExprHelper { +public: + explicit CoarrayExprHelper(AbstractConverter &converter, mlir::Location loc, + SymMap &syms) + : converter{converter}, symMap{syms}, loc{loc} {} + CoarrayExprHelper(const CoarrayExprHelper &) = delete; + + /// Generate the address of a co-array expression. + ExValue genAddr(const evaluate::CoarrayRef &expr); + + /// Generate the value of a co-array expression. + ExValue genValue(const evaluate::CoarrayRef &expr); + +private: + AbstractConverter &converter; + SymMap &symMap; + mlir::Location loc; +}; + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_IMAGE_H diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 76232f320c129..633486ccce69d 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -15,6 +15,7 @@ #include "flang/Lower/ConvertType.h" #include "flang/Lower/FIRBuilder.h" #include "flang/Lower/IO.h" +#include "flang/Lower/Image.h" #include "flang/Lower/Mangler.h" #include "flang/Lower/OpenMP.h" #include "flang/Lower/PFTBuilder.h" @@ -221,7 +222,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::common::visitors{ [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); }, [&](Fortran::lower::pft::ModuleLikeUnit &m) { lowerMod(m); }, - [&](Fortran::lower::pft::BlockDataUnit &) { + [&](Fortran::lower::pft::BlockDataUnit &) { mlir::emitError(toLocation(), "BLOCK DATA not handled"); exit(1); }, @@ -1012,9 +1013,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::BlockStmt &) { TODO(); } void genFIR(const Fortran::parser::EndBlockStmt &) { TODO(); } - void genFIR(const Fortran::parser::ChangeTeamConstruct &) { TODO(); } - void genFIR(const Fortran::parser::ChangeTeamStmt &) { TODO(); } - void genFIR(const Fortran::parser::EndChangeTeamStmt &) { TODO(); } + void genFIR(const Fortran::parser::ChangeTeamConstruct &construct) { + genChangeTeamConstruct(*this, getEval(), construct); + } + void genFIR(const Fortran::parser::ChangeTeamStmt &stmt) { + genChangeTeamStmt(*this, getEval(), stmt); + } + void genFIR(const Fortran::parser::EndChangeTeamStmt &stmt) { + genEndChangeTeamStmt(*this, getEval(), stmt); + } void genFIR(const Fortran::parser::CriticalConstruct &) { TODO(); } void genFIR(const Fortran::parser::CriticalStmt &) { TODO(); } @@ -1180,7 +1187,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(const Fortran::parser::FormTeamStmt &stmt) { - genFormTeamStatement(*this, stmt); + genFormTeamStatement(*this, getEval(), stmt); } void genFIR(const Fortran::parser::LockStmt &stmt) { diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt index a3514b11ad11a..dbd627d2e8d13 100644 --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -12,6 +12,7 @@ add_flang_library(FortranLower ConvertExpr.cpp DoLoopHelper.cpp FIRBuilder.cpp + Image.cpp IntrinsicCall.cpp IO.cpp Mangler.cpp diff --git a/flang/lib/Lower/Image.cpp b/flang/lib/Lower/Image.cpp new file mode 100644 index 0000000000000..ed58f69f1113e --- /dev/null +++ b/flang/lib/Lower/Image.cpp @@ -0,0 +1,77 @@ +//===-- Image.cpp ---------------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/Image.h" +#include "RTBuilder.h" +#include "SymbolMap.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/FIRBuilder.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Semantics/expression.h" + +#undef TODO +#define TODO(MSG) \ + { \ + mlir::emitError(converter.getCurrentLocation(), "not yet implemented") \ + << MSG; \ + exit(1); \ + } + +// TODO: We don't have runtime library support for various features. When they +// are encountered, we emit an error message and exit immediately. +static void noRuntimeSupport(mlir::Location loc, llvm::StringRef stmt) { + mlir::emitError(loc, "There is no runtime support for ") + << stmt << " statement.\n"; + std::exit(1); +} + +//===----------------------------------------------------------------------===// +// TEAM statements and constructs +//===----------------------------------------------------------------------===// + +void Fortran::lower::genChangeTeamConstruct( + Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &, + const Fortran::parser::ChangeTeamConstruct &) { + TODO("CHANGE TEAM construct"); +} + +void Fortran::lower::genChangeTeamStmt( + Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &, + const Fortran::parser::ChangeTeamStmt &) { + TODO("CHANGE TEAM stmt"); +} + +void Fortran::lower::genEndChangeTeamStmt( + Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &, + const Fortran::parser::EndChangeTeamStmt &) { + TODO("END CHANGE TEAM"); +} + +void Fortran::lower::genFormTeamStatement( + Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &, const Fortran::parser::FormTeamStmt &) { + // FIXME: There is no runtime call to make for this yet. + noRuntimeSupport(converter.getCurrentLocation(), "FORM TEAM"); +} + +//===----------------------------------------------------------------------===// +// COARRAY expressions +//===----------------------------------------------------------------------===// + +Fortran::lower::ExValue Fortran::lower::CoarrayExprHelper::genAddr( + const Fortran::evaluate::CoarrayRef &expr) { + TODO("co-array address"); +} + +Fortran::lower::ExValue Fortran::lower::CoarrayExprHelper::genValue( + const Fortran::evaluate::CoarrayRef &expr) { + TODO("co-array value"); +} diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index e3d08d0d8fad2..98afa14452e7b 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -132,13 +132,6 @@ void Fortran::lower::genEventWaitStatement( noRuntimeSupport(converter.getCurrentLocation(), "EVENT WAIT"); } -void Fortran::lower::genFormTeamStatement( - Fortran::lower::AbstractConverter &converter, - const Fortran::parser::FormTeamStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport(converter.getCurrentLocation(), "FORM TEAM"); -} - void Fortran::lower::genLockStatement( Fortran::lower::AbstractConverter &converter, const Fortran::parser::LockStmt &) { From 52563fef376469454ed2f99c4fa064e7b46dda61 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 9 Jun 2020 08:48:01 -0700 Subject: [PATCH 0089/1017] review comment: change diagnostic message --- flang/lib/Lower/Image.cpp | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/flang/lib/Lower/Image.cpp b/flang/lib/Lower/Image.cpp index ed58f69f1113e..b7f26879e2c92 100644 --- a/flang/lib/Lower/Image.cpp +++ b/flang/lib/Lower/Image.cpp @@ -5,6 +5,11 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +/// +/// Implementation of the lowering of image related constructs and expressions. +/// Fortran images can form teams, communicate via coarrays, etc. +/// +//===----------------------------------------------------------------------===// #include "flang/Lower/Image.h" #include "RTBuilder.h" @@ -22,14 +27,6 @@ exit(1); \ } -// TODO: We don't have runtime library support for various features. When they -// are encountered, we emit an error message and exit immediately. -static void noRuntimeSupport(mlir::Location loc, llvm::StringRef stmt) { - mlir::emitError(loc, "There is no runtime support for ") - << stmt << " statement.\n"; - std::exit(1); -} - //===----------------------------------------------------------------------===// // TEAM statements and constructs //===----------------------------------------------------------------------===// @@ -58,8 +55,7 @@ void Fortran::lower::genEndChangeTeamStmt( void Fortran::lower::genFormTeamStatement( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &, const Fortran::parser::FormTeamStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport(converter.getCurrentLocation(), "FORM TEAM"); + TODO("FORM TEAM"); } //===----------------------------------------------------------------------===// From 9a8d09954430a07447e49dc2cbea82622446f6f2 Mon Sep 17 00:00:00 2001 From: Steve Scalpone Date: Mon, 8 Jun 2020 21:38:57 -0700 Subject: [PATCH 0090/1017] Adjust the C/C++ compiler environments The hello world sample and the end-to-end character assignment test both use the host GCC to build and link their executable. Some environments use GCC with the env vars C_INCLUDE_PATH and CPLUS_INCLUDE_PATH set; test must be preserved in the lit env. Until flang gets a proper driver, the end-to-end "hello world" example uses a pipeline of bbc, tco, llc, and as to create the test's PIC relocatable object file. On some systems, GCC needs the -fPIC to override the default choice of a static link. --- flang/test/Lower/end-to-end-character-assignment.f90 | 2 +- flang/test/lit.cfg.py | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/flang/test/Lower/end-to-end-character-assignment.f90 b/flang/test/Lower/end-to-end-character-assignment.f90 index e2f93547ed1d7..7746bd3ec7959 100644 --- a/flang/test/Lower/end-to-end-character-assignment.f90 +++ b/flang/test/Lower/end-to-end-character-assignment.f90 @@ -1,5 +1,5 @@ ! RUN: bbc -emit-llvm -o - %s | tco | llc --relocation-model=pic | as -o %t -! RUN: %CXX -std=c++17 %t %S/end-to-end-character-assignment-driver.cpp +! RUN: %CXX -fPIC -std=c++17 %t %S/end-to-end-character-assignment-driver.cpp ! RUN: ./a.out ! This is an end-to-end test that is driven from a c++ program that builds diff --git a/flang/test/lit.cfg.py b/flang/test/lit.cfg.py index f9aafed1e832f..c65274f1571c5 100644 --- a/flang/test/lit.cfg.py +++ b/flang/test/lit.cfg.py @@ -105,3 +105,10 @@ result = lit_config.params.get("LIBPGMATH") if result: config.environment["LIBPGMATH"] = True + +# Preserve the GCC environment for +# Examples/hello.cpp and Lower/end-to-end-character-assignment-driver.cpp +if 'C_INCLUDE_PATH' in os.environ: + config.environment['C_INCLUDE_PATH'] = os.environ.get('C_INCLUDE_PATH') +if 'CPLUS_INCLUDE_PATH' in os.environ: + config.environment['CPLUS_INCLUDE_PATH'] = os.environ.get('CPLUS_INCLUDE_PATH') From e65f4d368d4bb97309313a182b953f94f03d9199 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 5 Jun 2020 13:21:04 -0700 Subject: [PATCH 0091/1017] add verification to lowering --- flang/include/flang/Lower/Support/Verifier.h | 30 ++++++++++++++++++++ flang/tools/bbc/bbc.cpp | 22 ++++++++------ 2 files changed, 44 insertions(+), 8 deletions(-) create mode 100644 flang/include/flang/Lower/Support/Verifier.h diff --git a/flang/include/flang/Lower/Support/Verifier.h b/flang/include/flang/Lower/Support/Verifier.h new file mode 100644 index 0000000000000..55449f43f051a --- /dev/null +++ b/flang/include/flang/Lower/Support/Verifier.h @@ -0,0 +1,30 @@ +//===-- Lower/Support/Verifier.h -- verify pass for lowering ----*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef LOWER_SUPPORT_VERIFIER_H +#define LOWER_SUPPORT_VERIFIER_H + +#include "mlir/IR/Verifier.h" +#include "mlir/Pass/Pass.h" + +namespace Fortran::lower { + +/// A verification pass to verify the output from the bridge. This provides a +/// little bit of glue to run a verifier pass directly. +class VerifierPass + : public mlir::PassWrapper> { + void runOnOperation() override final { + if (mlir::failed(mlir::verify(getOperation()))) + signalPassFailure(); + markAllAnalysesPreserved(); + } +}; + +} // namespace Fortran::lower + +#endif // LOWER_SUPPORT_VERIFIER_H diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 65389eda4a449..ff6bd650b4b60 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -16,6 +16,7 @@ #include "flang/Lower/Bridge.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/Support/Verifier.h" #include "flang/Optimizer/CodeGen/CodeGen.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Support/InternalNames.h" @@ -65,11 +66,11 @@ static llvm::cl::list static llvm::cl::opt intrinsicModuleDir("intrinsic-module-directory", - llvm::cl::desc("intrinsic module directory")); + llvm::cl::desc("intrinsic module directory")); static llvm::cl::opt moduleDir("module", llvm::cl::desc("module output directory (default .)"), - llvm::cl::init(".")); + llvm::cl::init(".")); static llvm::cl::opt moduleSuffix("module-suffix", llvm::cl::desc("module file suffix override"), @@ -218,24 +219,29 @@ static void convertFortranSourceToMLIR( llvm::errs() << "could not open output file " << outputName << '\n'; return; } - if (emitFIR) { - // Do lowering, but nothing else. Dump FIR and exit. - printModule(mlirModule, out); - return; - } // Otherwise run the default passes. mlir::PassManager pm(mlirModule.getContext()); mlir::applyPassManagerCLOptions(pm); if (passPipeline.hasAnyOccurrences()) { passPipeline.addToPipeline(pm); + } else if (emitFIR) { + // --emit-fir: Build the IR, verify it, and dump the IR (unconditionally). + pm.addPass(std::make_unique()); + if (mlir::failed(pm.run(mlirModule))) + llvm::errs() << "FATAL: verification of lowering to FIR failed"; + printModule(mlirModule, out); + return; } else { + pm.addPass(std::make_unique()); + pm.addPass(mlir::createCanonicalizerPass()); + pm.addPass(fir::createCSEPass()); pm.addPass(fir::createPromoteToAffinePass()); pm.addPass(fir::createFirToCfgPass()); pm.addPass(fir::createControlFlowLoweringPass()); pm.addPass(mlir::createLowerToCFGPass()); // pm.addPass(fir::createMemToRegPass()); - pm.addPass(fir::createCSEPass()); + pm.addPass(mlir::createCSEPass()); pm.addPass(mlir::createCanonicalizerPass()); } From 6d074d062c4284adba95e899685e6bef82b434b2 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 5 Jun 2020 15:34:15 -0700 Subject: [PATCH 0092/1017] relax checks in Tilikum when converting CoordinateOp. add a couple of regression tests. --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 4 +- flang/test/Fir/coordinate01.fir | 19 ---------- flang/test/Fir/coordinateof.fir | 49 +++++++++++++++++++++++++ 3 files changed, 51 insertions(+), 21 deletions(-) delete mode 100644 flang/test/Fir/coordinate01.fir create mode 100644 flang/test/Fir/coordinateof.fir diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index e83f311f9b1c0..e7fbd9a52aa63 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -1485,7 +1485,7 @@ struct CoordinateOpConversion offs.push_back(nxtOpnd); } if (dims.hasValue()) - return mlir::emitError(loc, "not enough arguments for array shape"); + offs.append(arrIdx.rbegin(), arrIdx.rend()); mlir::Value retval = genGEP(loc, unwrap(ty), rewriter, base, offs); rewriter.replaceOp(coor, retval); return success(); @@ -1583,7 +1583,7 @@ struct CoordinateOpConversion } if (ptrEle) return (!subEle) && (sz == 1); - return subEle && (i == sz); + return subEle && (i >= sz); } /// Returns the element type of the reference `refTy`. diff --git a/flang/test/Fir/coordinate01.fir b/flang/test/Fir/coordinate01.fir deleted file mode 100644 index cdb4111363276..0000000000000 --- a/flang/test/Fir/coordinate01.fir +++ /dev/null @@ -1,19 +0,0 @@ -// RUN: tco -emit-fir %s | tco | FileCheck %s - -// CHECK-LABEL: @foo1 -func @foo1(%i : i32, %j : i32, %k : i32) -> !fir.ref { - %1 = fir.alloca !fir.array<10 x 20 x 30 x f32> - %2 = fir.convert %1 : (!fir.ref>) -> !fir.ref> - // CHECK: getelementptr [20 x [10 x float]], [20 x [10 x float]]* % - %3 = fir.coordinate_of %2, %i, %j, %k : (!fir.ref>, i32, i32, i32) -> !fir.ref - return %3 : !fir.ref -} - -// CHECK-LABEL: @foo2 -func @foo2(%i : i32, %j : i32, %k : i32) -> !fir.ref { - %1 = fir.alloca !fir.array<10 x 20 x 30 x f32> - %2 = fir.convert %1 : (!fir.ref>) -> !fir.ref - // CHECK: getelementptr float, float* % - %3 = fir.coordinate_of %2, %i : (!fir.ref, i32) -> !fir.ref - return %3 : !fir.ref -} diff --git a/flang/test/Fir/coordinateof.fir b/flang/test/Fir/coordinateof.fir new file mode 100644 index 0000000000000..4eddae739eea9 --- /dev/null +++ b/flang/test/Fir/coordinateof.fir @@ -0,0 +1,49 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// tests on coordinate_of op + +// CHECK-LABEL: @foo1 +func @foo1(%i : i32, %j : i32, %k : i32) -> !fir.ref { + %1 = fir.alloca !fir.array<10 x 20 x 30 x f32> + // CHECK: %[[ptr:.*]] = bitcast [30 x [20 x [10 x + %2 = fir.convert %1 : (!fir.ref>) -> !fir.ref> + // CHECK: getelementptr [20 x [10 x float]], [20 x [10 x float]]* %[[ptr]] + %3 = fir.coordinate_of %2, %i, %j, %k : (!fir.ref>, i32, i32, i32) -> !fir.ref + return %3 : !fir.ref +} + +// CHECK-LABEL: @foo2 +func @foo2(%i : i32, %j : i32, %k : i32) -> !fir.ref { + %1 = fir.alloca !fir.array<10 x 20 x 30 x f32> + // CHECK: %[[ptr:.*]] = bitcast [30 x [20 x [10 x + %2 = fir.convert %1 : (!fir.ref>) -> !fir.ref + // CHECK: getelementptr float, float* %[[ptr]] + %3 = fir.coordinate_of %2, %i : (!fir.ref, i32) -> !fir.ref + return %3 : !fir.ref +} + +// CHECK-LABEL: @foo3 +func @foo3(%box : !fir.box>, %i : i32) -> i32 { + // CHECK: %[[cvt:.*]] = sext i32 % + %ii = fir.convert %i : (i32) -> index + // CHECK: %[[gep0:.*]] = getelementptr { i32* + // CHECK: %[[boxptr:.*]] = load i32*, i32** %[[gep0]] + // CHECK: %[[gep1:.*]] = getelementptr i32, i32* %[[boxptr]], i64 % + %1 = fir.coordinate_of %box, %ii : (!fir.box>, index) -> !fir.ref + // CHECK: load i32, i32* %[[gep1]] + %rv = fir.load %1 : !fir.ref + return %rv : i32 +} + +// CHECK-LABEL: @foo4 +func @foo4(%a : !fir.ptr>, %i : i32, %j : i64, %k : index) -> i32 { + // CHECK: getelementptr [25 x [15 x [5 x + %1 = fir.coordinate_of %a, %k : (!fir.ptr>, index) -> !fir.ref> + // CHECK: getelementptr [15 x [5 x + %2 = fir.coordinate_of %1, %j : (!fir.ref>, i64) -> !fir.ref> + // CHECK: %[[ref:.*]] = getelementptr [5 x + %3 = fir.coordinate_of %2, %i : (!fir.ref>, i32) -> !fir.ref + // CHECK: load i32, i32* %[[ref]] + %4 = fir.load %3 : !fir.ref + return %4 : i32 +} From ee2d0a6f08aedb77feeafd3dcae7db66b107d58d Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 9 Jun 2020 10:48:46 -0700 Subject: [PATCH 0093/1017] merge all the optimizer libraries into one --- flang/lib/Lower/CMakeLists.txt | 1 - flang/lib/Optimizer/Analysis/CMakeLists.txt | 13 ------------ flang/lib/Optimizer/CodeGen/CMakeLists.txt | 13 ------------ flang/lib/Optimizer/Transforms/CMakeLists.txt | 20 ------------------- flang/tools/bbc/CMakeLists.txt | 5 +---- 5 files changed, 1 insertion(+), 51 deletions(-) delete mode 100644 flang/lib/Optimizer/Analysis/CMakeLists.txt delete mode 100644 flang/lib/Optimizer/CodeGen/CMakeLists.txt delete mode 100644 flang/lib/Optimizer/Transforms/CMakeLists.txt diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt index dbd627d2e8d13..a3514b11ad11a 100644 --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -12,7 +12,6 @@ add_flang_library(FortranLower ConvertExpr.cpp DoLoopHelper.cpp FIRBuilder.cpp - Image.cpp IntrinsicCall.cpp IO.cpp Mangler.cpp diff --git a/flang/lib/Optimizer/Analysis/CMakeLists.txt b/flang/lib/Optimizer/Analysis/CMakeLists.txt deleted file mode 100644 index 2382c48adaf0e..0000000000000 --- a/flang/lib/Optimizer/Analysis/CMakeLists.txt +++ /dev/null @@ -1,13 +0,0 @@ -get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) - -add_flang_library(FIRAnalysis - IteratedDominanceFrontier.cpp - - DEPENDS - FIROpsIncGen - ${dialect_libs} - - LINK_LIBS - FIRDialect - FIRSupport -) diff --git a/flang/lib/Optimizer/CodeGen/CMakeLists.txt b/flang/lib/Optimizer/CodeGen/CMakeLists.txt deleted file mode 100644 index 409018e6e81c8..0000000000000 --- a/flang/lib/Optimizer/CodeGen/CMakeLists.txt +++ /dev/null @@ -1,13 +0,0 @@ -get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) - -add_flang_library(FIRCodeGen - CodeGen.cpp - - DEPENDS - FIROpsIncGen - ${dialect_libs} - - LINK_LIBS - FIRDialect - FIRSupport -) diff --git a/flang/lib/Optimizer/Transforms/CMakeLists.txt b/flang/lib/Optimizer/Transforms/CMakeLists.txt deleted file mode 100644 index c144f7c4af1f9..0000000000000 --- a/flang/lib/Optimizer/Transforms/CMakeLists.txt +++ /dev/null @@ -1,20 +0,0 @@ -get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) - -add_flang_library(FIRTransforms - ControlFlowConverter.cpp - CSE.cpp - Inliner.cpp - MemToReg.cpp - RaiseToAffine.cpp - RewriteLoop.cpp - - DEPENDS - FIROpsIncGen - FIROptTransformsPassIncGen - ${dialect_libs} - - LINK_LIBS - FIRAnalysis - FIRDialect - FIRSupport -) diff --git a/flang/tools/bbc/CMakeLists.txt b/flang/tools/bbc/CMakeLists.txt index fe42de6a239d4..c1668b80881d5 100644 --- a/flang/tools/bbc/CMakeLists.txt +++ b/flang/tools/bbc/CMakeLists.txt @@ -2,10 +2,7 @@ set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-parameter") get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) set(LIBS - FIRAnalysis - FIRCodeGen - FIRDialect - FIRTransforms + FIROptimizer ${dialect_libs} MLIRLLVMIR MLIRAffineToStandard From f45642acb5ee16231d834a9c49fdfd645403642d Mon Sep 17 00:00:00 2001 From: Rajan Walia Date: Wed, 10 Jun 2020 09:38:13 -0700 Subject: [PATCH 0094/1017] affine loop analysis and conversion --- .../Optimizer/Transforms/AffinePromotion.cpp | 176 ++++++++++++++++++ .../Optimizer/Transforms/RaiseToAffine.cpp | 81 -------- 2 files changed, 176 insertions(+), 81 deletions(-) create mode 100644 flang/lib/Optimizer/Transforms/AffinePromotion.cpp delete mode 100644 flang/lib/Optimizer/Transforms/RaiseToAffine.cpp diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp new file mode 100644 index 0000000000000..a304db8bb387f --- /dev/null +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -0,0 +1,176 @@ +//===-- AffinePromotion.cpp -----------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "PassDetail.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Dialect/Affine/IR/AffineOps.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/IR/Attributes.h" +#include "mlir/IR/Visitors.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Transforms/DialectConversion.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/Optional.h" +#include "llvm/Support/CommandLine.h" +#define DEBUG_TYPE "flang-affine-promotion" + +/// disable FIR to affine dialect conversion +static llvm::cl::opt + disableAffinePromo("disable-affine-promotion", + llvm::cl::desc("disable FIR to Affine pass"), + llvm::cl::init(true)); + +using namespace fir; + +namespace { + +class AffineLoopAnalysis { +public: + AffineLoopAnalysis(fir::LoopOp op) : legality(analyzeLoop(op)) {} + bool canPromoteToAffine() { return legality; } + Optional step; + +private: + bool legality; + bool analyzeLoop(fir::LoopOp op) { + return analyzeStep(op.step()) && analyzeMemoryAccess(op); + } + bool analyzeStep(const mlir::Value stepValue) { + auto stepDefinition = stepValue.getDefiningOp(); + if (stepDefinition) { + if (auto stepAttr = stepDefinition.getValue().dyn_cast()) { + step = stepAttr.getInt(); + return true; + } else { + LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: cannot promote loop, " + "step not integer\n"; + stepAttr.print(llvm::dbgs());); + return false; + } + } else { + LLVM_DEBUG( + llvm::dbgs() + << "AffineLoopAnalysis: cannot promote loop, step not constant\n"; + if (stepValue.getDefiningOp()) stepValue.getDefiningOp()->print( + llvm::dbgs())); + return false; + } + } + bool analyzeMemoryAccess(fir::LoopOp loop) { + llvm_unreachable("not yet implemented"); + return true; + } +}; + +/// builds analysis for all loop operations within a function +class AffineFunctionAnalysis { +public: + AffineFunctionAnalysis(mlir::FuncOp funcOp) { + for (fir::LoopOp op : funcOp.getOps()) { + loopAnalysisMap.try_emplace(op, op); + } + } + AffineLoopAnalysis getChildLoopAnalysis(fir::LoopOp op) const { + auto it = loopAnalysisMap.find_as(op); + if (it == loopAnalysisMap.end()) { + op.emitError("error in fetching loop analysis during affine promotion\n"); + } else { + return it->getSecond(); + } + } + +private: + DenseMap loopAnalysisMap; +}; + +/// Convert `fir.loop` to `affine.for` +class AffineLoopConversion : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + AffineLoopConversion(mlir::MLIRContext *context, AffineFunctionAnalysis &afa) + : OpRewritePattern(context), functionAnalysis(afa) {} + + mlir::LogicalResult + matchAndRewrite(fir::LoopOp loop, + mlir::PatternRewriter &rewriter) const override { + auto loopAnalysis = functionAnalysis.getChildLoopAnalysis(loop); + if (loopAnalysis.step.getValue() <= 0) { + LLVM_DEBUG(llvm::dbgs() + << "AffineLoopAnalysis: cannot promote loop for now, " + "step not postive\n";); + return failure(); + } + auto loopOps = &loop.getBody()->getOperations(); + for (auto loadOp : loop.getOps()) { + if (failed(rewriteLoad(loadOp, rewriter))) + return failure(); + } + auto affineFor = rewriter.create( + loop.getLoc(), ValueRange(loop.lowerBound()), + AffineMap::getMultiDimIdentityMap(1, loop.getContext()), + ValueRange(loop.upperBound()), + AffineMap::getMultiDimIdentityMap(1, loop.getContext()), + loopAnalysis.step.getValue()); + loop.step().dropAllUses(); + loop.getBody()->getOperations().pop_back(); // remove fir.result + affineFor.getBody()->getOperations().splice(affineFor.getBody()->begin(), + *loopOps, loopOps->begin(), + loopOps->end()); + rewriter.eraseOp(loop); + loop.getInductionVar().replaceAllUsesWith(affineFor.getInductionVar()); + return success(); + } + +private: + mlir::LogicalResult rewriteLoad(fir::LoadOp op, + mlir::PatternRewriter &rewriter) const { + return success(); + } + AffineFunctionAnalysis &functionAnalysis; +}; + +/// Promote fir.loop and fir.where to affine.for and affine.if, in the cases +/// where such a promotion is possible. +class AffineDialectPromotion + : public AffineDialectPromotionBase { +public: + void runOnFunction() override { + if (disableAffinePromo) + return; + + auto *context = &getContext(); + auto function = getFunction(); + auto functionAnalysis = AffineFunctionAnalysis(function); + mlir::OwningRewritePatternList patterns; + patterns.insert(context, functionAnalysis); + mlir::ConversionTarget target = *context; + target.addLegalDialect(); + target.addDynamicallyLegalOp([&functionAnalysis](fir::LoopOp op) { + return !(functionAnalysis.getChildLoopAnalysis(op).canPromoteToAffine()); + }); + LLVM_DEBUG(llvm::dbgs() + << "AffineDialectPromotion: running promotion on: \n"; + function.print(llvm::dbgs());); + // apply the patterns + if (mlir::failed(mlir::applyPartialConversion(function, target, + std::move(patterns)))) { + mlir::emitError(mlir::UnknownLoc::get(context), + "error in converting to affine dialect\n"); + signalPassFailure(); + } + } +}; +} // namespace + +/// Convert FIR loop constructs to the Affine dialect +std::unique_ptr fir::createPromoteToAffinePass() { + return std::make_unique(); +} diff --git a/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp b/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp deleted file mode 100644 index 2be2b3457d3a9..0000000000000 --- a/flang/lib/Optimizer/Transforms/RaiseToAffine.cpp +++ /dev/null @@ -1,81 +0,0 @@ -//===-- RaiseToAffine.cpp -------------------------------------------------===// -// -// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -// See https://llvm.org/LICENSE.txt for license information. -// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -// -//===----------------------------------------------------------------------===// - -#include "PassDetail.h" -#include "flang/Optimizer/Dialect/FIRDialect.h" -#include "flang/Optimizer/Dialect/FIROps.h" -#include "flang/Optimizer/Transforms/Passes.h" -#include "mlir/Dialect/Affine/IR/AffineOps.h" -#include "mlir/Dialect/StandardOps/IR/Ops.h" -#include "mlir/Pass/Pass.h" -#include "mlir/Transforms/DialectConversion.h" -#include "llvm/Support/CommandLine.h" - -/// disable FIR to affine dialect conversion -static llvm::cl::opt - disableAffinePromo("disable-affine-promotion", - llvm::cl::desc("disable FIR to Affine pass"), - llvm::cl::init(false)); - -using namespace fir; - -namespace { - -template -class OpRewrite : public mlir::RewritePattern { -public: - explicit OpRewrite(mlir::MLIRContext *ctx) - : RewritePattern(FROM::getOperationName(), 1, ctx) {} -}; - -/// Convert `fir.loop` to `affine.for` -class AffineLoopConv : public OpRewrite { -public: - using OpRewrite::OpRewrite; -}; - -/// Convert `fir.where` to `affine.if` -class AffineWhereConv : public OpRewrite { -public: - using OpRewrite::OpRewrite; -}; - -/// Promote fir.loop and fir.where to affine.for and affine.if, in the cases -/// where such a promotion is possible. -class AffineDialectPromotion - : public AffineDialectPromotionBase { -public: - void runOnFunction() override { - if (disableAffinePromo) - return; - - auto *context = &getContext(); - mlir::OwningRewritePatternList patterns; - patterns.insert(context); - mlir::ConversionTarget target = *context; - target.addLegalDialect(); - // target.addDynamicallyLegalOp(); - - // apply the patterns - if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, - std::move(patterns)))) { - mlir::emitError(mlir::UnknownLoc::get(context), - "error in converting to affine dialect\n"); - signalPassFailure(); - } - } -}; - -} // namespace - -/// Convert FIR loop constructs to the Affine dialect -std::unique_ptr fir::createPromoteToAffinePass() { - return std::make_unique(); -} From 237c7f7e9631c3f633faa67c17538aec8388a14e Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 10 Jun 2020 13:37:37 -0700 Subject: [PATCH 0095/1017] [rebase] fallout from MLIR changing the output of i1 constants --- flang/test/Lower/stop.f90 | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/flang/test/Lower/stop.f90 b/flang/test/Lower/stop.f90 index 402c00ab84cd7..70bab23097a12 100644 --- a/flang/test/Lower/stop.f90 +++ b/flang/test/Lower/stop.f90 @@ -1,11 +1,10 @@ -! RUN: bbc -emit-fir %s -o - | FileCheck %s +! RUN: bbc %s -o - | FileCheck %s ! CHECK-LABEL stop_test subroutine stop_test(b) ! CHECK-DAG: %[[c0:.*]] = constant 0 : i32 - ! CHECK-DAG: %[[false:.*]] = constant 0 : i1 - ! CHECK-DAG: %[[false_0:.*]] = constant 0 : i1 - ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[false_0]]) + ! CHECK-DAG: %[[false:.*]] = constant false + ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[false]]) stop end subroutine ! CHECK: func @_Fortran{{.*}}StopStatement(i32, i1, i1) -> none @@ -14,17 +13,16 @@ subroutine stop_test(b) subroutine stop_code() stop 42 ! CHECK-DAG: %[[c42:.*]] = constant 42 : i32 - ! CHECK-DAG: %[[false:.*]] = constant 0 : i1 - ! CHECK-DAG: %[[false_0:.*]] = constant 0 : i1 - ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c42]], %[[false]], %[[false_0]]) + ! CHECK-DAG: %[[false:.*]] = constant false + ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c42]], %[[false]], %[[false]]) end subroutine ! CHECK-LABEL stop_error subroutine stop_error() error stop ! CHECK-DAG: %[[c0:.*]] = constant 0 : i32 - ! CHECK-DAG: %[[true:.*]] = constant 1 : i1 - ! CHECK-DAG: %[[false:.*]] = constant 0 : i1 + ! CHECK-DAG: %[[true:.*]] = constant true + ! CHECK-DAG: %[[false:.*]] = constant false ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[true]], %[[false]]) end subroutine @@ -33,7 +31,7 @@ subroutine stop_quiet(b) logical :: b stop, quiet = b ! CHECK-DAG: %[[c0:.*]] = constant 0 : i32 - ! CHECK-DAG: %[[false:.*]] = constant 0 : i1 + ! CHECK-DAG: %[[false:.*]] = constant false ! CHECK-DAG: %[[b:.*]] = fir.load %arg0 ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[bi1]]) @@ -44,7 +42,7 @@ subroutine stop_error_code_quiet(b) logical :: b error stop 66, quiet = b ! CHECK-DAG: %[[c66:.*]] = constant 66 : i32 - ! CHECK-DAG: %[[true:.*]] = constant 1 : i1 + ! CHECK-DAG: %[[true:.*]] = constant true ! CHECK-DAG: %[[b:.*]] = fir.load %arg0 ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c66]], %[[true]], %[[bi1]]) From 4c72fda89c5cac7036be1e6ec7e294fc7122e0fd Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 11 Jun 2020 09:36:02 -0700 Subject: [PATCH 0096/1017] [cleanup] some misc cleanup --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index e7fbd9a52aa63..6bb2b776e6230 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -273,8 +273,7 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { // fir.array --> llvm<"[...[c x any]]"> mlir::LLVM::LLVMType convertSequenceType(fir::SequenceType seq) { - if (!seq.hasConstantInterior()) - llvm_unreachable("cannot lower type to LLVM IR"); + assert(seq.hasConstantInterior() && "cannot lower type to LLVM IR"); auto baseTy = unwrap(convertType(seq.getEleTy())); auto shape = seq.getShape(); auto constRows = seq.getConstantRows(); @@ -2012,7 +2011,8 @@ struct SelectTypeOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::SelectTypeOp select, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - llvm_unreachable("fir.select_type should have already been converted"); + mlir::emitError(select.getLoc(), + "fir.select_type should have already been converted"); return failure(); } }; From 72d467582a1636e1955312b71e11c81a7d14b3e0 Mon Sep 17 00:00:00 2001 From: rajan Date: Thu, 11 Jun 2020 10:19:15 -0700 Subject: [PATCH 0097/1017] adding other flang passes to cli parser, accepting cl options in tco (#171) * adding other flang passes to cli parser, accepting cl options in tco * keeping previous invariant of emit-fir --- flang/lib/Optimizer/Transforms/CSE.cpp | 7 ++++--- flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp | 3 ++- flang/lib/Optimizer/Transforms/RewriteLoop.cpp | 4 ++-- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp index 5c3f406c2fc0c..fda5525c540be 100644 --- a/flang/lib/Optimizer/Transforms/CSE.cpp +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -12,6 +12,7 @@ /// //===----------------------------------------------------------------------===// +#include "PassDetail.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Optimizer/Transforms/Passes.h" #include "mlir/IR/Attributes.h" @@ -90,11 +91,11 @@ struct SimpleOperationInfo : public llvm::DenseMapInfo { return false; // Compare operands. if (lhs->isCommutative()) { - SmallVector lops; + SmallVector lops; for (const auto &lod : lhs->getOperands()) lops.push_back(lod.getAsOpaquePointer()); llvm::sort(lops.begin(), lops.end()); - SmallVector rops; + SmallVector rops; for (const auto &rod : rhs->getOperands()) rops.push_back(rod.getAsOpaquePointer()); llvm::sort(rops.begin(), rops.end()); @@ -112,7 +113,7 @@ struct SimpleOperationInfo : public llvm::DenseMapInfo { }; /// Basic common sub-expression elimination. -struct BasicCSE : public mlir::PassWrapper { +struct BasicCSE : public fir::BasicCSEBase { BasicCSE() {} BasicCSE(const BasicCSE &) {} diff --git a/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp index a752730a4ac16..45435a5d33fab 100644 --- a/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp +++ b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp @@ -14,6 +14,7 @@ // //===----------------------------------------------------------------------===// +#include "PassDetail.h" #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" @@ -136,7 +137,7 @@ struct SelectTypeOpConversion : public FIROpConversion { /// Convert affine dialect, fir.select_type to standard dialect class ControlFlowLoweringPass - : public mlir::PassWrapper { + : public ControlFlowLoweringBase { public: explicit ControlFlowLoweringPass() {} diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index ee2ba4551d314..fadd39ce262b9 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -6,6 +6,7 @@ // //===----------------------------------------------------------------------===// +#include "PassDetail.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Transforms/Passes.h" @@ -259,8 +260,7 @@ class CfgIterWhileConv : public mlir::OpRewritePattern { }; /// Convert FIR structured control flow ops to CFG ops. -class CfgConversion - : public mlir::PassWrapper { +class CfgConversion : public CFGConversionBase { public: void runOnFunction() override { if (disableCfgConversion) From 0f0d139b3335c3b0cdf333bc72051b1ced6aab49 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 12 Jun 2020 11:54:00 -0700 Subject: [PATCH 0098/1017] add TODO comment [NFC] do a rename on files (part of my backlog) implement verify checks; work on tilikum and fir implement code gen of xArrayCoor and xEmbox [f77] fix assertion when a boxed value is wrapped in parentheses. This fix just inserts a no_reassoc op and forwards the boxed value. This relaxes what was otherwise a hard assertion failure. fixes build issue --- flang/include/flang/Lower/Image.h | 83 ----- flang/include/flang/Optimizer/OptPasses.h | 22 ++ flang/lib/Lower/Bridge.cpp | 2 +- flang/lib/Lower/Image.cpp | 73 ---- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 320 ++++++++++++------ flang/lib/Optimizer/CodeGen/DescriptorModel.h | 150 ++++++++ flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 296 ++++++---------- flang/lib/Optimizer/Dialect/FIROps.cpp | 69 ++++ flang/lib/Optimizer/Transforms/CSE.cpp | 3 +- flang/lib/Optimizer/Transforms/PassDetail.h | 2 +- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 2 +- flang/tools/bbc/bbc.cpp | 6 +- 12 files changed, 557 insertions(+), 471 deletions(-) delete mode 100644 flang/include/flang/Lower/Image.h create mode 100644 flang/include/flang/Optimizer/OptPasses.h delete mode 100644 flang/lib/Lower/Image.cpp create mode 100644 flang/lib/Optimizer/CodeGen/DescriptorModel.h diff --git a/flang/include/flang/Lower/Image.h b/flang/include/flang/Lower/Image.h deleted file mode 100644 index 76c748db621b4..0000000000000 --- a/flang/include/flang/Lower/Image.h +++ /dev/null @@ -1,83 +0,0 @@ -//===-- Lower/Image.h -- image related lowering -----------------*- C++ -*-===// -// -// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -// See https://llvm.org/LICENSE.txt for license information. -// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -// -//===----------------------------------------------------------------------===// -// -// Builder routines for constructing the FIR dialect of MLIR. As FIR is a -// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding -// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this -// module. -// -//===----------------------------------------------------------------------===// - -#ifndef FORTRAN_LOWER_IMAGE_H -#define FORTRAN_LOWER_IMAGE_H - -#include "flang/Lower/AbstractConverter.h" -#include "flang/Lower/Support/BoxValue.h" - -namespace Fortran { - -namespace parser { -struct ChangeTeamConstruct; -struct ChangeTeamStmt; -struct EndChangeTeamStmt; -struct FormTeamStmt; -} // namespace parser - -namespace evaluate { -class CoarrayRef; -} // namespace evaluate - -namespace lower { -class SymMap; -namespace pft { -struct Evaluation; -} // namespace pft - -//===----------------------------------------------------------------------===// -// TEAM constructs -//===----------------------------------------------------------------------===// - -void genChangeTeamConstruct(AbstractConverter &, pft::Evaluation &eval, - const parser::ChangeTeamConstruct &); -void genChangeTeamStmt(AbstractConverter &, pft::Evaluation &eval, - const parser::ChangeTeamStmt &); -void genEndChangeTeamStmt(AbstractConverter &, pft::Evaluation &eval, - const parser::EndChangeTeamStmt &); -void genFormTeamStatement(AbstractConverter &, pft::Evaluation &eval, - const parser::FormTeamStmt &); - -//===----------------------------------------------------------------------===// -// COARRAY expressions -//===----------------------------------------------------------------------===// - -/// Coarray expression lowering helper. A coarray expression is expected to be -/// lowered into runtime support calls. For example, expressions may use a -/// message-passing runtime to access another image's data. -class CoarrayExprHelper { -public: - explicit CoarrayExprHelper(AbstractConverter &converter, mlir::Location loc, - SymMap &syms) - : converter{converter}, symMap{syms}, loc{loc} {} - CoarrayExprHelper(const CoarrayExprHelper &) = delete; - - /// Generate the address of a co-array expression. - ExValue genAddr(const evaluate::CoarrayRef &expr); - - /// Generate the value of a co-array expression. - ExValue genValue(const evaluate::CoarrayRef &expr); - -private: - AbstractConverter &converter; - SymMap &symMap; - mlir::Location loc; -}; - -} // namespace lower -} // namespace Fortran - -#endif // FORTRAN_LOWER_IMAGE_H diff --git a/flang/include/flang/Optimizer/OptPasses.h b/flang/include/flang/Optimizer/OptPasses.h new file mode 100644 index 0000000000000..1aa5f7dc009a0 --- /dev/null +++ b/flang/include/flang/Optimizer/OptPasses.h @@ -0,0 +1,22 @@ +//===-- Optimizer/Transforms/Passes.h ---------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef OPTIMIZER_OPTPASSES_H +#define OPTIMIZER_OPTPASSES_H + +#include "flang/Optimizer/CodeGen/CodeGen.h" +#include "flang/Optimizer/Transforms/Passes.h" + +namespace fir { +inline void registerOptPasses() { + registerOptCodeGenPasses(); + registerOptTransformPasses(); +} +} // namespace fir + +#endif // OPTIMIZER_OPTPASSES_H diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 633486ccce69d..7c4d75bfbe915 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -11,11 +11,11 @@ #include "SymbolMap.h" #include "flang/Lower/CallInterface.h" #include "flang/Lower/CharacterExpr.h" +#include "flang/Lower/Coarray.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/FIRBuilder.h" #include "flang/Lower/IO.h" -#include "flang/Lower/Image.h" #include "flang/Lower/Mangler.h" #include "flang/Lower/OpenMP.h" #include "flang/Lower/PFTBuilder.h" diff --git a/flang/lib/Lower/Image.cpp b/flang/lib/Lower/Image.cpp deleted file mode 100644 index b7f26879e2c92..0000000000000 --- a/flang/lib/Lower/Image.cpp +++ /dev/null @@ -1,73 +0,0 @@ -//===-- Image.cpp ---------------------------------------------------------===// -// -// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -// See https://llvm.org/LICENSE.txt for license information. -// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -// -//===----------------------------------------------------------------------===// -/// -/// Implementation of the lowering of image related constructs and expressions. -/// Fortran images can form teams, communicate via coarrays, etc. -/// -//===----------------------------------------------------------------------===// - -#include "flang/Lower/Image.h" -#include "RTBuilder.h" -#include "SymbolMap.h" -#include "flang/Lower/Bridge.h" -#include "flang/Lower/FIRBuilder.h" -#include "flang/Parser/parse-tree.h" -#include "flang/Semantics/expression.h" - -#undef TODO -#define TODO(MSG) \ - { \ - mlir::emitError(converter.getCurrentLocation(), "not yet implemented") \ - << MSG; \ - exit(1); \ - } - -//===----------------------------------------------------------------------===// -// TEAM statements and constructs -//===----------------------------------------------------------------------===// - -void Fortran::lower::genChangeTeamConstruct( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &, - const Fortran::parser::ChangeTeamConstruct &) { - TODO("CHANGE TEAM construct"); -} - -void Fortran::lower::genChangeTeamStmt( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &, - const Fortran::parser::ChangeTeamStmt &) { - TODO("CHANGE TEAM stmt"); -} - -void Fortran::lower::genEndChangeTeamStmt( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &, - const Fortran::parser::EndChangeTeamStmt &) { - TODO("END CHANGE TEAM"); -} - -void Fortran::lower::genFormTeamStatement( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &, const Fortran::parser::FormTeamStmt &) { - TODO("FORM TEAM"); -} - -//===----------------------------------------------------------------------===// -// COARRAY expressions -//===----------------------------------------------------------------------===// - -Fortran::lower::ExValue Fortran::lower::CoarrayExprHelper::genAddr( - const Fortran::evaluate::CoarrayRef &expr) { - TODO("co-array address"); -} - -Fortran::lower::ExValue Fortran::lower::CoarrayExprHelper::genValue( - const Fortran::evaluate::CoarrayRef &expr) { - TODO("co-array value"); -} diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 6bb2b776e6230..223a3b5f0a173 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -7,6 +7,7 @@ //===----------------------------------------------------------------------===// #include "flang/Optimizer/CodeGen/CodeGen.h" +#include "DescriptorModel.h" #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" @@ -143,36 +144,39 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { return mlir::LLVM::LLVMType::getInt64Ty(llvmDialect); } + // TODO + bool requiresExtendedDesc() { return false; } + // This corresponds to the descriptor as defined ISO_Fortran_binding.h and the // addendum defined in descriptor.h. - // FIXME: This code should be generated and follow SPOT - mlir::LLVM::LLVMType convertBoxType(fir::BoxType box) { + mlir::LLVM::LLVMType convertBoxType(fir::BoxType box, int rank = -1) { // (buffer*, ele-size, rank, type-descriptor, attribute, [dims]) SmallVector parts; mlir::Type ele = box.getEleTy(); - // auto *ctx = box.getContext(); auto eleTy = unwrap(convertType(ele)); // buffer* if (ele.isa() && eleTy.isPointerTy()) parts.push_back(eleTy); else parts.push_back(eleTy.getPointerTo()); - // ele-size - parts.push_back(mlir::LLVM::LLVMType::getInt64Ty(llvmDialect)); - // version - parts.push_back(mlir::LLVM::LLVMType::getInt32Ty(llvmDialect)); - // rank - parts.push_back(mlir::LLVM::LLVMType::getInt8Ty(llvmDialect)); - // type (code) - parts.push_back(mlir::LLVM::LLVMType::getInt8Ty(llvmDialect)); - // attribute - parts.push_back(mlir::LLVM::LLVMType::getInt8Ty(llvmDialect)); - // addendum - parts.push_back(mlir::LLVM::LLVMType::getInt8Ty(llvmDialect)); - // opt-dims: [0..15 x [int,int,int]] (see fir.dims) + parts.push_back(fir::getDescFieldTypeModel<1>()(llvmDialect)); + parts.push_back(fir::getDescFieldTypeModel<2>()(llvmDialect)); + parts.push_back(fir::getDescFieldTypeModel<3>()(llvmDialect)); + parts.push_back(fir::getDescFieldTypeModel<4>()(llvmDialect)); + parts.push_back(fir::getDescFieldTypeModel<5>()(llvmDialect)); + parts.push_back(fir::getDescFieldTypeModel<6>()(llvmDialect)); + if (rank > 0) { + auto rowTy = fir::getDescFieldTypeModel<7>()(llvmDialect); + parts.push_back(mlir::LLVM::LLVMType::getArrayTy(rowTy, rank)); + } // opt-type-ptr: i8* (see fir.tdesc) - // opt-flags: i64 - // opt-len-params: [? x i64] + if (requiresExtendedDesc()) { + parts.push_back(fir::getExtendedDescFieldTypeModel<8>()(llvmDialect)); + parts.push_back(fir::getExtendedDescFieldTypeModel<9>()(llvmDialect)); + auto rowTy = fir::getExtendedDescFieldTypeModel<10>()(llvmDialect); + unsigned numLenParams = 0; // FIXME + parts.push_back(mlir::LLVM::LLVMType::getArrayTy(rowTy, numLenParams)); + } return mlir::LLVM::LLVMType::getStructTy(llvmDialect, parts).getPointerTo(); } @@ -1166,13 +1170,41 @@ struct EmboxCharOpConversion : public FIROpConversion { struct EmboxOpConversion : public FIROpConversion { using FIROpConversion::FIROpConversion; + /// Generate an alloca of size `size` and cast it to type `toTy` + mlir::LLVM::AllocaOp + genAllocaWithType(mlir::Location loc, mlir::LLVM::LLVMType toTy, + unsigned alignment, mlir::LLVM::LLVMDialect *dialect, + mlir::ConversionPatternRewriter &rewriter) const { + auto thisPt = rewriter.saveInsertionPoint(); + auto *thisBlock = rewriter.getInsertionBlock(); + auto func = mlir::cast(thisBlock->getParentOp()); + rewriter.setInsertionPointToStart(&func.front()); + auto sz = genConstantOffset(loc, rewriter, 1); + auto al = rewriter.create(loc, toTy, sz, alignment); + rewriter.restoreInsertionPoint(thisPt); + return al; + } + + mlir::LLVM::BitcastOp genGEPToField(mlir::Location loc, + mlir::LLVM::LLVMType ty, + mlir::ConversionPatternRewriter &rewriter, + mlir::Value base, mlir::Value zero, + int field) const { + auto fld = genConstantOffset(loc, rewriter, field); + auto gep = genGEP(loc, ty, rewriter, base, zero, fld); + return rewriter.create(loc, ty, gep); + } + mlir::LogicalResult matchAndRewrite(fir::EmboxOp embox, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { + auto dims = embox.getDims(); + assert(!dims); auto loc = embox.getLoc(); - auto dialect = getDialect(); - auto ty = unwrap(convertType(embox.getType())); - auto alloca = genAllocaWithType(loc, ty, 24, defaultAlign, rewriter); + auto *dialect = getDialect(); + auto ty = unwrap( + lowering.convertBoxType(embox.getType().dyn_cast(), 0)); + auto alloca = genAllocaWithType(loc, ty, defaultAlign, dialect, rewriter); auto c0 = genConstantOffset(loc, rewriter, 0); auto rty = unwrap(operands[0].getType()).getPointerTo(); auto f0p = genGEP(loc, rty, rewriter, alloca, c0, c0); @@ -1197,38 +1229,89 @@ struct EmboxOpConversion : public FIROpConversion { rewriter.create(loc, c0__, f5p); auto f6p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 6); rewriter.create(loc, c0__, f6p); - // FIXME: copy the dims info, etc. - rewriter.replaceOp(embox, alloca.getResult()); return success(); } +}; + +/// create a generic box on a memory reference +struct XEmboxOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; /// Generate an alloca of size `size` and cast it to type `toTy` - mlir::LLVM::BitcastOp + mlir::LLVM::AllocaOp genAllocaWithType(mlir::Location loc, mlir::LLVM::LLVMType toTy, - unsigned size, unsigned alignment, + unsigned alignment, mlir::LLVM::LLVMDialect *dialect, mlir::ConversionPatternRewriter &rewriter) const { - auto i8Ty = mlir::LLVM::LLVMType::getInt8PtrTy(getDialect()); auto thisPt = rewriter.saveInsertionPoint(); auto *thisBlock = rewriter.getInsertionBlock(); auto func = mlir::cast(thisBlock->getParentOp()); rewriter.setInsertionPointToStart(&func.front()); - auto size_ = genConstantOffset(loc, rewriter, size); - auto al = - rewriter.create(loc, i8Ty, size_, alignment); + auto sz = genConstantOffset(loc, rewriter, 1); + auto al = rewriter.create(loc, toTy, sz, alignment); rewriter.restoreInsertionPoint(thisPt); - return rewriter.create(loc, toTy, al); + return al; } - mlir::LLVM::BitcastOp genGEPToField(mlir::Location loc, - mlir::LLVM::LLVMType ty, - mlir::ConversionPatternRewriter &rewriter, - mlir::Value base, mlir::Value zero, - int field) const { - auto coff = genConstantOffset(loc, rewriter, field); - auto gep = genGEP(loc, ty, rewriter, base, zero, coff); + template + mlir::LLVM::BitcastOp + genGEPToField(mlir::Location loc, mlir::LLVM::LLVMType ty, + mlir::ConversionPatternRewriter &rewriter, mlir::Value base, + mlir::Value zero, FLDS... fields) const { + auto gep = genGEP(loc, ty, rewriter, base, zero, + genConstantOffset(loc, rewriter, fields)...); return rewriter.create(loc, ty, gep); } + + mlir::LogicalResult + matchAndRewrite(fir::XEmboxOp xbox, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto loc = xbox.getLoc(); + auto *dialect = getDialect(); + auto rank = xbox.getRank(); + auto ty = unwrap( + lowering.convertBoxType(xbox.getType().dyn_cast(), rank)); + + auto alloca = genAllocaWithType(loc, ty, defaultAlign, dialect, rewriter); + auto c0 = genConstantOffset(loc, rewriter, 0); + auto rty = unwrap(operands[0].getType()).getPointerTo(); + auto f0p = genGEP(loc, rty, rewriter, alloca, c0, c0); + auto f0p_ = rewriter.create(loc, rty, f0p); + rewriter.create(loc, operands[0], f0p_); + auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(dialect); + auto i64PtrTy = i64Ty.getPointerTo(); + auto f1p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 1); + auto c0_ = rewriter.create(loc, i64Ty, c0); + rewriter.create(loc, c0_, f1p); + auto i32PtrTy = mlir::LLVM::LLVMType::getInt32Ty(dialect).getPointerTo(); + auto f2p = genGEPToField(loc, i32PtrTy, rewriter, alloca, c0, 2); + rewriter.create(loc, c0, f2p); + auto i8Ty = mlir::LLVM::LLVMType::getInt8Ty(dialect); + auto i8PtrTy = mlir::LLVM::LLVMType::getInt8PtrTy(dialect); + auto c0__ = rewriter.create(loc, i8Ty, c0); + auto f3p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 3); + rewriter.create(loc, c0__, f3p); + auto f4p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 4); + rewriter.create(loc, c0__, f4p); + auto f5p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 5); + rewriter.create(loc, c0__, f5p); + auto f6p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 6); + rewriter.create(loc, c0__, f6p); + auto dimsIter = xbox.dimsOperands().begin(); + for (unsigned d = 0; d < rank; ++d) { + // store lower bound (normally 0) + auto f70p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 7, d, 0); + rewriter.create(loc, *dimsIter++, f70p); + // store extent + auto f71p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 7, d, 1); + rewriter.create(loc, *dimsIter++, f71p); + // store step (scaled by extent to save a multiplication) + auto f72p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 7, d, 2); + rewriter.create(loc, *dimsIter++, f72p); + } + rewriter.replaceOp(xbox, alloca.getResult()); + return success(); + } }; /// create a procedure pointer box @@ -1238,17 +1321,16 @@ struct EmboxProcOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::EmboxProcOp emboxproc, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - auto a = operands[0]; - auto b = operands[1]; auto loc = emboxproc.getLoc(); auto ctx = emboxproc.getContext(); auto ty = convertType(emboxproc.getType()); auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); auto un = rewriter.create(loc, ty); - auto r = rewriter.create(loc, ty, un, a, c0); - rewriter.replaceOpWithNewOp(emboxproc, ty, r, b, - c1); + auto r = rewriter.create(loc, ty, un, + operands[0], c0); + rewriter.replaceOpWithNewOp(emboxproc, ty, r, + operands[1], c1); return success(); } }; @@ -1351,7 +1433,79 @@ struct InsertValueOpConversion } }; -/// convert to reference to a reference to a subobject +/// InsertOnRange inserts a value into a sequence over a range of offsets. +struct InsertOnRangeOpConversion + : public FIROpAndTypeConversion { + using FIROpAndTypeConversion::FIROpAndTypeConversion; + + mlir::LogicalResult + doRewrite(fir::InsertOnRangeOp range, mlir::Type ty, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + TODO(); + return success(); + } +}; + +/// XArrayCoor is the address arithmetic on a dynamically shaped, etc. array. +/// (See the static restriction on coordinate_of.) array_coor determines the +/// coordinate (location) of a specific element. +struct XArrayCoorOpConversion + : public FIROpAndTypeConversion { + using FIROpAndTypeConversion::FIROpAndTypeConversion; + + mlir::LogicalResult + doRewrite(fir::XArrayCoorOp coor, mlir::Type ty, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + auto loc = coor.getLoc(); + auto rank = coor.getRank(); + assert(coor.indexOperands().size() == rank); + assert(coor.dimsOperands().size() == 3 * rank); + unsigned dimsOff = 1; + unsigned indexOff = 1 + coor.dimsOperands().size(); + // Cast the base address to a pointer to T + auto base = rewriter.create(loc, ty, operands[0]); + auto idxTy = lowering.indexType(); + mlir::Value prevExt = genConstantIndex(loc, idxTy, rewriter, 1); + mlir::Value off = genConstantIndex(loc, idxTy, rewriter, 0); + for (unsigned i = 0; i < rank; ++i) { + auto index = asType(loc, rewriter, idxTy, operands[indexOff++]); + auto lb = asType(loc, rewriter, idxTy, operands[dimsOff++]); + auto nextExt = asType(loc, rewriter, idxTy, operands[dimsOff++]); + auto step = asType(loc, rewriter, idxTy, operands[dimsOff++]); + // For each dimension, i, add to the running pointer offset the value of + // (index_i - lb_i) * step_i * extent_{i-1}. + // Note: LLVM will do constant folding, etc. + auto diff = rewriter.create(loc, idxTy, index, lb); + auto sc0 = rewriter.create(loc, idxTy, diff, step); + auto sc1 = rewriter.create(loc, idxTy, sc0, prevExt); + off = rewriter.create(loc, idxTy, sc1, off); + prevExt = + rewriter.create(loc, idxTy, prevExt, nextExt); + } + llvm::SmallVector args{base, off}; + rewriter.replaceOpWithNewOp(coor, ty, args); + return success(); + } + + mlir::Value asType(mlir::Location loc, + mlir::ConversionPatternRewriter &rewriter, + mlir::LLVM::LLVMType toTy, mlir::Value val) const { + auto *fromLLVMTy = unwrap(convertType(val.getType())).getUnderlyingType(); + auto *toLLVMTy = toTy.getUnderlyingType(); + assert(fromLLVMTy->isIntegerTy() && toLLVMTy->isIntegerTy()); + if (fromLLVMTy->getIntegerBitWidth() < toLLVMTy->getIntegerBitWidth()) + return rewriter.create(loc, toTy, val); + if (fromLLVMTy->getIntegerBitWidth() > toLLVMTy->getIntegerBitWidth()) + return rewriter.create(loc, toTy, val); + return val; + } +}; + +/// Convert to (memory) reference to a reference to a subobject. +/// The coordinate_of op is a Swiss army knife operation that can be used on +/// (memory) references to records, arrays, complex, etc. as well as boxes. +/// With unboxed arrays, there is the restriction that the array have a static +/// shape in all but the last column. struct CoordinateOpConversion : public FIROpAndTypeConversion { using FIROpAndTypeConversion::FIROpAndTypeConversion; @@ -1693,47 +1847,6 @@ struct FirEndOpConversion : public FIROpConversion { } }; -/// lower a gendims operation into a sequence of writes to a temp -/// TODO: should this be returning a value or a ref? A !fir.dims object has -/// very restricted application -struct GenDimsOpConversion : public FIROpConversion { - using FIROpConversion::FIROpConversion; - - // gendims(args:index, ...) ==> %v = ... : [size x <3 x index>] - mlir::LogicalResult - matchAndRewrite(fir::GenDimsOp gendims, OperandTy operands, - mlir::ConversionPatternRewriter &rewriter) const override { - auto loc = gendims.getLoc(); - auto ty = convertType(gendims.getType()); - auto ptrTy = unwrap(ty).getPointerTo(); - auto alloca = genAlloca(loc, ptrTy, defaultAlign, rewriter); - unsigned offIndex = 0; - auto c0 = genConstantOffset(loc, rewriter, 0); - auto ipty = lowering.indexType().getPointerTo(); - for (auto opd : operands) { - auto offset = genConstantOffset(loc, rewriter, offIndex++); - auto gep = genGEP(loc, ipty, rewriter, alloca, c0, c0, offset); - rewriter.create(loc, opd, gep); - } - rewriter.replaceOpWithNewOp(gendims, ptrTy, alloca); - return success(); - } - - // Generate an alloca of size `size` and cast it to type `toTy` - mlir::LLVM::AllocaOp - genAlloca(mlir::Location loc, mlir::LLVM::LLVMType toTy, unsigned alignment, - mlir::ConversionPatternRewriter &rewriter) const { - auto thisPt = rewriter.saveInsertionPoint(); - auto *thisBlock = rewriter.getInsertionBlock(); - auto func = mlir::cast(thisBlock->getParentOp()); - rewriter.setInsertionPointToStart(&func.front()); - auto size = genConstantOffset(loc, rewriter, 1); - auto rv = rewriter.create(loc, toTy, size, alignment); - rewriter.restoreInsertionPoint(thisPt); - return rv; - } -}; - /// lower a type descriptor to a global constant struct GenTypeDescOpConversion : public FIROpConversion { using FIROpConversion::FIROpConversion; @@ -2403,8 +2516,10 @@ struct FIRToLLVMLoweringPass auto *context{&getContext()}; FIRToLLVMTypeConverter typeConverter{context, uniquer}; - mlir::OwningRewritePatternList patterns; - patterns.insert< + auto loc = mlir::UnknownLoc::get(context); + + mlir::OwningRewritePatternList pattern; + pattern.insert< AddcOpConversion, AddfOpConversion, AddrOfOpConversion, AllocaOpConversion, AllocMemOpConversion, BoxAddrOpConversion, BoxCharLenOpConversion, BoxDimsOpConversion, BoxEleSizeOpConversion, @@ -2414,47 +2529,34 @@ struct FIRToLLVMLoweringPass ConstcOpConversion, ConstfOpConversion, ConvertOpConversion, CoordinateOpConversion, DispatchOpConversion, DispatchTableOpConversion, DivcOpConversion, DivfOpConversion, DTEntryOpConversion, - EmboxCharOpConversion, EmboxOpConversion, EmboxProcOpConversion, + EmboxOpConversion, EmboxCharOpConversion, EmboxProcOpConversion, FieldIndexOpConversion, FirEndOpConversion, ExtractValueOpConversion, - FreeMemOpConversion, GenDimsOpConversion, GenTypeDescOpConversion, - GlobalLenOpConversion, GlobalOpConversion, HasValueOpConversion, + FreeMemOpConversion, GenTypeDescOpConversion, GlobalLenOpConversion, + GlobalOpConversion, HasValueOpConversion, InsertOnRangeOpConversion, InsertValueOpConversion, LenParamIndexOpConversion, LoadOpConversion, ModfOpConversion, MulcOpConversion, MulfOpConversion, NegcOpConversion, NegfOpConversion, NoReassocOpConversion, SelectCaseOpConversion, SelectOpConversion, SelectRankOpConversion, SelectTypeOpConversion, StoreOpConversion, StringLitOpConversion, SubcOpConversion, SubfOpConversion, UnboxCharOpConversion, UnboxOpConversion, - UnboxProcOpConversion, UndefOpConversion, UnreachableOpConversion>( - context, typeConverter); - mlir::populateStdToLLVMConversionPatterns(typeConverter, patterns); + UnboxProcOpConversion, UndefOpConversion, UnreachableOpConversion, + XArrayCoorOpConversion, XEmboxOpConversion>(context, typeConverter); + mlir::populateStdToLLVMConversionPatterns(typeConverter, pattern); mlir::ConversionTarget target{*context}; target.addLegalDialect(); - // required NOP stubs for applying a full conversion - target.addDynamicallyLegalOp( - [&](mlir::ModuleOp) { return true; }); - target.addDynamicallyLegalOp( - [&](mlir::ModuleTerminatorOp) { return true; }); - - genDispatchTableMap(); + // required NOPs for applying a full conversion + target.addLegalOp(); // apply the patterns if (mlir::failed(mlir::applyFullConversion( - getModule(), target, std::move(patterns), &typeConverter))) { - mlir::emitError(mlir::UnknownLoc::get(context), - "error in converting to LLVM-IR dialect\n"); + getModule(), target, std::move(pattern), &typeConverter))) { + mlir::emitError(loc, "error in converting to LLVM-IR dialect\n"); signalPassFailure(); } } private: - void genDispatchTableMap() { - for (auto dt : getModule().getOps()) { - // FIXME - (void)dt; - } - } - fir::NameUniquer &uniquer; }; diff --git a/flang/lib/Optimizer/CodeGen/DescriptorModel.h b/flang/lib/Optimizer/CodeGen/DescriptorModel.h new file mode 100644 index 0000000000000..20af7ecc137f5 --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/DescriptorModel.h @@ -0,0 +1,150 @@ +//===-- DescriptorModel.h -- model of descriptors for codegen ---*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef OPTIMIZER_DESCRIPTOR_MODEL_H +#define OPTIMIZER_DESCRIPTOR_MODEL_H + +#include "../runtime/descriptor.h" +#include "flang/ISO_Fortran_binding.h" +#include "mlir/Dialect/LLVMIR/LLVMDialect.h" +#include "llvm/Support/ErrorHandling.h" +#include + +namespace fir { + +//===----------------------------------------------------------------------===// +// Static size information +//===----------------------------------------------------------------------===// + +static constexpr std::size_t sizeOfDimElement() { + return sizeof(Fortran::ISO::Fortran_2018::CFI_index_t); +} +static constexpr std::size_t sizeOfDimRow() { + return sizeof(Fortran::ISO::Fortran_2018::CFI_dim_t); +} +static constexpr std::size_t sizeOfBareDesc() { + return sizeof(Fortran::ISO::Fortran_2018::CFI_cdesc_t); +} +static constexpr std::size_t sizeOfDesc(unsigned rank) { + return sizeOfBareDesc() + rank * sizeOfDimRow(); +} +static constexpr std::size_t sizeOfTypeParam() { + return sizeof(Fortran::runtime::TypeParameterValue); +} +static constexpr std::size_t sizeOfDescAddendum() { + return sizeof(Fortran::runtime::DescriptorAddendum); +} +static constexpr std::size_t sizeOfExtendedDesc(unsigned rank, + unsigned lenParams) { + return sizeOfDesc(rank) + sizeOfDescAddendum() + + lenParams * sizeOfTypeParam(); +} + +//===----------------------------------------------------------------------===// +// Descriptor reflection +// +// This supplies a set of model builders to decompose the C declaration of a +// descriptor (as encoded in ISO_Fortran_binding.h and elsewhere) and +// reconstruct that type in the LLVM IR dialect. +// +//===----------------------------------------------------------------------===// + +using TypeBuilderFunc = mlir::LLVM::LLVMType (*)(mlir::LLVM::LLVMDialect *); + +template +TypeBuilderFunc getModel(); +template <> +TypeBuilderFunc getModel() { + return [](mlir::LLVM::LLVMDialect *dialect) { + return mlir::LLVM::LLVMType::getInt8PtrTy(dialect); + }; +} +template <> +TypeBuilderFunc getModel() { + return [](mlir::LLVM::LLVMDialect *dialect) { + return mlir::LLVM::LLVMType::getIntNTy(dialect, sizeof(uint32_t) * 8); + }; +} +template <> +TypeBuilderFunc getModel() { + return [](mlir::LLVM::LLVMDialect *dialect) { + return mlir::LLVM::LLVMType::getIntNTy(dialect, sizeof(int) * 8); + }; +} +template <> +TypeBuilderFunc getModel() { + return [](mlir::LLVM::LLVMDialect *dialect) { + return mlir::LLVM::LLVMType::getIntNTy(dialect, sizeof(uint64_t) * 8); + }; +} +template <> +TypeBuilderFunc getModel() { + return [](mlir::LLVM::LLVMDialect *dialect) { + return mlir::LLVM::LLVMType::getIntNTy( + dialect, sizeof(Fortran::ISO::CFI_rank_t) * 8); + }; +} +template <> +TypeBuilderFunc getModel() { + return [](mlir::LLVM::LLVMDialect *dialect) { + return mlir::LLVM::LLVMType::getIntNTy( + dialect, sizeof(Fortran::ISO::CFI_type_t) * 8); + }; +} +template <> +TypeBuilderFunc getModel() { + return [](mlir::LLVM::LLVMDialect *dialect) { + return mlir::LLVM::LLVMType::getIntNTy( + dialect, sizeof(Fortran::ISO::CFI_index_t) * 8); + }; +} +template <> +TypeBuilderFunc getModel() { + return [](mlir::LLVM::LLVMDialect *dialect) { + auto indexTy = getModel()(dialect); + return mlir::LLVM::LLVMType::getArrayTy(indexTy, 3); + }; +} +template <> +TypeBuilderFunc +getModel>() { + return getModel(); +} + +//===----------------------------------------------------------------------===// + +/// Get the type model of the field number `Field` in an ISO descriptor. +template +static constexpr TypeBuilderFunc getDescFieldTypeModel() { + Fortran::ISO::Fortran_2018::CFI_cdesc_t dummyDesc{}; + // check that the descriptor is exactly 8 fields + auto [a, b, c, d, e, f, g, h] = dummyDesc; + auto tup = std::tie(a, b, c, d, e, f, g, h); + auto field = std::get(tup); + return getModel(); +} + +/// An extended descriptor is defined by a class in runtime/descriptor.h. The +/// three fields in the class are hard-coded here, unlike the reflection used on +/// the ISO parts, which are a POD. +template +static constexpr TypeBuilderFunc getExtendedDescFieldTypeModel() { + if constexpr (Field == 8) { + return getModel(); + } else if constexpr (Field == 9) { + return getModel(); + } else if constexpr (Field == 10) { + return getModel(); + } else { + llvm_unreachable("extended ISO descriptor only has 11 fields"); + } +} + +} // namespace fir + +#endif // OPTIMIZER_DESCRIPTOR_MODEL_H diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index 913e42b29dbc4..2df13ad807bb5 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -5,69 +5,23 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// -// -// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ -// -//===----------------------------------------------------------------------===// -#include "CGOps.h" #include "PassDetail.h" #include "flang/Optimizer/CodeGen/CodeGen.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Dialect/FIRType.h" -#include "flang/Optimizer/Support/FIRContext.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Pass/Pass.h" #include "mlir/Transforms/DialectConversion.h" -#include "llvm/ADT/STLExtras.h" +#include "llvm/Support/CommandLine.h" #include "llvm/Support/Debug.h" -//===----------------------------------------------------------------------===// -// Codegen rewrite: rewriting of subgraphs of ops -//===----------------------------------------------------------------------===// - using namespace fir; -#define DEBUG_TYPE "flang-codegen-rewrite" - -static void populateShape(llvm::SmallVectorImpl &vec, - ShapeOp shape) { - vec.append(shape.extents().begin(), shape.extents().end()); -} - -// Operands of fir.shape_shift split into two vectors. -static void populateShapeAndShift(llvm::SmallVectorImpl &shapeVec, - llvm::SmallVectorImpl &shiftVec, - ShapeShiftOp shift) { - auto endIter = shift.pairs().end(); - for (auto i = shift.pairs().begin(); i != endIter;) { - shiftVec.push_back(*i++); - shapeVec.push_back(*i++); - } -} - -static void populateShift(llvm::SmallVectorImpl &vec, - ShiftOp shift) { - vec.append(shift.origins().begin(), shift.origins().end()); -} - namespace { /// Convert fir.embox to the extended form where necessary. -/// -/// The embox operation can take arguments that specify multidimensional array -/// properties at runtime. These properties may be shared between distinct -/// objects that have the same properties. Before we lower these small DAGs to -/// LLVM-IR, we gather all the information into a single extended operation. For -/// example, -/// ``` -/// %1 = fir.shape_shift %4, %5 : (index, index) -> !fir.shapeshift<1> -/// %2 = fir.slice %6, %7, %8 : (index, index, index) -> !fir.slice<1> -/// %3 = fir.embox %0 (%1) [%2] : (!fir.ref>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box> -/// ``` -/// can be rewritten as -/// ``` -/// %1 = fircg.ext_embox %0(%5) origin %4[%6, %7, %8] : (!fir.ref>, index, index, index, index, index) -> !fir.box> -/// ``` class EmboxConversion : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -75,124 +29,33 @@ class EmboxConversion : public mlir::OpRewritePattern { mlir::LogicalResult matchAndRewrite(EmboxOp embox, mlir::PatternRewriter &rewriter) const override { - auto shapeVal = embox.getShape(); - // If the embox does not include a shape, then do not convert it - if (shapeVal) - return rewriteDynamicShape(embox, rewriter, shapeVal); - if (auto boxTy = embox.getType().dyn_cast()) - if (auto seqTy = boxTy.getEleTy().dyn_cast()) - if (seqTy.hasConstantShape()) - return rewriteStaticShape(embox, rewriter, seqTy); - return mlir::failure(); - } - - mlir::LogicalResult rewriteStaticShape(EmboxOp embox, - mlir::PatternRewriter &rewriter, - SequenceType seqTy) const { auto loc = embox.getLoc(); - llvm::SmallVector shapeOpers; + auto dimsVal = embox.getDims(); + if (!dimsVal) + return mlir::failure(); + auto dimsOp = dyn_cast(dimsVal.getDefiningOp()); + assert(dimsOp && "dims is not a fir.gendims"); + mlir::NamedAttrList attrs; + auto lenParamSize = embox.getLenParams().size(); auto idxTy = rewriter.getIndexType(); - for (auto ext : seqTy.getShape()) { - auto iAttr = rewriter.getIndexAttr(ext); - auto extVal = rewriter.create(loc, idxTy, iAttr); - shapeOpers.push_back(extVal); - } - auto xbox = rewriter.create( - loc, embox.getType(), embox.memref(), shapeOpers, llvm::None, - llvm::None, llvm::None, embox.lenParams()); - LLVM_DEBUG(llvm::dbgs() << "rewriting " << embox << " to " << xbox << '\n'); - rewriter.replaceOp(embox, xbox.getOperation()->getResults()); - return mlir::success(); - } - - mlir::LogicalResult rewriteDynamicShape(EmboxOp embox, - mlir::PatternRewriter &rewriter, - mlir::Value shapeVal) const { - auto loc = embox.getLoc(); - auto shapeOp = dyn_cast(shapeVal.getDefiningOp()); - llvm::SmallVector shapeOpers; - llvm::SmallVector shiftOpers; - if (shapeOp) { - populateShape(shapeOpers, shapeOp); - } else { - auto shiftOp = dyn_cast(shapeVal.getDefiningOp()); - assert(shiftOp && "shape is neither fir.shape nor fir.shape_shift"); - populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); - } - llvm::SmallVector sliceOpers; - llvm::SmallVector subcompOpers; - if (auto s = embox.getSlice()) - if (auto sliceOp = dyn_cast_or_null(s.getDefiningOp())) { - sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); - subcompOpers.append(sliceOp.fields().begin(), sliceOp.fields().end()); - } - auto xbox = rewriter.create( - loc, embox.getType(), embox.memref(), shapeOpers, shiftOpers, - sliceOpers, subcompOpers, embox.lenParams()); - LLVM_DEBUG(llvm::dbgs() << "rewriting " << embox << " to " << xbox << '\n'); + auto lenParamAttr = rewriter.getIntegerAttr(idxTy, lenParamSize); + attrs.push_back( + rewriter.getNamedAttr(XEmboxOp::lenParamAttrName(), lenParamAttr)); + auto dimsSize = dimsOp.getNumOperands(); + auto dimAttr = rewriter.getIntegerAttr(idxTy, dimsSize); + attrs.push_back(rewriter.getNamedAttr(XEmboxOp::dimsAttrName(), dimAttr)); + auto rank = dimsOp.getType().cast().getRank(); + auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); + attrs.push_back(rewriter.getNamedAttr(XEmboxOp::rankAttrName(), rankAttr)); + auto xbox = rewriter.create(loc, embox.getType(), embox.memref(), + embox.getLenParams(), + dimsOp.getOperands(), attrs); rewriter.replaceOp(embox, xbox.getOperation()->getResults()); return mlir::success(); } }; -/// Convert fir.rebox to the extended form where necessary. -/// -/// For example, -/// ``` -/// %5 = fir.rebox %3(%1) : (!fir.box>, !fir.shapeshift<1>) -> !fir.box> -/// ``` -/// converted to -/// ``` -/// %5 = fircg.ext_rebox %3(%13) origin %12 : (!fir.box>, index, index) -> !fir.box> -/// ``` -class ReboxConversion : public mlir::OpRewritePattern { -public: - using OpRewritePattern::OpRewritePattern; - - mlir::LogicalResult - matchAndRewrite(ReboxOp rebox, - mlir::PatternRewriter &rewriter) const override { - auto loc = rebox.getLoc(); - llvm::SmallVector shapeOpers; - llvm::SmallVector shiftOpers; - if (auto shapeVal = rebox.shape()) { - if (auto shapeOp = dyn_cast(shapeVal.getDefiningOp())) - populateShape(shapeOpers, shapeOp); - else if (auto shiftOp = dyn_cast(shapeVal.getDefiningOp())) - populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); - else if (auto shiftOp = dyn_cast(shapeVal.getDefiningOp())) - populateShift(shiftOpers, shiftOp); - else - return mlir::failure(); - } - llvm::SmallVector sliceOpers; - llvm::SmallVector subcompOpers; - if (auto s = rebox.slice()) - if (auto sliceOp = dyn_cast_or_null(s.getDefiningOp())) { - sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); - subcompOpers.append(sliceOp.fields().begin(), sliceOp.fields().end()); - } - - auto xRebox = rewriter.create( - loc, rebox.getType(), rebox.box(), shapeOpers, shiftOpers, sliceOpers, - subcompOpers); - LLVM_DEBUG(llvm::dbgs() - << "rewriting " << rebox << " to " << xRebox << '\n'); - rewriter.replaceOp(rebox, xRebox.getOperation()->getResults()); - return mlir::success(); - } -}; - /// Convert all fir.array_coor to the extended form. -/// -/// For example, -/// ``` -/// %4 = fir.array_coor %addr (%1) [%2] %0 : (!fir.ref>, !fir.shapeshift<1>, !fir.slice<1>, index) -> !fir.ref -/// ``` -/// converted to -/// ``` -/// %40 = fircg.ext_array_coor %addr(%9) origin %8[%4, %5, %6<%39> : (!fir.ref>, index, index, index, index, index, index) -> !fir.ref -/// ``` class ArrayCoorConversion : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -201,64 +64,101 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { matchAndRewrite(ArrayCoorOp arrCoor, mlir::PatternRewriter &rewriter) const override { auto loc = arrCoor.getLoc(); - llvm::SmallVector shapeOpers; - llvm::SmallVector shiftOpers; - if (auto shapeVal = arrCoor.shape()) { - if (auto shapeOp = dyn_cast(shapeVal.getDefiningOp())) - populateShape(shapeOpers, shapeOp); - else if (auto shiftOp = dyn_cast(shapeVal.getDefiningOp())) - populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); - else if (auto shiftOp = dyn_cast(shapeVal.getDefiningOp())) - populateShift(shiftOpers, shiftOp); - else - return mlir::failure(); - } - llvm::SmallVector sliceOpers; - llvm::SmallVector subcompOpers; - if (auto s = arrCoor.slice()) - if (auto sliceOp = dyn_cast_or_null(s.getDefiningOp())) { - sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); - subcompOpers.append(sliceOp.fields().begin(), sliceOp.fields().end()); - } - auto xArrCoor = rewriter.create( - loc, arrCoor.getType(), arrCoor.memref(), shapeOpers, shiftOpers, - sliceOpers, subcompOpers, arrCoor.indices(), arrCoor.lenParams()); - LLVM_DEBUG(llvm::dbgs() - << "rewriting " << arrCoor << " to " << xArrCoor << '\n'); + auto dimsVal = arrCoor.dims(); + auto dimsOp = dyn_cast(dimsVal.getDefiningOp()); + assert(dimsOp && "dims is not a fir.gendims"); + mlir::NamedAttrList attrs; + auto indexSize = arrCoor.coor().size(); + auto idxTy = rewriter.getIndexType(); + auto idxAttr = rewriter.getIntegerAttr(idxTy, indexSize); + attrs.push_back( + rewriter.getNamedAttr(XArrayCoorOp::indexAttrName(), idxAttr)); + auto dimsSize = dimsOp.getNumOperands(); + auto dimAttr = rewriter.getIntegerAttr(idxTy, dimsSize); + attrs.push_back( + rewriter.getNamedAttr(XArrayCoorOp::dimsAttrName(), dimAttr)); + auto rank = dimsOp.getType().cast().getRank(); + auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); + attrs.push_back( + rewriter.getNamedAttr(XArrayCoorOp::rankAttrName(), rankAttr)); + auto xArrCoor = rewriter.create( + loc, arrCoor.getType(), arrCoor.ref(), dimsOp.getOperands(), + arrCoor.coor(), attrs); rewriter.replaceOp(arrCoor, xArrCoor.getOperation()->getResults()); return mlir::success(); } }; +/// Convert FIR structured control flow ops to CFG ops. class CodeGenRewrite : public CodeGenRewriteBase { public: - void runOnOperation() override final { - auto op = getOperation(); + void runOnFunction() override final { auto &context = getContext(); - mlir::OpBuilder rewriter(&context); + mlir::OwningRewritePatternList patterns(&context); + patterns.insert(&context); mlir::ConversionTarget target(context); - target.addLegalDialect(); + target.addLegalDialect(); target.addIllegalOp(); - target.addIllegalOp(); - target.addDynamicallyLegalOp([](EmboxOp embox) { - return !(embox.getShape() || - embox.getType().cast().getEleTy().isa()); - }); - mlir::OwningRewritePatternList patterns(&context); - patterns.insert( - &context); - if (mlir::failed( - mlir::applyPartialConversion(op, target, std::move(patterns)))) { + target.addDynamicallyLegalOp( + [](EmboxOp embox) { return !embox.getDims(); }); + + // Do the conversions. + if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, + std::move(patterns)))) { mlir::emitError(mlir::UnknownLoc::get(&context), "error in running the pre-codegen conversions"); signalPassFailure(); } + + // Erase any residual. + simplifyRegion(getFunction().getBody()); } + + // Clean up the region. + void simplifyRegion(mlir::Region ®ion) { + for (auto &block : region.getBlocks()) + for (auto &op : block.getOperations()) { + if (op.getNumRegions() != 0) + for (auto ® : op.getRegions()) + simplifyRegion(reg); + maybeEraseOp(&op); + } + + for (auto *op : opsToErase) + op->erase(); + opsToErase.clear(); + } + + void maybeEraseOp(mlir::Operation *op) { + // Erase any embox that was replaced. + if (auto embox = dyn_cast_or_null(op)) + if (embox.getDims()) { + assert(op->use_empty()); + opsToErase.push_back(op); + } + + // Erase all fir.array_coor. + if (auto arrCoor = dyn_cast_or_null(op)) { + assert(op->use_empty()); + opsToErase.push_back(op); + } + + // Erase all fir.gendims ops. + if (auto genDims = dyn_cast_or_null(op)) { + assert(op->use_empty()); + opsToErase.push_back(op); + } + } + +private: + std::vector opsToErase; }; } // namespace +/// Convert FIR's structured control flow ops to CFG ops. This +/// conversion enables the `createLowerToCFGPass` to transform these to CFG +/// form. std::unique_ptr fir::createFirCodeGenRewritePass() { return std::make_unique(); } diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp index 2900e4357f509..868984056f52e 100644 --- a/flang/lib/Optimizer/Dialect/FIROps.cpp +++ b/flang/lib/Optimizer/Dialect/FIROps.cpp @@ -556,6 +556,17 @@ static mlir::LogicalResult verify(fir::EmboxOp op) { return mlir::success(); } +/// Get the dims argument to the embox op. If there was no dims argument (i.e., +/// the box is on a scalar), then return an null value. +mlir::Value fir::EmboxOp::getDims() { + auto size = dims().size(); + if (size > 0) { + assert(size == 1 && "incorrect number of dims arguments"); + return *dims().begin(); + } + return {}; +} + //===----------------------------------------------------------------------===// // GenTypeDescOp //===----------------------------------------------------------------------===// @@ -1846,6 +1857,64 @@ void fir::IfOp::resultToSourceOps(llvm::SmallVectorImpl &results, results.push_back(term->getOperand(resultNum)); } +//===----------------------------------------------------------------------===// +// Internal ops +//===----------------------------------------------------------------------===// + +void fir::XArrayCoorOp::build(mlir::OpBuilder &builder, OperationState &result, + mlir::Type ty, mlir::Value memref, + mlir::ValueRange dims, mlir::ValueRange indices, + llvm::ArrayRef attr) { + result.addOperands(memref); + result.addOperands(dims); + result.addOperands(indices); + result.addTypes(ty); + result.addAttributes(attr); +} + +mlir::Operation::operand_range fir::XArrayCoorOp::dimsOperands() { + auto first = std::next(getOperation()->operand_begin()); + auto off = getAttrOfType(dimsAttrName()).getInt(); + return {first, first + off}; +} + +mlir::Operation::operand_range fir::XArrayCoorOp::indexOperands() { + auto off = getAttrOfType(dimsAttrName()).getInt(); + auto first = std::next(getOperation()->operand_begin() + off); + return {first, getOperation()->operand_end()}; +} + +unsigned fir::XArrayCoorOp::getRank() { + return getAttrOfType(rankAttrName()).getInt(); +} + +void fir::XEmboxOp::build(mlir::OpBuilder &builder, OperationState &result, + mlir::Type ty, mlir::Value memref, + mlir::ValueRange lenParams, mlir::ValueRange dims, + llvm::ArrayRef attr) { + result.addOperands(memref); + result.addOperands(lenParams); + result.addOperands(dims); + result.addTypes(ty); + result.addAttributes(attr); +} + +mlir::Operation::operand_range fir::XEmboxOp::lenParamOperands() { + auto first = std::next(getOperation()->operand_begin()); + auto off = getAttrOfType(lenParamAttrName()).getInt(); + return {first, first + off}; +} + +mlir::Operation::operand_range fir::XEmboxOp::dimsOperands() { + auto off = getAttrOfType(lenParamAttrName()).getInt(); + auto first = std::next(getOperation()->operand_begin() + off); + return {first, getOperation()->operand_end()}; +} + +unsigned fir::XEmboxOp::getRank() { + return getAttrOfType(rankAttrName()).getInt(); +} + //===----------------------------------------------------------------------===// mlir::ParseResult fir::isValidCaseAttr(mlir::Attribute attr) { diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp index fda5525c540be..641015935dbbb 100644 --- a/flang/lib/Optimizer/Transforms/CSE.cpp +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -301,9 +301,8 @@ void BasicCSE::runOnFunction() { simplifyRegion(knownValues, getAnalysis(), getFunction().getBody()); } - if (!leaveEffects) { + if (!leaveEffects) cleanupRegion(getFunction().getBody()); - } // If no operations were erased, then we mark all analyses as preserved. if (opsToErase.empty()) diff --git a/flang/lib/Optimizer/Transforms/PassDetail.h b/flang/lib/Optimizer/Transforms/PassDetail.h index 528cff34a3f51..cc728bf8fe0f0 100644 --- a/flang/lib/Optimizer/Transforms/PassDetail.h +++ b/flang/lib/Optimizer/Transforms/PassDetail.h @@ -17,6 +17,6 @@ namespace fir { #define GEN_PASS_CLASSES #include "flang/Optimizer/Transforms/Passes.h.inc" -} // end namespace mlir +} // namespace fir #endif // OPTMIZER_TRANSFORMS_PASSDETAIL_H_ diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index fadd39ce262b9..539ee7170ee71 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -269,7 +269,7 @@ class CfgConversion : public CFGConversionBase { auto *context = &getContext(); mlir::OwningRewritePatternList patterns; patterns.insert(context); - mlir::ConversionTarget target = *context; + mlir::ConversionTarget target(*context); target.addLegalDialect(); diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index ff6bd650b4b60..e9218b93480e7 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -17,11 +17,10 @@ #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Support/Verifier.h" -#include "flang/Optimizer/CodeGen/CodeGen.h" #include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/OptPasses.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Optimizer/Support/KindMapping.h" -#include "flang/Optimizer/Transforms/Passes.h" #include "flang/Parser/characters.h" #include "flang/Parser/dump-parse-tree.h" #include "flang/Parser/message.h" @@ -247,6 +246,7 @@ static void convertFortranSourceToMLIR( if (emitLLVM) { // Continue to lower from MLIR down to LLVM IR. Emit LLVM and MLIR. + pm.addPass(fir::createFirCodeGenRewritePass()); pm.addPass(fir::createFIRToLLVMPass(nameUniquer)); std::error_code ec; llvm::ToolOutputFile outFile(outputName + ".ll", ec, @@ -277,7 +277,7 @@ static void convertFortranSourceToMLIR( int main(int argc, char **argv) { fir::registerFIR(); fir::registerFIRPasses(); - fir::registerOptTransformPasses(); + fir::registerOptPasses(); [[maybe_unused]] llvm::InitLLVM y(argc, argv); mlir::registerPassManagerCLOptions(); From 8091f8f6600ccbb91871957b1850482e3f5de741 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 17 Jun 2020 17:26:14 -0700 Subject: [PATCH 0099/1017] [prep] Some technical debt and warning elimination for upstreaming --- flang/lib/Lower/Bridge.cpp | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 7c4d75bfbe915..d440b2eb01fde 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -235,11 +235,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { // AbstractConverter overrides //===--------------------------------------------------------------------===// - /// Find the symbol in the local map or return null. - mlir::Value lookupSymbol(const Fortran::semantics::Symbol &sym) { - if (auto v = localSymbols.lookupSymbol(sym)) - return v; - return {}; + mlir::Value getSymbolAddress(Fortran::lower::SymbolRef sym) override final { + return fir::getBase(lookupSymbol(sym)); } mlir::Value genExprAddr(const Fortran::lower::SomeExpr &expr, @@ -355,6 +352,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { return createSomeExpression(loc, *this, *expr, localSymbols); } + /// Find the symbol in the local map or return null. + mlir::Value lookupSymbol(const Fortran::semantics::Symbol &sym) { + if (auto v = localSymbols.lookupSymbol(sym)) + return v; + return {}; + } + /// Add the symbol to the local map. If the symbol is already in the map, it /// is not updated. Instead the value `false` is returned. bool addSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val, From 13b9877ec005fe243b3c32d2a467dfa5acc81e8f Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 16 Jun 2020 17:20:45 -0700 Subject: [PATCH 0100/1017] Make sure the DO variable is always initialized. --- flang/lib/Lower/Bridge.cpp | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index d440b2eb01fde..d5e074cc87e0a 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -755,23 +755,27 @@ class FirConverter : public Fortran::lower::AbstractConverter { info.isStructured() ? builder->getIndexType() : info.loopVariableType; auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); auto upperValue = genFIRLoopIndex(info.upperExpr, type); - info.stepValue = info.stepExpr.has_value() - ? genFIRLoopIndex(*info.stepExpr, type) - : info.isStructured() - ? builder->create(loc, 1) - : builder->createIntegerConstant( - loc, info.loopVariableType, 1); + info.stepValue = + info.stepExpr.has_value() ? genFIRLoopIndex(*info.stepExpr, type) + : info.isStructured() + ? builder->create(loc, 1) + : builder->createIntegerConstant(loc, info.loopVariableType, 1); assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(loc, *info.loopVariableSym); // Structured loop - generate fir.loop. if (info.isStructured()) { + // Perform the default initial assignment of the DO variable. + auto lowerVal = + builder->createConvert(loc, info.loopVariableType, lowerValue); + builder->create(loc, lowerVal, info.loopVariable); info.insertionPoint = builder->saveInsertionPoint(); info.doLoop = builder->create(loc, lowerValue, upperValue, info.stepValue); builder->setInsertionPointToStart(info.doLoop.getBody()); - // Always store iteration ssa-value to the LCV to avoid missing any - // aliasing of the LCV. + // Always store iteration ssa-value to the DO variable to avoid missing + // any aliasing. Note that this assignment can only happen when executing + // an iteration of the loop. auto lcv = builder->createConvert(loc, info.loopVariableType, info.doLoop.getInductionVar()); builder->create(loc, lcv, info.loopVariable); From d3926d5196671be73fff90aaea97a701fc090bb2 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 17 Jun 2020 18:45:33 -0700 Subject: [PATCH 0101/1017] Move initialization to cover both structured and unstructured cases. --- flang/lib/Lower/Bridge.cpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index d5e074cc87e0a..715fdf177b828 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -762,13 +762,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { : builder->createIntegerConstant(loc, info.loopVariableType, 1); assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(loc, *info.loopVariableSym); + auto lowerVal = + builder->createConvert(loc, info.loopVariableType, lowerValue); + builder->create(loc, lowerVal, info.loopVariable); // Structured loop - generate fir.loop. if (info.isStructured()) { // Perform the default initial assignment of the DO variable. - auto lowerVal = - builder->createConvert(loc, info.loopVariableType, lowerValue); - builder->create(loc, lowerVal, info.loopVariable); info.insertionPoint = builder->saveInsertionPoint(); info.doLoop = builder->create(loc, lowerValue, upperValue, info.stepValue); From fa071616a91a6af1428ada6331ff952a004dca20 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 18 Jun 2020 10:00:26 -0700 Subject: [PATCH 0102/1017] fix for mac headers --- flang/lib/Optimizer/CodeGen/DescriptorModel.h | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/DescriptorModel.h b/flang/lib/Optimizer/CodeGen/DescriptorModel.h index 20af7ecc137f5..5be34ffea67ce 100644 --- a/flang/lib/Optimizer/CodeGen/DescriptorModel.h +++ b/flang/lib/Optimizer/CodeGen/DescriptorModel.h @@ -65,9 +65,9 @@ TypeBuilderFunc getModel() { }; } template <> -TypeBuilderFunc getModel() { +TypeBuilderFunc getModel() { return [](mlir::LLVM::LLVMDialect *dialect) { - return mlir::LLVM::LLVMType::getIntNTy(dialect, sizeof(uint32_t) * 8); + return mlir::LLVM::LLVMType::getIntNTy(dialect, sizeof(unsigned) * 8); }; } template <> @@ -77,9 +77,16 @@ TypeBuilderFunc getModel() { }; } template <> -TypeBuilderFunc getModel() { +TypeBuilderFunc getModel() { return [](mlir::LLVM::LLVMDialect *dialect) { - return mlir::LLVM::LLVMType::getIntNTy(dialect, sizeof(uint64_t) * 8); + return mlir::LLVM::LLVMType::getIntNTy(dialect, sizeof(unsigned long) * 8); + }; +} +template <> +TypeBuilderFunc getModel() { + return [](mlir::LLVM::LLVMDialect *dialect) { + return mlir::LLVM::LLVMType::getIntNTy(dialect, + sizeof(unsigned long long) * 8); }; } template <> From 8439774c0044080e16aa2dce06f68ad5c8015150 Mon Sep 17 00:00:00 2001 From: V Donaldson Date: Tue, 16 Jun 2020 21:07:13 -0700 Subject: [PATCH 0103/1017] Address a variety of overlapping issues - - fix test fm255.f: accommodate jumps into a construct and fix problems with assigned and computed gotos nested in constructs (fixes #151) - fix a bug in iomsg specifier processing uncovered by IR verification - add a TODO for a verification problem with character select case constructs - fix several problems processing subprograms with internal subprograms - set up information for generating an assigned format string --- flang/lib/Lower/Bridge.cpp | 44 +++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 715fdf177b828..61cb08606b8bf 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -547,7 +547,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { blockList.push_back(blockOfLabel(eval, altReturn->v)); } } - blockList.push_back(eval.lexicalSuccessor->block); // default = fallthrough + blockList.push_back(eval.nonNopSuccessor()->block); // default = fallthrough builder->create(toLocation(), res, indexList, blockList); } @@ -578,7 +578,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { indexList.push_back(++index); blockList.push_back(blockOfLabel(eval, label)); } - blockList.push_back(eval.lexicalSuccessor->block); // default + blockList.push_back(eval.nonNopSuccessor()->block); // default builder->create(toLocation(), selectExpr, indexList, blockList); } @@ -661,12 +661,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { }; // Add labels from an explicit list. The list may have duplicates. for (auto &label : std::get>(stmt.t)) { - if (labelSet.count(label) == 0) { - // Ignore labels with no ASSIGN statements for the selector variable. - continue; - } - if (std::find(indexList.begin(), indexList.end(), label) == - indexList.end()) { // ignore duplicates + if (labelSet.count(label) && + std::find(indexList.begin(), indexList.end(), label) == + indexList.end()) { // ignore duplicates addLabel(label); } } @@ -678,7 +675,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // Add a nop/fallthrough branch to the switch for a nonconforming program // unit that violates the program requirement above. - blockList.push_back(eval.lexicalSuccessor->block); // default + blockList.push_back(eval.nonNopSuccessor()->block); // default builder->create(loc, selectExpr, indexList, blockList); } @@ -947,15 +944,19 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto &eval = getEval(); using ScalarExpr = Fortran::parser::Scalar; MLIRContext *context = builder->getContext(); - const auto selectExpr = genExprValue( + auto loc = toLocation(); + auto selectExpr = genExprValue( *Fortran::semantics::GetExpr(std::get(stmt.t))); - const auto selectType = selectExpr.getType(); + auto selectType = selectExpr.getType(); + Fortran::lower::CharacterExprHelper helper{*builder, loc}; + if (helper.isCharacter(selectExpr.getType())) { + TODO(); + } llvm::SmallVector attrList; llvm::SmallVector valueList; llvm::SmallVector blockList; auto *defaultBlock = eval.parentConstruct->constructExit->block; using CaseValue = Fortran::parser::Scalar; - auto loc = toLocation(); auto addValue = [&](const CaseValue &caseValue) { const auto *expr = Fortran::semantics::GetExpr(caseValue.thing); const auto v = Fortran::evaluate::ToInt64(*expr); @@ -1074,12 +1075,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { genIoConditionBranches(getEval(), stmt.v, iostat); } void genFIR(const Fortran::parser::PrintStmt &stmt) { - genPrintStatement(*this, stmt, - getEval().getOwningProcedure()->labelEvaluationMap); + auto &owningProc = *getEval().getOwningProcedure(); + genPrintStatement(*this, stmt, owningProc.labelEvaluationMap, + owningProc.assignSymbolLabelMap); } void genFIR(const Fortran::parser::ReadStmt &stmt) { - auto iostat = genReadStatement( - *this, stmt, getEval().getOwningProcedure()->labelEvaluationMap); + auto &owningProc = *getEval().getOwningProcedure(); + auto iostat = genReadStatement(*this, stmt, owningProc.labelEvaluationMap, + owningProc.assignSymbolLabelMap); genIoConditionBranches(getEval(), stmt.controls, iostat); } void genFIR(const Fortran::parser::RewindStmt &stmt) { @@ -1091,8 +1094,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { genIoConditionBranches(getEval(), stmt.v, iostat); } void genFIR(const Fortran::parser::WriteStmt &stmt) { - auto iostat = genWriteStatement( - *this, stmt, getEval().getOwningProcedure()->labelEvaluationMap); + auto &owningProc = *getEval().getOwningProcedure(); + auto iostat = genWriteStatement(*this, stmt, owningProc.labelEvaluationMap, + owningProc.assignSymbolLabelMap); genIoConditionBranches(getEval(), stmt.controls, iostat); } @@ -1137,12 +1141,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { } if (errBlock) { indexList.push_back(0); - blockList.push_back(eval.lexicalSuccessor->block); + blockList.push_back(eval.nonNopSuccessor()->block); // ERR label statement is the default successor. blockList.push_back(errBlock); } else { // Fallthrough successor statement is the default successor. - blockList.push_back(eval.lexicalSuccessor->block); + blockList.push_back(eval.nonNopSuccessor()->block); } builder->create(loc, selector, indexList, blockList); } From 1faaa219b9eebc0a9e89b751466a622d6515769b Mon Sep 17 00:00:00 2001 From: V Donaldson Date: Wed, 17 Jun 2020 18:07:35 -0700 Subject: [PATCH 0104/1017] review update --- flang/lib/Lower/Bridge.cpp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 61cb08606b8bf..0eb780ee607b9 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -547,7 +547,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { blockList.push_back(blockOfLabel(eval, altReturn->v)); } } - blockList.push_back(eval.nonNopSuccessor()->block); // default = fallthrough + blockList.push_back(eval.nonNopSuccessor().block); // default = fallthrough builder->create(toLocation(), res, indexList, blockList); } @@ -578,7 +578,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { indexList.push_back(++index); blockList.push_back(blockOfLabel(eval, label)); } - blockList.push_back(eval.nonNopSuccessor()->block); // default + blockList.push_back(eval.nonNopSuccessor().block); // default builder->create(toLocation(), selectExpr, indexList, blockList); } @@ -675,7 +675,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // Add a nop/fallthrough branch to the switch for a nonconforming program // unit that violates the program requirement above. - blockList.push_back(eval.nonNopSuccessor()->block); // default + blockList.push_back(eval.nonNopSuccessor().block); // default builder->create(loc, selectExpr, indexList, blockList); } @@ -1141,12 +1141,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { } if (errBlock) { indexList.push_back(0); - blockList.push_back(eval.nonNopSuccessor()->block); + blockList.push_back(eval.nonNopSuccessor().block); // ERR label statement is the default successor. blockList.push_back(errBlock); } else { // Fallthrough successor statement is the default successor. - blockList.push_back(eval.nonNopSuccessor()->block); + blockList.push_back(eval.nonNopSuccessor().block); } builder->create(loc, selector, indexList, blockList); } From cc47bc71d04362e3fbc6f4a5f96f82f4d247deb0 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 18 Jun 2020 19:54:17 -0700 Subject: [PATCH 0105/1017] fix for out-of-tree when the install includes flang --- flang/tools/bbc/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/tools/bbc/CMakeLists.txt b/flang/tools/bbc/CMakeLists.txt index c1668b80881d5..439ba00fb863c 100644 --- a/flang/tools/bbc/CMakeLists.txt +++ b/flang/tools/bbc/CMakeLists.txt @@ -13,6 +13,6 @@ set(LIBS FortranLower ) -add_llvm_tool(bbc bbc.cpp) +add_flang_tool(bbc bbc.cpp) llvm_update_compile_flags(bbc) target_link_libraries(bbc PRIVATE ${LIBS}) From f0a0e0f6e93edae69c68c5ecc8bf549fe16515d1 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 19 Jun 2020 10:16:56 -0700 Subject: [PATCH 0106/1017] [cleanup] finish the removal of some punning once used for transitioning --- flang/include/flang/Lower/ConvertExpr.h | 4 ++-- flang/lib/Lower/Bridge.cpp | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h index 93e15475852db..ff322aa231e9b 100644 --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -58,7 +58,7 @@ mlir::Value createSomeExpression(mlir::Location loc, SymMap &symMap); /// Create an extended expression value. -ExValue +fir::ExtendedValue createSomeExtendedExpression(mlir::Location loc, AbstractConverter &converter, const evaluate::Expr &expr, SymMap &symMap, llvm::ArrayRef lcvs); @@ -71,7 +71,7 @@ mlir::Value createSomeAddress(mlir::Location loc, AbstractConverter &converter, SymMap &symMap); /// Create an extended expression address. -ExValue +fir::ExtendedValue createSomeExtendedAddress(mlir::Location loc, AbstractConverter &converter, const evaluate::Expr &expr, SymMap &symMap, llvm::ArrayRef lcvs); diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 0eb780ee607b9..4397519966d31 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1272,14 +1272,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } - Fortran::lower::ExValue genExprEleValue(const Fortran::lower::SomeExpr &expr, - llvm::ArrayRef lcvs) { + fir::ExtendedValue genExprEleValue(const Fortran::lower::SomeExpr &expr, + llvm::ArrayRef lcvs) { return createSomeExtendedExpression(toLocation(), *this, expr, localSymbols, lcvs); } - Fortran::lower::ExValue genExprEleAddr(const Fortran::lower::SomeExpr &expr, - llvm::ArrayRef lcvs) { + fir::ExtendedValue genExprEleAddr(const Fortran::lower::SomeExpr &expr, + llvm::ArrayRef lcvs) { return createSomeExtendedAddress(toLocation(), *this, expr, localSymbols, lcvs); } From 02bb1b6c7a7ddb6e8d522e98071553d04f2fd418 Mon Sep 17 00:00:00 2001 From: rajan Date: Fri, 19 Jun 2020 22:55:00 -0400 Subject: [PATCH 0107/1017] converting fir memory ops to affine ops for affine promotion (#185) * using affine-map for index calculations * conversion from fir ref type to mlir memref * upper bound increment when going to affine --- .../Optimizer/Transforms/AffinePromotion.cpp | 207 +++++++++++++++--- 1 file changed, 173 insertions(+), 34 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index a304db8bb387f..495502160a078 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -9,6 +9,7 @@ #include "PassDetail.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" #include "flang/Optimizer/Transforms/Passes.h" #include "mlir/Dialect/Affine/IR/AffineOps.h" #include "mlir/Dialect/StandardOps/IR/Ops.h" @@ -30,21 +31,32 @@ static llvm::cl::opt using namespace fir; namespace { +class AffineFunctionAnalysis; +class AffineLoopAnalysis; class AffineLoopAnalysis { public: - AffineLoopAnalysis(fir::LoopOp op) : legality(analyzeLoop(op)) {} + AffineLoopAnalysis(fir::LoopOp op, AffineFunctionAnalysis &afa) + : legality(analyzeLoop(op, afa)) {} bool canPromoteToAffine() { return legality; } Optional step; + friend AffineFunctionAnalysis; private: bool legality; - bool analyzeLoop(fir::LoopOp op) { - return analyzeStep(op.step()) && analyzeMemoryAccess(op); + struct MemoryLoadAnalysis {}; + DenseMap loadAnalysis; + AffineLoopAnalysis(bool forcedLegality) : legality(forcedLegality) {} + bool analyzeBody(fir::LoopOp, AffineFunctionAnalysis &); + bool analyzeLoop(fir::LoopOp loopOperation, + AffineFunctionAnalysis &functionAnalysis) { + LLVM_DEBUG(llvm::dbgs() << "AffinLoopAnalysis: \n"; loopOperation.dump();); + return analyzeStep(loopOperation.step()) && + analyzeMemoryAccess(loopOperation) && + analyzeBody(loopOperation, functionAnalysis); } bool analyzeStep(const mlir::Value stepValue) { - auto stepDefinition = stepValue.getDefiningOp(); - if (stepDefinition) { + if (auto stepDefinition = stepValue.getDefiningOp()) { if (auto stepAttr = stepDefinition.getValue().dyn_cast()) { step = stepAttr.getInt(); return true; @@ -54,17 +66,22 @@ class AffineLoopAnalysis { stepAttr.print(llvm::dbgs());); return false; } - } else { - LLVM_DEBUG( - llvm::dbgs() - << "AffineLoopAnalysis: cannot promote loop, step not constant\n"; - if (stepValue.getDefiningOp()) stepValue.getDefiningOp()->print( - llvm::dbgs())); - return false; } + LLVM_DEBUG( + llvm::dbgs() + << "AffineLoopAnalysis: cannot promote loop, step not constant\n"; + if (stepValue.getDefiningOp()) stepValue.getDefiningOp()->print( + llvm::dbgs());); + return false; } - bool analyzeMemoryAccess(fir::LoopOp loop) { - llvm_unreachable("not yet implemented"); + bool analyzeArrayReference(mlir::Value); + bool analyzeMemoryAccess(fir::LoopOp loopOperation) { + for (auto loadOp : loopOperation.getOps()) + if (!analyzeArrayReference(loadOp.memref())) + return false; + for (auto storeOp : loopOperation.getOps()) + if (!analyzeArrayReference(storeOp.memref())) + return false; return true; } }; @@ -73,22 +90,81 @@ class AffineLoopAnalysis { class AffineFunctionAnalysis { public: AffineFunctionAnalysis(mlir::FuncOp funcOp) { - for (fir::LoopOp op : funcOp.getOps()) { - loopAnalysisMap.try_emplace(op, op); - } + for (fir::LoopOp op : funcOp.getOps()) + loopAnalysisMap.try_emplace(op, op, *this); } AffineLoopAnalysis getChildLoopAnalysis(fir::LoopOp op) const { auto it = loopAnalysisMap.find_as(op); if (it == loopAnalysisMap.end()) { - op.emitError("error in fetching loop analysis during affine promotion\n"); - } else { - return it->getSecond(); + LLVM_DEBUG(llvm::dbgs() << "AffineFunctionAnalysis: not computed for:\n"; + op.dump();); + op.emitError( + "error in fetching loop analysis in AffineFunctionAnalysis\n"); + return AffineLoopAnalysis(false); } + return it->getSecond(); } + friend AffineLoopAnalysis; private: - DenseMap loopAnalysisMap; + llvm::DenseMap loopAnalysisMap; }; +bool analyzeCoordinate(mlir::Value coordinate) { + if (auto blockArg = coordinate.dyn_cast()) { + if (isa(blockArg.getOwner()->getParentOp())) { + return true; + } else { + llvm::dbgs() << "AffineLoopAnalysis: array coordinate is not a " + "loop induction variable (owner not loopOp)\n"; + return false; + } + } else { + llvm::dbgs() << "AffineLoopAnalysis: array coordinate is not a loop " + "induction variable (not a block argument)\n"; + return false; + } +} +bool AffineLoopAnalysis::analyzeArrayReference(mlir::Value arrayRef) { + bool canPromote = true; + if (auto acoOp = arrayRef.getDefiningOp()) { + for (auto coordinate : acoOp.coor()) + canPromote = canPromote && analyzeCoordinate(coordinate); + } else { + LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: cannot promote loop, " + "array reference uses non ArrayCoorOp\n";); + canPromote = false; + } + return canPromote; +} + +bool AffineLoopAnalysis::analyzeBody(fir::LoopOp loopOperation, + AffineFunctionAnalysis &functionAnalysis) { + for (auto loopOp : loopOperation.getOps()) { + auto analysis = functionAnalysis.loopAnalysisMap + .try_emplace(loopOp, loopOp, functionAnalysis) + .first->getSecond(); + if (!analysis.canPromoteToAffine()) + return false; + } + return true; +} + +mlir::AffineMap createArrayIndexAffineMap(unsigned dimensions, + MLIRContext *context) { + auto index = mlir::getAffineConstantExpr(0, context); + auto extent = mlir::getAffineConstantExpr(1, context); + for (unsigned i = 0; i < dimensions; ++i) { + mlir::AffineExpr idx = mlir::getAffineDimExpr(i, context), + lowerBound = mlir::getAffineSymbolExpr(i * 3, context), + upperBound = mlir::getAffineSymbolExpr(i * 3 + 1, context), + stride = mlir::getAffineSymbolExpr(i * 3 + 2, context), + currentPart = (idx - lowerBound) * extent; + index = currentPart + index; + extent = + (upperBound - lowerBound + 1) * stride * extent; // TODO negative stride + } + return mlir::AffineMap::get(dimensions, dimensions * 3, index); +} /// Convert `fir.loop` to `affine.for` class AffineLoopConversion : public mlir::OpRewritePattern { @@ -100,6 +176,8 @@ class AffineLoopConversion : public mlir::OpRewritePattern { mlir::LogicalResult matchAndRewrite(fir::LoopOp loop, mlir::PatternRewriter &rewriter) const override { + LLVM_DEBUG(llvm::dbgs() << "AffineLoopConversion: rewriting loop:\n"; + loop.dump();); auto loopAnalysis = functionAnalysis.getChildLoopAnalysis(loop); if (loopAnalysis.step.getValue() <= 0) { LLVM_DEBUG(llvm::dbgs() @@ -107,30 +185,91 @@ class AffineLoopConversion : public mlir::OpRewritePattern { "step not postive\n";); return failure(); } - auto loopOps = &loop.getBody()->getOperations(); - for (auto loadOp : loop.getOps()) { - if (failed(rewriteLoad(loadOp, rewriter))) - return failure(); - } + auto &loopOps = loop.getBody()->getOperations(); + auto affineFor = rewriter.create( loop.getLoc(), ValueRange(loop.lowerBound()), - AffineMap::getMultiDimIdentityMap(1, loop.getContext()), + mlir::AffineMap::get(0, 1, + mlir::getAffineSymbolExpr(0, loop.getContext())), ValueRange(loop.upperBound()), - AffineMap::getMultiDimIdentityMap(1, loop.getContext()), + mlir::AffineMap::get( + 0, 1, 1 + mlir::getAffineSymbolExpr(0, loop.getContext())), loopAnalysis.step.getValue()); - loop.step().dropAllUses(); - loop.getBody()->getOperations().pop_back(); // remove fir.result + + rewriter.startRootUpdate(affineFor.getOperation()); affineFor.getBody()->getOperations().splice(affineFor.getBody()->begin(), - *loopOps, loopOps->begin(), - loopOps->end()); - rewriter.eraseOp(loop); + loopOps, loopOps.begin(), + --loopOps.end()); + rewriter.finalizeRootUpdate(affineFor.getOperation()); + + for (auto &bodyOp : affineFor.getBody()->getOperations()) { + if (isa(bodyOp)) { + if (failed(rewriteLoad(cast(bodyOp), rewriter))) { + return failure(); + } + } + if (isa(bodyOp)) { + if (failed(rewriteStore(cast(bodyOp), rewriter))) { + return failure(); + } + } + } + + rewriter.startRootUpdate(loop.getOperation()); loop.getInductionVar().replaceAllUsesWith(affineFor.getInductionVar()); + rewriter.finalizeRootUpdate(loop.getOperation()); + + rewriter.replaceOp(loop, affineFor.getOperation()->getResults()); + + LLVM_DEBUG(llvm::dbgs() << "AffineLoopConversion: loop rewriten to:\n"; + affineFor.dump();); return success(); } private: - mlir::LogicalResult rewriteLoad(fir::LoadOp op, + mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) const { + if (auto refType = op.ref().getType().dyn_cast_or_null()) { + if (auto seqType = refType.getEleTy().dyn_cast_or_null()) { + return seqType.getEleTy(); + } + } + op.emitError( + "AffineLoopConversion: array type in coordinate operation not valid\n"); + return mlir::Type(); + } + std::pair + createAffineOps(mlir::Value arrayRef, mlir::PatternRewriter &rewriter) const { + auto acoOp = arrayRef.getDefiningOp(); + auto genDim = acoOp.dims().getDefiningOp(); + auto affineMap = + createArrayIndexAffineMap(acoOp.coor().size(), acoOp.getContext()); + SmallVector indexArgs; + indexArgs.append(acoOp.coor().begin(), acoOp.coor().end()); + indexArgs.append(genDim.triples().begin(), genDim.triples().end()); + auto affineApply = rewriter.create( + acoOp.getLoc(), affineMap, indexArgs); + auto arrayElementType = coordinateArrayElement(acoOp); + auto newType = mlir::MemRefType::get({-1}, arrayElementType); + auto arrayConvert = + rewriter.create(acoOp.getLoc(), newType, acoOp.ref()); + return std::make_pair(affineApply, arrayConvert); + } + + mlir::LogicalResult rewriteLoad(fir::LoadOp loadOp, mlir::PatternRewriter &rewriter) const { + rewriter.setInsertionPoint(loadOp); + auto affineOps = createAffineOps(loadOp.memref(), rewriter); + rewriter.replaceOpWithNewOp( + loadOp, affineOps.second.getResult(), affineOps.first.getResult()); + return success(); + } + mlir::LogicalResult rewriteStore(fir::StoreOp storeOp, + mlir::PatternRewriter &rewriter) const { + rewriter.setInsertionPoint(storeOp); + auto affineOps = createAffineOps(storeOp.memref(), rewriter); + rewriter.replaceOpWithNewOp( + storeOp, storeOp.value(), affineOps.second.getResult(), + affineOps.first.getResult()); return success(); } AffineFunctionAnalysis &functionAnalysis; From ab2cb063911bb0ffb07d1a803bb5209374a45ce9 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Wed, 17 Jun 2020 22:54:43 -0700 Subject: [PATCH 0108/1017] Lower dummy procedures This patch implements dummy procedure lowering with the exception following TODOs: - If an external function passed as a dummy argument does not yet have an mlir::funcOp, compilation will abort. - Passing specific intrinsic is not yet supporte. - The types of dummy procedure is () -> () this could be improved when more type knowledge is available. This as currently no functional impact. What's done in this patch: - Extend CallInterface to handle dummy procedure - Handle calls to dummy procedure accordingly in ConvertExpr.cpp - Lower ProcedureDesignator references (with the limitations raised above). - Allow fir.convert to cast between function types, this notably required updating fir::isa_fir_or_std_type. - Fix fir.call parsing in case of indirect calls (the arguments were parsed in a temporary vector, and therefore lost). --- flang/include/flang/Lower/CallInterface.h | 13 ++- .../include/flang/Optimizer/Dialect/FIROps.td | 3 +- flang/lib/Lower/CallInterface.cpp | 74 ++++++++++---- flang/test/Lower/dummy-procedure.f90 | 96 +++++++++++++++++++ 4 files changed, 165 insertions(+), 21 deletions(-) create mode 100644 flang/test/Lower/dummy-procedure.f90 diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index 157b6f633bdee..7d451f5c6c7f8 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -159,6 +159,8 @@ class CallInterface { /// In case the result must be passed by the caller, indicate how. /// nullopt if the result is not passed by the caller. std::optional getPassedResult() const { return passedResult; } + /// Returns the mlir function type + mlir::FunctionType genFunctionType() const; private: /// CRTP handle. @@ -170,8 +172,6 @@ class CallInterface { buildImplicitInterface(const Fortran::evaluate::characteristics::Procedure &); void buildExplicitInterface(const Fortran::evaluate::characteristics::Procedure &); - /// Helper to get type after the first pass. - mlir::FunctionType genFunctionType() const; /// Second pass entry point, once the mlir::FuncOp is created void mapBackInputToPassedEntity(const FirPlaceHolder &, FirValue); @@ -217,12 +217,18 @@ class CallerInterface : public CallInterface { return procRef; }; bool isMainProgram() const { return false; } + /// Returns true if this is a call to a procedure pointer of a dummy + /// procedure. + bool isIndirectCall() const; /// Helpers to place the lowered arguments at the right place once they /// have been lowered. void placeInput(const PassedEntity &passedEntity, mlir::Value arg); void placeAddressAndLengthInput(const PassedEntity &passedEntity, mlir::Value addr, mlir::Value len); + /// If this is a call to a procedure pointer or dummy, returns the related + /// symbol. Nullptr otherwise. + const Fortran::semantics::Symbol *getIfIndirectCallSymbol() const; /// Get the input vector once it is complete. const llvm::SmallVector &getInputs() const { assert(verifyActualInputs() && "lowered arguments are incomplete"); @@ -260,6 +266,9 @@ class CalleeInterface : public CallInterface { Fortran::lower::pft::FunctionLikeUnit &getCallDescription() const { return funit; }; + /// On the callee side it does not matter whether the procedure is + /// called through pointers or not. + bool isIndirectCall() const { return false; } private: Fortran::lower::pft::FunctionLikeUnit &funit; diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td index a38630b2a04f0..6e8e765144f23 100644 --- a/flang/include/flang/Optimizer/Dialect/FIROps.td +++ b/flang/include/flang/Optimizer/Dialect/FIROps.td @@ -2994,7 +2994,8 @@ def fir_ConvertOp : fir_OneResultOp<"convert", [NoSideEffect]> { (isIntegerCompatible(inType) && isPointerCompatible(outType)) || (isPointerCompatible(inType) && isIntegerCompatible(outType)) || (inType.isa() && outType.isa()) || - (fir::isa_complex(inType) && fir::isa_complex(outType))) + (fir::isa_complex(inType) && fir::isa_complex(outType)) || + (inType.isa() && outType.isa())) return mlir::success(); return emitOpError("invalid type conversion"); }]; diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index 87b3974a75cce..77a5372dcf568 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -34,6 +34,22 @@ std::string Fortran::lower::CallerInterface::getMangledName() const { return proc.GetName(); } +bool Fortran::lower::CallerInterface::isIndirectCall() const { + if (const auto *symbol = procRef.proc().GetSymbol()) + return Fortran::semantics::IsPointer(*symbol) || + Fortran::semantics::IsDummy(*symbol); + return false; +} + +const Fortran::semantics::Symbol * +Fortran::lower::CallerInterface::getIfIndirectCallSymbol() const { + if (const auto *symbol = procRef.proc().GetSymbol()) + if (Fortran::semantics::IsPointer(*symbol) || + Fortran::semantics::IsDummy(*symbol)) + return symbol; + return nullptr; +} + mlir::Location Fortran::lower::CallerInterface::getCalleeLocation() const { const auto &proc = procRef.proc(); // FIXME: If the callee is defined in the same file but after the current @@ -182,13 +198,19 @@ void Fortran::lower::CallInterface::init() { } // No input/output for main program - auto name = side().getMangledName(); - auto module = converter.getModuleOp(); - func = Fortran::lower::FirOpBuilder::getNamedFunction(module, name); - if (!func) { - mlir::Location loc = side().getCalleeLocation(); - mlir::FunctionType ty = genFunctionType(); - func = Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty); + // Create / get funcOp for direct calls. For indirect calls (only meaningful + // on the caller side), no funcOp has to be created here. The mlir::Value + // holding the indirection is used when creating the fir::CallOp. + if (!side().isIndirectCall()) { + auto name = side().getMangledName(); + auto module = converter.getModuleOp(); + func = Fortran::lower::FirOpBuilder::getNamedFunction(module, name); + if (!func) { + mlir::Location loc = side().getCalleeLocation(); + mlir::FunctionType ty = genFunctionType(); + func = + Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty); + } } // map back fir inputs to passed entities @@ -306,23 +328,18 @@ class Fortran::lower::CallInterfaceImpl { getEntityContainer(interface.side().getCallDescription()); for (const auto &pair : llvm::zip(procedure.dummyArguments, argumentEntities)) { - const auto &dummy = std::get<0>(pair); + const auto &dummyCharacteristic = std::get<0>(pair); std::visit( Fortran::common::visitors{ - [&](const Fortran::evaluate::characteristics::DummyDataObject - &obj) { - handleImplicitDataDummy(obj, - getDataObjectEntity(std::get<1>(pair))); - }, - [&](const Fortran::evaluate::characteristics::DummyProcedure &) { - // TODO - llvm_unreachable("dummy procedure pointer not yet handled"); + [&](const auto &dummy) { + const auto &entity = getDataObjectEntity(std::get<1>(pair)); + handleImplicitDummy(dummy, entity); }, [&](const Fortran::evaluate::characteristics::AlternateReturn &) { // nothing to do }, }, - dummy.u); + dummyCharacteristic.u); } } void buildExplicitInterface( @@ -347,7 +364,7 @@ class Fortran::lower::CallInterfaceImpl { addFirOutput(boxCharTy, resultPosition, Property::BoxChar); } - void handleImplicitDataDummy( + void handleImplicitDummy( const Fortran::evaluate::characteristics::DummyDataObject &obj, const FortranEntity &entity) { auto dynamicType = obj.type.type(); @@ -355,6 +372,7 @@ class Fortran::lower::CallInterfaceImpl { auto boxCharTy = fir::BoxCharType::get(&mlirContext, dynamicType.kind()); addFirInput(boxCharTy, nextPassedArgPosition(), Property::BoxChar); addPassedArg(PassEntityBy::BoxChar, entity); + // FIXME: non PDT derived type allowed here. } else { mlir::Type type = getConverter().genType(dynamicType.category(), dynamicType.kind()); @@ -368,6 +386,26 @@ class Fortran::lower::CallInterfaceImpl { } } + void handleImplicitDummy( + const Fortran::evaluate::characteristics::DummyProcedure &proc, + const FortranEntity &entity) { + if (proc.attrs.test( + Fortran::evaluate::characteristics::DummyProcedure::Attr::Pointer)) + llvm_unreachable("TODO: procedure pointer arguments"); + // Otherwise, it is a dummy procedure + + // TODO: Get actual function type of the dummy procedure, at least when an + // interface is given. + // In general, that is a nice to have but we cannot guarantee to find the + // function type that will match the one of the calls, we may not even know + // how many arguments the dummy procedure accepts (e.g. if a procedure + // pointer is only transiting through the current procedure without being + // called), so a function type cast must always be inserted. + auto funcType = mlir::FunctionType::get({}, {}, &mlirContext); + addFirInput(funcType, nextPassedArgPosition(), Property::BaseAddress); + addPassedArg(PassEntityBy::BaseAddress, entity); + } + fir::SequenceType::Shape getBounds(const Fortran::evaluate::Shape &shape) { fir::SequenceType::Shape bounds; for (const auto &extent : shape) { diff --git a/flang/test/Lower/dummy-procedure.f90 b/flang/test/Lower/dummy-procedure.f90 new file mode 100644 index 0000000000000..269429b4011b7 --- /dev/null +++ b/flang/test/Lower/dummy-procedure.f90 @@ -0,0 +1,96 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test dummy procedures + +! Test of dummy procedure call +! CHECK-LABEL: func @_QPfoo(%arg0: () -> ()) -> f32 +real function foo(bar) + real :: bar, x + ! CHECK: %[[x:.*]] = fir.alloca f32 {name = "x"} + x = 42. + ! CHECK: %[[funccast:.*]] = fir.convert %arg0 : (() -> ()) -> ((!fir.ref) -> f32) + ! CHECK: fir.call %[[funccast]](%[[x]]) : (!fir.ref) -> f32 + foo = bar(x) +end function + +! Test case where dummy procedure is only transiting. +! CHECK-LABEL: func @_QPprefoo(%arg0: () -> ()) -> f32 +real function prefoo(bar) + external :: bar + ! CHECK: fir.call @_QPfoo(%arg0) : (() -> ()) -> f32 + prefoo = foo(bar) +end function + +! Function that will be passed as dummy argument +!CHECK-LABEL: func @_QPfunc(%arg0: !fir.ref) -> f32 +real function func(x) + real :: x + func = x + 0.5 +end function + +! Test passing functions as dummy procedure arguments +! CHECK-LABEL: func @_QPtest_func +real function test_func() + real :: func, prefoo + external :: func + !CHECK: %[[f:.*]] = constant @_QPfunc : (!fir.ref) -> f32 + !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> f32) -> (() -> ()) + !CHECK: fir.call @_QPprefoo(%[[fcast]]) : (() -> ()) -> f32 + test_func = prefoo(func) +end function + +! Repeat test with dummy subroutine + +! CHECK-LABEL: func @_QPfoo_sub(%arg0: () -> ()) +subroutine foo_sub(bar_sub) + ! CHECK: %[[x:.*]] = fir.alloca f32 {name = "x"} + x = 42. + ! CHECK: %[[funccast:.*]] = fir.convert %arg0 : (() -> ()) -> ((!fir.ref) -> ()) + ! CHECK: fir.call %[[funccast]](%[[x]]) : (!fir.ref) + call bar_sub(x) +end subroutine + +! Test case where dummy procedure is only transiting. +! CHECK-LABEL: func @_QPprefoo_sub(%arg0: () -> ()) +subroutine prefoo_sub(bar_sub) + external :: bar_sub + ! CHECK: fir.call @_QPfoo_sub(%arg0) : (() -> ()) -> () + call foo_sub(bar_sub) +end subroutine + +! Subroutine that will be passed as dummy argument +!CHECK-LABEL: func @_QPsub(%arg0: !fir.ref) +subroutine sub(x) + real :: x + print *, x +end subroutine + +! Test passing functions as dummy procedure arguments +! CHECK-LABEL: func @_QPtest_sub +subroutine test_sub() + external :: sub + !CHECK: %[[f:.*]] = constant @_QPsub : (!fir.ref) -> () + !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> ()) -> (() -> ()) + !CHECK: fir.call @_QPprefoo_sub(%[[fcast]]) : (() -> ()) -> () + call prefoo_sub(sub) +end subroutine + +! FIXME: create funcOp if not defined in file +!subroutine todo1() +! external proc_not_defined_in_file +! call prefoo_sub(proc_not_defined_in_file) +!end subroutine + +! FIXME: pass intrinsics +!subroutine todo2() +! intrinsic :: acos +! print *, prefoo(acos) +!end subroutine + +! TODO: improve dummy procedure types when interface is given. +! CHECK: func @_QPtodo3(%arg0: () -> ()) +! SHOULD-CHECK: func @_QPtodo3(%arg0: (!fir.ref) -> f32) +subroutine todo3(dummy_proc) + intrinsic :: acos + procedure(acos) :: dummy_proc +end subroutine From 35be5e295183389d4bf2b735b6e5cfcbc677241b Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 22 Jun 2020 13:30:12 -0700 Subject: [PATCH 0109/1017] rebase fallout: fix merge issues and address changes to MLIR --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 75 ++++++++++--------- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 3 +- 2 files changed, 41 insertions(+), 37 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 223a3b5f0a173..c1331aa42ca73 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -427,16 +427,16 @@ class FIROpConversion : public mlir::OpConversionPattern { public: explicit FIROpConversion(mlir::MLIRContext *ctx, FIRToLLVMTypeConverter &lowering) - : mlir::OpConversionPattern(ctx, 1), lowering(lowering) {} + : mlir::OpConversionPattern(lowering, ctx, 1) {} protected: - LLVMContext &getLLVMContext() const { return lowering.getLLVMContext(); } - mlir::LLVM::LLVMDialect *getDialect() const { return lowering.getDialect(); } + LLVMContext &getLLVMContext() const { return lowerTy().getLLVMContext(); } + mlir::LLVM::LLVMDialect *getDialect() const { return lowerTy().getDialect(); } mlir::Type convertType(mlir::Type ty) const { - return lowering.convertType(ty); + return lowerTy().convertType(ty); } mlir::LLVM::LLVMType unwrap(mlir::Type ty) const { - return lowering.unwrap(ty); + return lowerTy().unwrap(ty); } mlir::LLVM::LLVMType voidPtrTy() const { return getVoidPtrType(getDialect()); @@ -446,7 +446,7 @@ class FIROpConversion : public mlir::OpConversionPattern { genConstantOffset(mlir::Location loc, mlir::ConversionPatternRewriter &rewriter, int offset) const { - auto ity = lowering.offsetType(); + auto ity = lowerTy().offsetType(); auto cattr = rewriter.getI32IntegerAttr(offset); return rewriter.create(loc, ity, cattr); } @@ -496,7 +496,9 @@ class FIROpConversion : public mlir::OpConversionPattern { return rewriter.create(loc, ty, base, cv); } - FIRToLLVMTypeConverter &lowering; + FIRToLLVMTypeConverter &lowerTy() const { + return *static_cast(this->getTypeConverter()); + } }; /// FIR conversion pattern template @@ -571,7 +573,7 @@ struct AllocaOpConversion : public FIROpConversion { matchAndRewrite(fir::AllocaOp alloc, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { auto loc = alloc.getLoc(); - auto ity = lowering.indexType(); + auto ity = lowerTy().indexType(); auto c1 = genConstantIndex(loc, ity, rewriter, 1); auto size = c1.getResult(); for (auto opnd : operands) @@ -611,7 +613,7 @@ struct AllocMemOpConversion : public FIROpConversion { auto dialect = getDialect(); auto mallocFunc = getMalloc(heap, rewriter, dialect); auto loc = heap.getLoc(); - auto ity = lowering.indexType(); + auto ity = lowerTy().indexType(); auto c1 = genConstantIndex(loc, ity, rewriter, 1); auto size = c1.getResult(); for (auto opnd : operands) @@ -746,7 +748,7 @@ struct BoxIsAllocOpConversion : public FIROpConversion { mlir::ConversionPatternRewriter &rewriter) const override { auto a = operands[0]; auto loc = boxisalloc.getLoc(); - auto ity = lowering.offsetType(); + auto ity = lowerTy().offsetType(); auto c0 = genConstantOffset(loc, rewriter, 0); auto c5 = genConstantOffset(loc, rewriter, 5); auto ty = convertType(boxisalloc.getType()); @@ -788,7 +790,7 @@ struct BoxIsPtrOpConversion : public FIROpConversion { auto a = operands[0]; auto loc = boxisptr.getLoc(); auto ty = convertType(boxisptr.getType()); - auto ity = lowering.offsetType(); + auto ity = lowerTy().offsetType(); auto c0 = genConstantOffset(loc, rewriter, 0); auto c5 = genConstantOffset(loc, rewriter, 5); SmallVector args{a, c0, c5}; @@ -870,7 +872,7 @@ struct StringLitOpConversion : public FIROpConversion { auto arr = attr.cast(); auto size = constop.getSize().cast().getInt(); auto eleTy = constop.getType().cast().getEleTy(); - auto bits = lowering.characterBitsize(eleTy.cast()); + auto bits = lowerTy().characterBitsize(eleTy.cast()); auto charTy = rewriter.getIntegerType(bits); auto det = mlir::VectorType::get({size}, charTy); // convert each character to a precise bitsize @@ -967,7 +969,7 @@ struct ConstcOpConversion : public FIROpConversion { auto ctx = conc.getContext(); auto ty = convertType(conc.getType()); auto ct = conc.getType().cast(); - auto ety = lowering.convertComplexPartType(ct.getFKind()); + auto ety = lowerTy().convertComplexPartType(ct.getFKind()); auto ri = mlir::FloatAttr::get(ety, getValue(conc.getReal())); auto rp = rewriter.create(loc, ety, ri); auto ii = mlir::FloatAttr::get(ety, getValue(conc.getImaginary())); @@ -1203,7 +1205,7 @@ struct EmboxOpConversion : public FIROpConversion { auto loc = embox.getLoc(); auto *dialect = getDialect(); auto ty = unwrap( - lowering.convertBoxType(embox.getType().dyn_cast(), 0)); + lowerTy().convertBoxType(embox.getType().dyn_cast(), 0)); auto alloca = genAllocaWithType(loc, ty, defaultAlign, dialect, rewriter); auto c0 = genConstantOffset(loc, rewriter, 0); auto rty = unwrap(operands[0].getType()).getPointerTo(); @@ -1269,8 +1271,8 @@ struct XEmboxOpConversion : public FIROpConversion { auto loc = xbox.getLoc(); auto *dialect = getDialect(); auto rank = xbox.getRank(); - auto ty = unwrap( - lowering.convertBoxType(xbox.getType().dyn_cast(), rank)); + auto ty = unwrap(lowerTy().convertBoxType( + xbox.getType().dyn_cast(), rank)); auto alloca = genAllocaWithType(loc, ty, defaultAlign, dialect, rewriter); auto c0 = genConstantOffset(loc, rewriter, 0); @@ -1402,7 +1404,7 @@ struct ExtractValueOpConversion SmallVector attrs; for (std::size_t i = 1, end{operands.size()}; i < end; ++i) attrs.push_back(getValue(operands[i])); - toRowMajor(attrs, lowering.unwrap(operands[0].getType())); + toRowMajor(attrs, lowerTy().unwrap(operands[0].getType())); auto position = mlir::ArrayAttr::get(attrs, extractVal.getContext()); rewriter.replaceOpWithNewOp( extractVal, ty, operands[0], position); @@ -1425,7 +1427,7 @@ struct InsertValueOpConversion SmallVector attrs; for (std::size_t i = 2, end{operands.size()}; i < end; ++i) attrs.push_back(getValue(operands[i])); - toRowMajor(attrs, lowering.unwrap(operands[0].getType())); + toRowMajor(attrs, lowerTy().unwrap(operands[0].getType())); auto position = mlir::ArrayAttr::get(attrs, insertVal.getContext()); rewriter.replaceOpWithNewOp( insertVal, ty, operands[0], operands[1], position); @@ -1464,7 +1466,7 @@ struct XArrayCoorOpConversion unsigned indexOff = 1 + coor.dimsOperands().size(); // Cast the base address to a pointer to T auto base = rewriter.create(loc, ty, operands[0]); - auto idxTy = lowering.indexType(); + auto idxTy = lowerTy().indexType(); mlir::Value prevExt = genConstantIndex(loc, idxTy, rewriter, 1); mlir::Value off = genConstantIndex(loc, idxTy, rewriter, 0); for (unsigned i = 0; i < rank; ++i) { @@ -1514,7 +1516,7 @@ struct CoordinateOpConversion doRewrite(fir::CoordinateOp coor, mlir::Type ty, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { auto loc = coor.getLoc(); - auto c0 = genConstantIndex(loc, lowering.indexType(), rewriter, 0); + auto c0 = genConstantIndex(loc, lowerTy().indexType(), rewriter, 0); mlir::Value base = operands[0]; auto firTy = coor.getBaseType(); mlir::Type cpnTy = getReferenceEleTy(firTy); @@ -1791,7 +1793,7 @@ struct FieldIndexOpConversion : public FIROpConversion { mlir::SymbolRefAttr::get(methodName(field), field.getContext()); SmallVector attrs{ rewriter.getNamedAttr("callee", symAttr)}; - auto ty = lowering.offsetType(); + auto ty = lowerTy().offsetType(); rewriter.replaceOpWithNewOp(field, ty, operands, attrs); return success(); } @@ -1815,7 +1817,7 @@ struct LenParamIndexOpConversion mlir::LogicalResult matchAndRewrite(fir::LenParamIndexOp lenp, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - auto ity = lowering.indexType(); + auto ity = lowerTy().indexType(); auto onty = lenp.getOnType(); // size of portable descriptor const unsigned boxsize = 24; // FIXME @@ -1871,7 +1873,7 @@ struct GenTypeDescOpConversion : public FIROpConversion { if (auto d = type.dyn_cast()) { auto name = d.getName(); auto pair = fir::NameUniquer::deconstruct(name); - return lowering.getUniquer().doTypeDescriptor( + return lowerTy().getUniquer().doTypeDescriptor( pair.second.modules, pair.second.host, pair.second.name, pair.second.kinds); } @@ -2101,7 +2103,7 @@ struct SelectOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::SelectOp op, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - selectMatchAndRewrite(lowering, op, operands, rewriter); + selectMatchAndRewrite(lowerTy(), op, operands, rewriter); return success(); } }; @@ -2113,7 +2115,7 @@ struct SelectRankOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::SelectRankOp op, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - selectMatchAndRewrite(lowering, op, operands, rewriter); + selectMatchAndRewrite(lowerTy(), op, operands, rewriter); return success(); } }; @@ -2184,7 +2186,7 @@ struct UnboxOpConversion : public FIROpConversion { auto loc = unbox.getLoc(); auto tuple = operands[0]; auto ty = unwrap(tuple.getType()); - auto oty = lowering.offsetType(); + auto oty = lowerTy().offsetType(); auto c0 = rewriter.create( loc, oty, rewriter.getI32IntegerAttr(0)); mlir::Value ptr = genLoadWithIndex(loc, tuple, ty, rewriter, oty, c0, 0); @@ -2281,7 +2283,7 @@ struct AddfOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::AddfOp op, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - lowerRealBinaryOp(op, operands, rewriter, lowering); + lowerRealBinaryOp(op, operands, rewriter, lowerTy()); return success(); } }; @@ -2291,7 +2293,7 @@ struct SubfOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::SubfOp op, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - lowerRealBinaryOp(op, operands, rewriter, lowering); + lowerRealBinaryOp(op, operands, rewriter, lowerTy()); return success(); } }; @@ -2301,7 +2303,7 @@ struct MulfOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::MulfOp op, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - lowerRealBinaryOp(op, operands, rewriter, lowering); + lowerRealBinaryOp(op, operands, rewriter, lowerTy()); return success(); } }; @@ -2311,7 +2313,7 @@ struct DivfOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::DivfOp op, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - lowerRealBinaryOp(op, operands, rewriter, lowering); + lowerRealBinaryOp(op, operands, rewriter, lowerTy()); return success(); } }; @@ -2321,7 +2323,7 @@ struct ModfOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::ModfOp op, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - lowerRealBinaryOp(op, operands, rewriter, lowering); + lowerRealBinaryOp(op, operands, rewriter, lowerTy()); return success(); } }; @@ -2373,7 +2375,8 @@ struct AddcOpConversion : public FIROpConversion { mlir::ConversionPatternRewriter &rewriter) const override { // given: (x + iy) * (x' + iy') // result: (x + x') + i(y + y') - auto r = complexSum(addc, operands, rewriter, lowering); + auto r = + complexSum(addc, operands, rewriter, lowerTy()); addc.replaceAllUsesWith(r.getResult()); rewriter.replaceOp(addc, r.getResult()); return success(); @@ -2388,7 +2391,8 @@ struct SubcOpConversion : public FIROpConversion { mlir::ConversionPatternRewriter &rewriter) const override { // given: (x + iy) * (x' + iy') // result: (x - x') + i(y - y') - auto r = complexSum(subc, operands, rewriter, lowering); + auto r = + complexSum(subc, operands, rewriter, lowerTy()); subc.replaceAllUsesWith(r.getResult()); rewriter.replaceOp(subc, r.getResult()); return success(); @@ -2517,7 +2521,6 @@ struct FIRToLLVMLoweringPass auto *context{&getContext()}; FIRToLLVMTypeConverter typeConverter{context, uniquer}; auto loc = mlir::UnknownLoc::get(context); - mlir::OwningRewritePatternList pattern; pattern.insert< AddcOpConversion, AddfOpConversion, AddrOfOpConversion, @@ -2549,8 +2552,8 @@ struct FIRToLLVMLoweringPass target.addLegalOp(); // apply the patterns - if (mlir::failed(mlir::applyFullConversion( - getModule(), target, std::move(pattern), &typeConverter))) { + if (mlir::failed(mlir::applyFullConversion(getModule(), target, + std::move(pattern)))) { mlir::emitError(loc, "error in converting to LLVM-IR dialect\n"); signalPassFailure(); } diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 539ee7170ee71..30e6270d5826c 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -275,8 +275,9 @@ class CfgConversion : public CFGConversionBase { // apply the patterns target.addIllegalOp(); + target.markUnknownOpDynamicallyLegal([](Operation*) { return true; }); if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, - std::move(patterns)))) { + patterns))) { mlir::emitError(mlir::UnknownLoc::get(context), "error in converting to CFG\n"); signalPassFailure(); From 32405500373a2ccf2752fbb161e2c8149503b87c Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 22 Jun 2020 14:19:21 -0700 Subject: [PATCH 0110/1017] remove exit on DATA statement lowering --- flang/lib/Lower/Bridge.cpp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 4397519966d31..5e8d6a0ff43c7 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1435,9 +1435,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(const Fortran::parser::DataStmt &) { - // FIXME: The front-end doesn't provide the right information yet. - mlir::emitError(toLocation(), "DATA statement is not handled."); - exit(1); + // do nothing. The front-end converts to data initializations. } void genFIR(const Fortran::parser::NamelistStmt &) { TODO(); } From e5f8197d8920eb6fe025da1ba70f928faae49529 Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 22 Jun 2020 18:11:05 -0700 Subject: [PATCH 0111/1017] fix for lost last iteration. the value of the last iteration was not being saved to the do variable. --- flang/lib/Lower/Bridge.cpp | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 5e8d6a0ff43c7..f26c99f68eb6a 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -752,23 +752,22 @@ class FirConverter : public Fortran::lower::AbstractConverter { info.isStructured() ? builder->getIndexType() : info.loopVariableType; auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); auto upperValue = genFIRLoopIndex(info.upperExpr, type); - info.stepValue = - info.stepExpr.has_value() ? genFIRLoopIndex(*info.stepExpr, type) - : info.isStructured() - ? builder->create(loc, 1) - : builder->createIntegerConstant(loc, info.loopVariableType, 1); + info.stepValue = info.stepExpr.has_value() + ? genFIRLoopIndex(*info.stepExpr, type) + : info.isStructured() + ? builder->create(loc, 1) + : builder->createIntegerConstant( + loc, info.loopVariableType, 1); assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(loc, *info.loopVariableSym); - auto lowerVal = - builder->createConvert(loc, info.loopVariableType, lowerValue); - builder->create(loc, lowerVal, info.loopVariable); // Structured loop - generate fir.loop. if (info.isStructured()) { // Perform the default initial assignment of the DO variable. info.insertionPoint = builder->saveInsertionPoint(); - info.doLoop = builder->create(loc, lowerValue, upperValue, - info.stepValue); + info.doLoop = builder->create( + loc, lowerValue, upperValue, info.stepValue, /*unordered=*/false, + ArrayRef{lowerValue}); builder->setInsertionPointToStart(info.doLoop.getBody()); // Always store iteration ssa-value to the DO variable to avoid missing // any aliasing. Note that this assignment can only happen when executing @@ -805,7 +804,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto loc = toLocation(); if (info.isStructured()) { // End fir.loop. + mlir::Value inc = builder->create( + loc, info.doLoop.getInductionVar(), info.doLoop.step()); + builder->create(loc, inc); builder->restoreInsertionPoint(info.insertionPoint); + auto lcv = builder->createConvert(loc, info.loopVariableType, + info.doLoop.getResult(0)); + builder->create(loc, lcv, info.loopVariable); return; } From 91ce458f7369144db57d4b88258127a069a4b331 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 23 Jun 2020 05:53:17 -0700 Subject: [PATCH 0112/1017] Undefine behaviour introduced by rebase with D80285 --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index c1331aa42ca73..d2329d60333f0 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -2544,7 +2544,12 @@ struct FIRToLLVMLoweringPass SubfOpConversion, UnboxCharOpConversion, UnboxOpConversion, UnboxProcOpConversion, UndefOpConversion, UnreachableOpConversion, XArrayCoorOpConversion, XEmboxOpConversion>(context, typeConverter); - mlir::populateStdToLLVMConversionPatterns(typeConverter, pattern); + // Workaround D80285: beware, optional LowerToLLVMOptions argument of + // populateStdToLLVMConversionPatterns is broken. It ends up creating a + // reference over a temp that has the lifetime of the call. Do not use + // it. + mlir::LowerToLLVMOptions options; + mlir::populateStdToLLVMConversionPatterns(typeConverter, pattern, options); mlir::ConversionTarget target{*context}; target.addLegalDialect(); From f31ab5b396759e4ac251d4556036e059d6c00ced Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Tue, 23 Jun 2020 19:34:44 +0530 Subject: [PATCH 0113/1017] [flang] Lower NULL() intrinsic. Added `createNullConstant` in FIRBuilder. --- flang/test/Lower/pointer.f90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 flang/test/Lower/pointer.f90 diff --git a/flang/test/Lower/pointer.f90 b/flang/test/Lower/pointer.f90 new file mode 100644 index 0000000000000..7c96216e1a9ec --- /dev/null +++ b/flang/test/Lower/pointer.f90 @@ -0,0 +1,16 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPpointertests +subroutine pointerTests + ! CHECK: fir.global @_QFpointertestsEptr1 : !fir.ptr + integer, pointer :: ptr1 => NULL() + ! CHECK: fir.global @_QFpointertestsEptr2 : !fir.ptr + real, pointer :: ptr2 => NULL() + ! CHECK: fir.global @_QFpointertestsEptr3 : !fir.ptr> + complex, pointer :: ptr3 => NULL() + ! CHECK: fir.global @_QFpointertestsEptr4 : !fir.ptr + character, pointer :: ptr4 => NULL() + ! CHECK: fir.global @_QFpointertestsEptr5 : !fir.ptr> + logical, pointer :: ptr5 => NULL() +end subroutine pointerTests + From 5743f9a6b8a56e1469ce864dc51ba7bb4a45368f Mon Sep 17 00:00:00 2001 From: rajan Date: Tue, 23 Jun 2020 10:50:00 -0400 Subject: [PATCH 0114/1017] generalized loop bound calculation for affine for (#191) Using affine map for loop bounds in case step is not a positive constant; `0 -> (upper - lower + step)/step`. --- .../Optimizer/Transforms/AffinePromotion.cpp | 116 ++++++++++-------- 1 file changed, 68 insertions(+), 48 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index 495502160a078..a7ba75eb04f32 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -39,7 +39,6 @@ class AffineLoopAnalysis { AffineLoopAnalysis(fir::LoopOp op, AffineFunctionAnalysis &afa) : legality(analyzeLoop(op, afa)) {} bool canPromoteToAffine() { return legality; } - Optional step; friend AffineFunctionAnalysis; private: @@ -51,29 +50,9 @@ class AffineLoopAnalysis { bool analyzeLoop(fir::LoopOp loopOperation, AffineFunctionAnalysis &functionAnalysis) { LLVM_DEBUG(llvm::dbgs() << "AffinLoopAnalysis: \n"; loopOperation.dump();); - return analyzeStep(loopOperation.step()) && - analyzeMemoryAccess(loopOperation) && + return analyzeMemoryAccess(loopOperation) && analyzeBody(loopOperation, functionAnalysis); } - bool analyzeStep(const mlir::Value stepValue) { - if (auto stepDefinition = stepValue.getDefiningOp()) { - if (auto stepAttr = stepDefinition.getValue().dyn_cast()) { - step = stepAttr.getInt(); - return true; - } else { - LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: cannot promote loop, " - "step not integer\n"; - stepAttr.print(llvm::dbgs());); - return false; - } - } - LLVM_DEBUG( - llvm::dbgs() - << "AffineLoopAnalysis: cannot promote loop, step not constant\n"; - if (stepValue.getDefiningOp()) stepValue.getDefiningOp()->print( - llvm::dbgs());); - return false; - } bool analyzeArrayReference(mlir::Value); bool analyzeMemoryAccess(fir::LoopOp loopOperation) { for (auto loadOp : loopOperation.getOps()) @@ -152,19 +131,25 @@ bool AffineLoopAnalysis::analyzeBody(fir::LoopOp loopOperation, mlir::AffineMap createArrayIndexAffineMap(unsigned dimensions, MLIRContext *context) { auto index = mlir::getAffineConstantExpr(0, context); - auto extent = mlir::getAffineConstantExpr(1, context); + auto accuExtent = mlir::getAffineConstantExpr(1, context); for (unsigned i = 0; i < dimensions; ++i) { mlir::AffineExpr idx = mlir::getAffineDimExpr(i, context), lowerBound = mlir::getAffineSymbolExpr(i * 3, context), - upperBound = mlir::getAffineSymbolExpr(i * 3 + 1, context), + currentExtent = + mlir::getAffineSymbolExpr(i * 3 + 1, context), stride = mlir::getAffineSymbolExpr(i * 3 + 2, context), - currentPart = (idx - lowerBound) * extent; + currentPart = (idx * stride - lowerBound) * accuExtent; index = currentPart + index; - extent = - (upperBound - lowerBound + 1) * stride * extent; // TODO negative stride + accuExtent = accuExtent * currentExtent; } return mlir::AffineMap::get(dimensions, dimensions * 3, index); } +Optional constantIntegerLike(const mlir::Value value) { + if (auto definition = value.getDefiningOp()) + if (auto stepAttr = definition.getValue().dyn_cast()) + return stepAttr.getInt(); + return {}; +} /// Convert `fir.loop` to `affine.for` class AffineLoopConversion : public mlir::OpRewritePattern { @@ -179,29 +164,20 @@ class AffineLoopConversion : public mlir::OpRewritePattern { LLVM_DEBUG(llvm::dbgs() << "AffineLoopConversion: rewriting loop:\n"; loop.dump();); auto loopAnalysis = functionAnalysis.getChildLoopAnalysis(loop); - if (loopAnalysis.step.getValue() <= 0) { - LLVM_DEBUG(llvm::dbgs() - << "AffineLoopAnalysis: cannot promote loop for now, " - "step not postive\n";); - return failure(); - } auto &loopOps = loop.getBody()->getOperations(); - - auto affineFor = rewriter.create( - loop.getLoc(), ValueRange(loop.lowerBound()), - mlir::AffineMap::get(0, 1, - mlir::getAffineSymbolExpr(0, loop.getContext())), - ValueRange(loop.upperBound()), - mlir::AffineMap::get( - 0, 1, 1 + mlir::getAffineSymbolExpr(0, loop.getContext())), - loopAnalysis.step.getValue()); - + auto loopAndIndex = createAffineFor(loop, rewriter); + auto affineFor = loopAndIndex.first; + auto inductionVar = loopAndIndex.second; rewriter.startRootUpdate(affineFor.getOperation()); - affineFor.getBody()->getOperations().splice(affineFor.getBody()->begin(), + affineFor.getBody()->getOperations().splice(--affineFor.getBody()->end(), loopOps, loopOps.begin(), --loopOps.end()); rewriter.finalizeRootUpdate(affineFor.getOperation()); + rewriter.startRootUpdate(loop.getOperation()); + loop.getInductionVar().replaceAllUsesWith(inductionVar); + rewriter.finalizeRootUpdate(loop.getOperation()); + for (auto &bodyOp : affineFor.getBody()->getOperations()) { if (isa(bodyOp)) { if (failed(rewriteLoad(cast(bodyOp), rewriter))) { @@ -215,10 +191,6 @@ class AffineLoopConversion : public mlir::OpRewritePattern { } } - rewriter.startRootUpdate(loop.getOperation()); - loop.getInductionVar().replaceAllUsesWith(affineFor.getInductionVar()); - rewriter.finalizeRootUpdate(loop.getOperation()); - rewriter.replaceOp(loop, affineFor.getOperation()->getResults()); LLVM_DEBUG(llvm::dbgs() << "AffineLoopConversion: loop rewriten to:\n"; @@ -227,6 +199,54 @@ class AffineLoopConversion : public mlir::OpRewritePattern { } private: + std::pair + createAffineFor(fir::LoopOp op, mlir::PatternRewriter &rewriter) const { + if (auto constantStep = constantIntegerLike(op.step())) + if (constantStep.getValue() > 0) + return positiveConstantStep(op, constantStep.getValue(), rewriter); + return genericBounds(op, rewriter); + } + std::pair + positiveConstantStep(fir::LoopOp op, int64_t step, + mlir::PatternRewriter &rewriter) const { + auto affineFor = rewriter.create( + op.getLoc(), ValueRange(op.lowerBound()), + mlir::AffineMap::get(0, 1, + mlir::getAffineSymbolExpr(0, op.getContext())), + ValueRange(op.upperBound()), + mlir::AffineMap::get(0, 1, + 1 + mlir::getAffineSymbolExpr(0, op.getContext())), + step); + return std::make_pair(affineFor, affineFor.getInductionVar()); + } + std::pair + genericBounds(fir::LoopOp op, mlir::PatternRewriter &rewriter) const { + auto lowerBound = mlir::getAffineSymbolExpr(0, op.getContext()); + auto upperBound = mlir::getAffineSymbolExpr(1, op.getContext()); + auto step = mlir::getAffineSymbolExpr(2, op.getContext()); + mlir::AffineMap upperBoundMap = + mlir::AffineMap::get(0, 3, (upperBound - lowerBound + step).floorDiv(step)); + auto genericUpperBound = rewriter.create( + op.getLoc(), upperBoundMap, + ValueRange({op.lowerBound(), op.upperBound(), op.step()})); + auto actualIndexMap = mlir::AffineMap::get( + 1, 2, + (lowerBound + mlir::getAffineDimExpr(0, op.getContext())) * + mlir::getAffineSymbolExpr(1, op.getContext())); + + auto affineFor = rewriter.create( + op.getLoc(), ValueRange(), + AffineMap::getConstantMap(0, op.getContext()), + genericUpperBound.getResult(), + mlir::AffineMap::get(0, 1, + 1 + mlir::getAffineSymbolExpr(0, op.getContext())), + 1); + rewriter.setInsertionPointToStart(affineFor.getBody()); + auto actualIndex = rewriter.create( + op.getLoc(), actualIndexMap, + ValueRange({affineFor.getInductionVar(), op.lowerBound(), op.step()})); + return std::make_pair(affineFor, actualIndex.getResult()); + } mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) const { if (auto refType = op.ref().getType().dyn_cast_or_null()) { if (auto seqType = refType.getEleTy().dyn_cast_or_null()) { From 318ef0e6eb393567409953380cc2cd8950f49b9d Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Tue, 23 Jun 2020 20:26:48 +0530 Subject: [PATCH 0115/1017] [review comment] Follow mlir coding style Add more lit CHECK in tests to check the actual NULL init. Remove explicit this pointer. --- flang/test/Lower/pointer.f90 | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/flang/test/Lower/pointer.f90 b/flang/test/Lower/pointer.f90 index 7c96216e1a9ec..52888692d7c5e 100644 --- a/flang/test/Lower/pointer.f90 +++ b/flang/test/Lower/pointer.f90 @@ -4,13 +4,38 @@ subroutine pointerTests ! CHECK: fir.global @_QFpointertestsEptr1 : !fir.ptr integer, pointer :: ptr1 => NULL() + ! CHECK: %[[c0:.*]] = constant 0 : index + ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr + ! CHECK: fir.has_value [[reg2]] : !fir.ptr + ! CHECK: fir.global @_QFpointertestsEptr2 : !fir.ptr real, pointer :: ptr2 => NULL() + ! CHECK: %[[c0:.*]] = constant 0 : index + ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr + ! CHECK: fir.has_value [[reg2]] : !fir.ptr + ! CHECK: fir.global @_QFpointertestsEptr3 : !fir.ptr> complex, pointer :: ptr3 => NULL() + ! CHECK: %[[c0:.*]] = constant 0 : index + ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> + ! CHECK: fir.has_value [[reg2]] : !fir.ptr> + ! CHECK: fir.global @_QFpointertestsEptr4 : !fir.ptr character, pointer :: ptr4 => NULL() + ! CHECK: %[[c0:.*]] = constant 0 : index + ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr + ! CHECK: fir.has_value [[reg2]] : !fir.ptr + ! CHECK: fir.global @_QFpointertestsEptr5 : !fir.ptr> logical, pointer :: ptr5 => NULL() + ! CHECK: %[[c0:.*]] = constant 0 : index + ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> + ! CHECK: fir.has_value [[reg2]] : !fir.ptr> + end subroutine pointerTests From 9f84df3cbc2c2ca5ceec2db2a2a393118734a62d Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Tue, 23 Jun 2020 22:54:11 +0530 Subject: [PATCH 0116/1017] Uncaught syntax error fixed in test --- flang/test/Lower/pointer.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/test/Lower/pointer.f90 b/flang/test/Lower/pointer.f90 index 52888692d7c5e..2526ea36f0129 100644 --- a/flang/test/Lower/pointer.f90 +++ b/flang/test/Lower/pointer.f90 @@ -23,12 +23,12 @@ subroutine pointerTests ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> ! CHECK: fir.has_value [[reg2]] : !fir.ptr> - ! CHECK: fir.global @_QFpointertestsEptr4 : !fir.ptr + ! CHECK: fir.global @_QFpointertestsEptr4 : !fir.ptr> character, pointer :: ptr4 => NULL() ! CHECK: %[[c0:.*]] = constant 0 : index ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref - ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr - ! CHECK: fir.has_value [[reg2]] : !fir.ptr + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> + ! CHECK: fir.has_value [[reg2]] : !fir.ptr> ! CHECK: fir.global @_QFpointertestsEptr5 : !fir.ptr> logical, pointer :: ptr5 => NULL() From 1cc50153d788482b99c9593d524e9fc12669c812 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 19 Jun 2020 18:20:37 -0700 Subject: [PATCH 0117/1017] Tilikum: work on the lowering of boxes to descriptors. --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 340 +++++++++++++----- flang/lib/Optimizer/CodeGen/DescriptorModel.h | 40 +-- flang/test/Fir/box.fir | 51 +++ 3 files changed, 307 insertions(+), 124 deletions(-) create mode 100644 flang/test/Fir/box.fir diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index d2329d60333f0..47e296a198ba7 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -389,6 +389,8 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { fir::NameUniquer &getUniquer() { return uniquer; } + fir::KindMapping &getKindMap() { return kindMapping; } + private: fir::KindMapping kindMapping; fir::NameUniquer &uniquer; @@ -1168,9 +1170,10 @@ struct EmboxCharOpConversion : public FIROpConversion { } }; -/// create a generic box on a memory reference -struct EmboxOpConversion : public FIROpConversion { - using FIROpConversion::FIROpConversion; +// Common base class for lowering of embox to descriptor creation. +template +struct EmboxCommonConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; /// Generate an alloca of size `size` and cast it to type `toTy` mlir::LLVM::AllocaOp @@ -1181,89 +1184,217 @@ struct EmboxOpConversion : public FIROpConversion { auto *thisBlock = rewriter.getInsertionBlock(); auto func = mlir::cast(thisBlock->getParentOp()); rewriter.setInsertionPointToStart(&func.front()); - auto sz = genConstantOffset(loc, rewriter, 1); + auto sz = this->genConstantOffset(loc, rewriter, 1); auto al = rewriter.create(loc, toTy, sz, alignment); rewriter.restoreInsertionPoint(thisPt); return al; } - mlir::LLVM::BitcastOp genGEPToField(mlir::Location loc, - mlir::LLVM::LLVMType ty, - mlir::ConversionPatternRewriter &rewriter, - mlir::Value base, mlir::Value zero, - int field) const { - auto fld = genConstantOffset(loc, rewriter, field); - auto gep = genGEP(loc, ty, rewriter, base, zero, fld); - return rewriter.create(loc, ty, gep); + template + mlir::LLVM::GEPOp genGEPToField(mlir::Location loc, mlir::LLVM::LLVMType ty, + mlir::ConversionPatternRewriter &rewriter, + mlir::Value base, mlir::Value zero, + FLDS... fields) const { + return this->genGEP(loc, ty.getPointerTo(), rewriter, base, zero, + this->genConstantOffset(loc, rewriter, fields)...); + } + + static mlir::LLVM::LLVMType getBoxEleTy(mlir::LLVM::LLVMType boxPtrTy, + unsigned i) { + return boxPtrTy.getPointerElementTy().getStructElementType(i); + } + + // Perform an extension or truncation as needed on an integer value + mlir::Value integerCast(mlir::Location loc, + mlir::ConversionPatternRewriter &rewriter, + mlir::LLVM::LLVMType ty, mlir::Value val) const { + auto toSize = ty.getUnderlyingType()->getPrimitiveSizeInBits(); + auto fromSize = val.getType() + .cast() + .getUnderlyingType() + ->getPrimitiveSizeInBits(); + if (toSize < fromSize) + return rewriter.create(loc, ty, val); + if (toSize > fromSize) + return rewriter.create(loc, ty, val); + return val; + } + + // Get the element size and CFI type code of the boxed value. + std::tuple + getSizeAndTypeCode(mlir::Location loc, + mlir::ConversionPatternRewriter &rewriter, + mlir::Type boxEleTy) const { + auto doInteger = + [&](unsigned width) -> std::tuple { + int typeCode; + switch (width) { + case 8: + typeCode = CFI_type_int8_t; + break; + case 16: + typeCode = CFI_type_int16_t; + break; + case 32: + typeCode = CFI_type_int32_t; + break; + case 64: + typeCode = CFI_type_int64_t; + break; + case 128: + typeCode = CFI_type_int128_t; + break; + default: + llvm_unreachable("unsupported integer size"); + } + return {this->genConstantOffset(loc, rewriter, width / 8), + this->genConstantOffset(loc, rewriter, typeCode)}; + }; + auto doFloat = [&](unsigned width) -> std::tuple { + int typeCode; + switch (width) { + case 32: + typeCode = CFI_type_float; + break; + case 64: + typeCode = CFI_type_double; + break; + case 80: + case 128: + typeCode = CFI_type_long_double; + break; + default: + llvm_unreachable("unsupported real size"); + } + return {this->genConstantOffset(loc, rewriter, width / 8), + this->genConstantOffset(loc, rewriter, typeCode)}; + }; + auto doComplex = + [&](unsigned width) -> std::tuple { + int typeCode; + switch (width) { + case 32: + typeCode = CFI_type_float_Complex; + break; + case 64: + typeCode = CFI_type_double_Complex; + break; + case 80: + case 128: + typeCode = CFI_type_long_double_Complex; + break; + default: + llvm_unreachable("unsupported complex size"); + } + return {this->genConstantOffset(loc, rewriter, width / 4), + this->genConstantOffset(loc, rewriter, typeCode)}; + }; + auto getKindMap = [&]() -> fir::KindMapping & { + return this->lowerTy().getKindMap(); + }; + + if (fir::isa_integer(boxEleTy)) { + if (auto ty = boxEleTy.dyn_cast()) + return doInteger(ty.getWidth()); + auto ty = boxEleTy.cast(); + return doInteger(getKindMap().getIntegerBitsize(ty.getFKind())); + } + if (fir::isa_real(boxEleTy)) { + if (auto ty = boxEleTy.dyn_cast()) + return doFloat(ty.getWidth()); + auto ty = boxEleTy.cast(); + return doFloat(getKindMap().getRealBitsize(ty.getFKind())); + } + if (fir::isa_complex(boxEleTy)) { + if (auto ty = boxEleTy.dyn_cast()) + return doComplex( + ty.getElementType().cast().getWidth()); + auto ty = boxEleTy.cast(); + return doComplex(getKindMap().getRealBitsize(ty.getFKind())); + } + if (auto ty = boxEleTy.dyn_cast()) { + TODO(); + } + if (auto ty = boxEleTy.dyn_cast()) + return doInteger(getKindMap().getLogicalBitsize(ty.getFKind())); + if (auto seqTy = boxEleTy.dyn_cast()) + return getSizeAndTypeCode(loc, rewriter, seqTy.getEleTy()); + if (boxEleTy.isa()) { + TODO(); + } + if (fir::isa_ref_type(boxEleTy)) { + // FIXME: use the target pointer size rather than sizeof(void*) + return {this->genConstantOffset(loc, rewriter, sizeof(void *)), + this->genConstantOffset(loc, rewriter, CFI_type_cptr)}; + } + // fail: unhandled case + TODO(); } +}; + +/// Create a generic box on a memory reference. This conversions lowers the +/// abstract box to the appropriate, initialized descriptor. +struct EmboxOpConversion : public EmboxCommonConversion { + using EmboxCommonConversion::EmboxCommonConversion; mlir::LogicalResult matchAndRewrite(fir::EmboxOp embox, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - auto dims = embox.getDims(); - assert(!dims); + // There should be no dims on this embox op + assert(!embox.getDims()); + auto loc = embox.getLoc(); auto *dialect = getDialect(); - auto ty = unwrap( - lowerTy().convertBoxType(embox.getType().dyn_cast(), 0)); + auto boxTy = embox.getType().dyn_cast(); + assert(boxTy); + auto ty = unwrap(lowerTy().convertBoxType(boxTy, 0)); auto alloca = genAllocaWithType(loc, ty, defaultAlign, dialect, rewriter); auto c0 = genConstantOffset(loc, rewriter, 0); - auto rty = unwrap(operands[0].getType()).getPointerTo(); - auto f0p = genGEP(loc, rty, rewriter, alloca, c0, c0); - auto f0p_ = rewriter.create(loc, rty, f0p); - rewriter.create(loc, operands[0], f0p_); - auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(dialect); - auto i64PtrTy = i64Ty.getPointerTo(); - auto f1p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 1); - auto c0_ = rewriter.create(loc, i64Ty, c0); - rewriter.create(loc, c0_, f1p); - auto i32PtrTy = mlir::LLVM::LLVMType::getInt32Ty(dialect).getPointerTo(); - auto f2p = genGEPToField(loc, i32PtrTy, rewriter, alloca, c0, 2); - rewriter.create(loc, c0, f2p); - auto i8Ty = mlir::LLVM::LLVMType::getInt8Ty(dialect); - auto i8PtrTy = mlir::LLVM::LLVMType::getInt8PtrTy(dialect); - auto c0__ = rewriter.create(loc, i8Ty, c0); - auto f3p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 3); - rewriter.create(loc, c0__, f3p); - auto f4p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 4); - rewriter.create(loc, c0__, f4p); - auto f5p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 5); - rewriter.create(loc, c0__, f5p); - auto f6p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 6); - rewriter.create(loc, c0__, f6p); + + // Basic pattern to write a field in the descriptor + auto storeField = [&](unsigned fldIndex, mlir::Value value, + const std::function &applyCast) { + auto fldTy = getBoxEleTy(ty, fldIndex); + auto fldPtr = genGEPToField(loc, fldTy, rewriter, alloca, c0, fldIndex); + auto fld = applyCast(fldTy, value); + rewriter.create(loc, fld, fldPtr); + }; + + // Write each of the fields with the appropriate values + storeField(0, operands[0], [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return rewriter.create(loc, ty, val).getResult(); + }); + auto [eleSize, cfiTy] = getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy()); + storeField(1, eleSize, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + auto version = genConstantOffset(loc, rewriter, CFI_VERSION); + storeField(2, version, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + storeField(3, /*rank*/ c0, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + storeField(4, cfiTy, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + auto attr = genConstantOffset(loc, rewriter, CFI_attribute_other); + storeField(5, attr, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + storeField(6, /*addend*/ c0, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + rewriter.replaceOp(embox, alloca.getResult()); return success(); } }; /// create a generic box on a memory reference -struct XEmboxOpConversion : public FIROpConversion { - using FIROpConversion::FIROpConversion; - - /// Generate an alloca of size `size` and cast it to type `toTy` - mlir::LLVM::AllocaOp - genAllocaWithType(mlir::Location loc, mlir::LLVM::LLVMType toTy, - unsigned alignment, mlir::LLVM::LLVMDialect *dialect, - mlir::ConversionPatternRewriter &rewriter) const { - auto thisPt = rewriter.saveInsertionPoint(); - auto *thisBlock = rewriter.getInsertionBlock(); - auto func = mlir::cast(thisBlock->getParentOp()); - rewriter.setInsertionPointToStart(&func.front()); - auto sz = genConstantOffset(loc, rewriter, 1); - auto al = rewriter.create(loc, toTy, sz, alignment); - rewriter.restoreInsertionPoint(thisPt); - return al; - } - - template - mlir::LLVM::BitcastOp - genGEPToField(mlir::Location loc, mlir::LLVM::LLVMType ty, - mlir::ConversionPatternRewriter &rewriter, mlir::Value base, - mlir::Value zero, FLDS... fields) const { - auto gep = genGEP(loc, ty, rewriter, base, zero, - genConstantOffset(loc, rewriter, fields)...); - return rewriter.create(loc, ty, gep); - } +struct XEmboxOpConversion : public EmboxCommonConversion { + using EmboxCommonConversion::EmboxCommonConversion; mlir::LogicalResult matchAndRewrite(fir::XEmboxOp xbox, OperandTy operands, @@ -1271,47 +1402,66 @@ struct XEmboxOpConversion : public FIROpConversion { auto loc = xbox.getLoc(); auto *dialect = getDialect(); auto rank = xbox.getRank(); - auto ty = unwrap(lowerTy().convertBoxType( - xbox.getType().dyn_cast(), rank)); - + auto boxTy = xbox.getType().dyn_cast(); + assert(boxTy); + auto ty = unwrap(lowerTy().convertBoxType(boxTy, rank)); auto alloca = genAllocaWithType(loc, ty, defaultAlign, dialect, rewriter); auto c0 = genConstantOffset(loc, rewriter, 0); - auto rty = unwrap(operands[0].getType()).getPointerTo(); - auto f0p = genGEP(loc, rty, rewriter, alloca, c0, c0); - auto f0p_ = rewriter.create(loc, rty, f0p); - rewriter.create(loc, operands[0], f0p_); + + // Basic pattern to write a field in the descriptor + auto storeField = [&](unsigned fldIndex, mlir::Value value, + const std::function &applyCast) { + auto fldTy = getBoxEleTy(ty, fldIndex); + auto fldPtr = genGEPToField(loc, fldTy, rewriter, alloca, c0, fldIndex); + auto fld = applyCast(fldTy, value); + rewriter.create(loc, fld, fldPtr); + }; + + // Write each of the fields with the appropriate values + storeField(0, operands[0], [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return rewriter.create(loc, ty, val).getResult(); + }); + auto [eleSize, cfiTy] = getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy()); + storeField(1, eleSize, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + auto version = genConstantOffset(loc, rewriter, CFI_VERSION); + storeField(2, version, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + auto rankVal = genConstantOffset(loc, rewriter, rank); + storeField(3, rankVal, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + storeField(4, cfiTy, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + auto attr = genConstantOffset(loc, rewriter, CFI_attribute_other); + storeField(5, attr, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + storeField(6, /*addend*/ c0, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { + return integerCast(loc, rewriter, ty, val); + }); + + unsigned dimsOff = 1; auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(dialect); auto i64PtrTy = i64Ty.getPointerTo(); - auto f1p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 1); - auto c0_ = rewriter.create(loc, i64Ty, c0); - rewriter.create(loc, c0_, f1p); - auto i32PtrTy = mlir::LLVM::LLVMType::getInt32Ty(dialect).getPointerTo(); - auto f2p = genGEPToField(loc, i32PtrTy, rewriter, alloca, c0, 2); - rewriter.create(loc, c0, f2p); - auto i8Ty = mlir::LLVM::LLVMType::getInt8Ty(dialect); - auto i8PtrTy = mlir::LLVM::LLVMType::getInt8PtrTy(dialect); - auto c0__ = rewriter.create(loc, i8Ty, c0); - auto f3p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 3); - rewriter.create(loc, c0__, f3p); - auto f4p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 4); - rewriter.create(loc, c0__, f4p); - auto f5p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 5); - rewriter.create(loc, c0__, f5p); - auto f6p = genGEPToField(loc, i8PtrTy, rewriter, alloca, c0, 6); - rewriter.create(loc, c0__, f6p); - auto dimsIter = xbox.dimsOperands().begin(); for (unsigned d = 0; d < rank; ++d) { // store lower bound (normally 0) auto f70p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 7, d, 0); - rewriter.create(loc, *dimsIter++, f70p); + rewriter.create(loc, operands[dimsOff++], f70p); // store extent auto f71p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 7, d, 1); - rewriter.create(loc, *dimsIter++, f71p); + rewriter.create(loc, operands[dimsOff++], f71p); // store step (scaled by extent to save a multiplication) auto f72p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 7, d, 2); - rewriter.create(loc, *dimsIter++, f72p); + rewriter.create(loc, operands[dimsOff++], f72p); } - rewriter.replaceOp(xbox, alloca.getResult()); + auto desc = rewriter.create( + loc, lowerTy().convertType(boxTy), alloca); + rewriter.replaceOp(xbox, desc.getResult()); return success(); } }; diff --git a/flang/lib/Optimizer/CodeGen/DescriptorModel.h b/flang/lib/Optimizer/CodeGen/DescriptorModel.h index 5be34ffea67ce..0c797694b352f 100644 --- a/flang/lib/Optimizer/CodeGen/DescriptorModel.h +++ b/flang/lib/Optimizer/CodeGen/DescriptorModel.h @@ -18,46 +18,26 @@ namespace fir { //===----------------------------------------------------------------------===// -// Static size information -//===----------------------------------------------------------------------===// - -static constexpr std::size_t sizeOfDimElement() { - return sizeof(Fortran::ISO::Fortran_2018::CFI_index_t); -} -static constexpr std::size_t sizeOfDimRow() { - return sizeof(Fortran::ISO::Fortran_2018::CFI_dim_t); -} -static constexpr std::size_t sizeOfBareDesc() { - return sizeof(Fortran::ISO::Fortran_2018::CFI_cdesc_t); -} -static constexpr std::size_t sizeOfDesc(unsigned rank) { - return sizeOfBareDesc() + rank * sizeOfDimRow(); -} -static constexpr std::size_t sizeOfTypeParam() { - return sizeof(Fortran::runtime::TypeParameterValue); -} -static constexpr std::size_t sizeOfDescAddendum() { - return sizeof(Fortran::runtime::DescriptorAddendum); -} -static constexpr std::size_t sizeOfExtendedDesc(unsigned rank, - unsigned lenParams) { - return sizeOfDesc(rank) + sizeOfDescAddendum() + - lenParams * sizeOfTypeParam(); -} - -//===----------------------------------------------------------------------===// -// Descriptor reflection +// LLVM IR dialect models of C++ types. // // This supplies a set of model builders to decompose the C declaration of a // descriptor (as encoded in ISO_Fortran_binding.h and elsewhere) and // reconstruct that type in the LLVM IR dialect. // +// TODO: It is understood that this is deeply incorrect as far as building a +// portability layer for cross-compilation as these reflected types are those of +// the build machine and not necessarily that of either the host or the target. +// This assumption that build == host == target is actually pervasive across the +// compiler. +// //===----------------------------------------------------------------------===// using TypeBuilderFunc = mlir::LLVM::LLVMType (*)(mlir::LLVM::LLVMDialect *); +/// Get the LLVM IR dialect model for building a particular C++ type, `T`. template TypeBuilderFunc getModel(); + template <> TypeBuilderFunc getModel() { return [](mlir::LLVM::LLVMDialect *dialect) { @@ -123,6 +103,8 @@ getModel>() { return getModel(); } +//===----------------------------------------------------------------------===// +// Descriptor reflection //===----------------------------------------------------------------------===// /// Get the type model of the field number `Field` in an ISO descriptor. diff --git a/flang/test/Fir/box.fir b/flang/test/Fir/box.fir new file mode 100644 index 0000000000000..5d159f061b223 --- /dev/null +++ b/flang/test/Fir/box.fir @@ -0,0 +1,51 @@ +// RUN: tco -o - %s | FileCheck %s + +// CHECK-LABEL: declare void @g({ float*, i64, i32, i8, i8, i8, i8 }*) +func @g(%b : !fir.box) +// CHECK-LABEL: declare void @ga({ float*, i64, i32, i8, i8, i8, i8 }*) +func @ga(%b : !fir.box>) + +// CHECK-LABEL: define void @f +// CHECK: (float* %[[ARG:.*]]) +func @f(%a : !fir.ref) { + // CHECK: %[[GEP0:.*]] = getelementptr {{.*}}, i32 0, i32 0 + // CHECK: store float* %[[ARG]], float** %[[GEP0]] + // CHECK: %[[GEP1:.*]] = getelementptr {{.*}}, i32 0, i32 1 + // CHECK: store i64 {{.*}}, i64* %[[GEP1]] + // CHECK: %[[GEP2:.*]] = getelementptr {{.*}}, i32 0, i32 2 + // CHECK: store i32 {{.*}}, i32* %[[GEP2]] + // CHECK: %[[GEP3:.*]] = getelementptr {{.*}}, i32 0, i32 3 + // CHECK: store i8 {{.*}}, i8* %[[GEP3]] + // CHECK: %[[GEP4:.*]] = getelementptr {{.*}}, i32 0, i32 4 + // CHECK: store i8 {{.*}}, i8* %[[GEP4]] + // CHECK: %[[GEP5:.*]] = getelementptr {{.*}}, i32 0, i32 5 + // CHECK: store i8 {{.*}}, i8* %[[GEP5]] + // CHECK: %[[GEP6:.*]] = getelementptr {{.*}}, i32 0, i32 6 + // CHECK: store i8 {{.*}}, i8* %[[GEP6]] + %b = fir.embox %a : (!fir.ref) -> !fir.box + + // CHECK: call void @g( + fir.call @g(%b) : (!fir.box) -> () + // CHECK: ret void + return +} + +// CHECK-LABEL: define void @fa +// CHECK: ([100 x float]* %[[ARG:.*]]) +func @fa(%a : !fir.ref>) { + %c = fir.convert %a : (!fir.ref>) -> !fir.ref> + %c1 = constant 1 : index + %c100 = constant 100 : index + %d = fir.gendims %c1, %c100, %c1 : (index, index, index) -> !fir.dims<1> + // CHECK: %[[GEP70:.*]] = getelementptr {{.*}}, i32 0, i32 7, i32 0, i32 0 + // CHECK: store i64 {{.*}}, i64* %[[GEP70]] + // CHECK: %[[GEP71:.*]] = getelementptr {{.*}}, i32 0, i32 7, i32 0, i32 1 + // CHECK: store i64 {{.*}}, i64* %[[GEP71]] + // CHECK: %[[GEP72:.*]] = getelementptr {{.*}}, i32 0, i32 7, i32 0, i32 2 + // CHECK: store i64 {{.*}}, i64* %[[GEP72]] + %b = fir.embox %c, %d : (!fir.ref>, !fir.dims<1>) -> !fir.box> + // CHECK: call void @ga( + fir.call @ga(%b) : (!fir.box>) -> () + // CHECK: ret void + return +} From 1a357cd0222037497d386d7140957073427054d0 Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 24 Jun 2020 11:01:01 -0700 Subject: [PATCH 0118/1017] Remove the dependence on string literal operator template extensions to support more build compilers (e.g., MSVC). --- flang/lib/Lower/Runtime.cpp | 2 -- 1 file changed, 2 deletions(-) diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index 98afa14452e7b..2dd74158362a3 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -15,8 +15,6 @@ #include "flang/Semantics/tools.h" #include "llvm/ADT/SmallVector.h" -using Fortran::lower::operator""_rt_ident; - #define MakeRuntimeEntry(X) mkKey(RTNAME(X)) template From d8b62e5608a54bcab506dd4012dd35e01b5a0744 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 26 Jun 2020 15:32:27 -0700 Subject: [PATCH 0119/1017] remove workaround after rebasing --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 47e296a198ba7..39b06deb4c3a4 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -2694,12 +2694,7 @@ struct FIRToLLVMLoweringPass SubfOpConversion, UnboxCharOpConversion, UnboxOpConversion, UnboxProcOpConversion, UndefOpConversion, UnreachableOpConversion, XArrayCoorOpConversion, XEmboxOpConversion>(context, typeConverter); - // Workaround D80285: beware, optional LowerToLLVMOptions argument of - // populateStdToLLVMConversionPatterns is broken. It ends up creating a - // reference over a temp that has the lifetime of the call. Do not use - // it. - mlir::LowerToLLVMOptions options; - mlir::populateStdToLLVMConversionPatterns(typeConverter, pattern, options); + mlir::populateStdToLLVMConversionPatterns(typeConverter, pattern); mlir::ConversionTarget target{*context}; target.addLegalDialect(); From e35601355846f28b3fad64e18207e0027831537c Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 26 Jun 2020 13:20:11 -0700 Subject: [PATCH 0120/1017] fix for bug#203 --- flang/lib/Lower/Bridge.cpp | 77 +++++++++++++++++++++++++++++++------- 1 file changed, 64 insertions(+), 13 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index f26c99f68eb6a..dfbfa79f2c51f 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -101,6 +101,42 @@ static bool isExplicitShape(const Fortran::semantics::Symbol &sym) { return det && det->IsArray() && det->shape().IsExplicitShape(); } +// Retrieve a copy of a character literal string from a SomeExpr. +template +llvm::Optional> getCharacterLiteralCopy( + const Fortran::evaluate::Expr< + Fortran::evaluate::Type> + &x) { + if (const auto *con = + Fortran::evaluate::UnwrapConstantValue>(x)) + if (auto val = con->GetScalarValue()) + return std::tuple{ + std::string{(const char *)val->c_str(), + KIND * (std::size_t)con->LEN()}, + (std::size_t)con->LEN()}; + return llvm::None; +} +llvm::Optional> getCharacterLiteralCopy( + const Fortran::evaluate::Expr &x) { + return std::visit([](const auto &e) { return getCharacterLiteralCopy(e); }, + x.u); +} +llvm::Optional> getCharacterLiteralCopy( + const Fortran::evaluate::Expr &x) { + if (const auto *e = Fortran::evaluate::UnwrapExpr< + Fortran::evaluate::Expr>(x)) + return getCharacterLiteralCopy(*e); + return llvm::None; +} +template +llvm::Optional> +getCharacterLiteralCopy(const std::optional &x) { + if (x) + return getCharacterLiteralCopy(*x); + return llvm::None; +} + namespace { struct SymbolBoxAnalyzer { using FromBox = std::monostate; @@ -752,12 +788,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { info.isStructured() ? builder->getIndexType() : info.loopVariableType; auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); auto upperValue = genFIRLoopIndex(info.upperExpr, type); - info.stepValue = info.stepExpr.has_value() - ? genFIRLoopIndex(*info.stepExpr, type) - : info.isStructured() - ? builder->create(loc, 1) - : builder->createIntegerConstant( - loc, info.loopVariableType, 1); + info.stepValue = + info.stepExpr.has_value() ? genFIRLoopIndex(*info.stepExpr, type) + : info.isStructured() + ? builder->create(loc, 1) + : builder->createIntegerConstant(loc, info.loopVariableType, 1); assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(loc, *info.loopVariableSym); @@ -1535,6 +1570,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { fir::GlobalOp global; bool isConst = sym.attrs().test(Fortran::semantics::Attr::PARAMETER); auto loc = toLocation(); + // FIXME: name returned does not consider subprogram's scope, is not unique if (builder->getNamedGlobal(globalName)) return; if (const auto *details = @@ -1544,13 +1580,28 @@ class FirConverter : public Fortran::lower::AbstractConverter { TODO(); // Derived type / polymorphic } auto symTy = genType(var); - global = builder->createGlobal( - loc, symTy, globalName, isConst, - [&](Fortran::lower::FirOpBuilder &builder) { - auto initVal = genExprValue(details->init().value()); - auto castTo = builder.createConvert(loc, symTy, initVal); - builder.create(loc, castTo); - }); + if (symTy.isa()) { + if (auto chLit = getCharacterLiteralCopy(details->init().value())) { + fir::SequenceType::Shape len; + len.push_back(std::get(*chLit)); + symTy = fir::SequenceType::get(len, symTy); + auto init = builder->getStringAttr(std::get(*chLit)); + auto linkage = builder->getStringAttr("internal"); + global = builder->createGlobal(loc, symTy, globalName, linkage, + init, isConst); + } else { + llvm::report_fatal_error( + "global CHARACTER has unexpected initial value"); + } + } else { + global = builder->createGlobal( + loc, symTy, globalName, isConst, + [&](Fortran::lower::FirOpBuilder &builder) { + auto initVal = genExprValue(details->init().value()); + auto castTo = builder.createConvert(loc, symTy, initVal); + builder.create(loc, castTo); + }); + } } else { global = builder->createGlobal(loc, genType(var), globalName); } From 311904e83cabbd8828e0d3d19ace312c435dc106 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 26 Jun 2020 15:48:26 -0700 Subject: [PATCH 0121/1017] Merge PR #205 --- flang/lib/Lower/PFTBuilder.cpp | 1061 ++++++++++---------------------- 1 file changed, 316 insertions(+), 745 deletions(-) diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index b0bd5bec1694e..075fa04f97910 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -7,29 +7,17 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/PFTBuilder.h" -#include "IntervalSet.h" -#include "flang/Lower/Support/Utils.h" +#include "flang/Lower/Utils.h" #include "flang/Parser/dump-parse-tree.h" #include "flang/Parser/parse-tree-visitor.h" #include "flang/Semantics/semantics.h" #include "flang/Semantics/tools.h" -#include "llvm/ADT/DenseSet.h" -#include "llvm/ADT/IntervalMap.h" #include "llvm/Support/CommandLine.h" -#include "llvm/Support/Debug.h" - -#define DEBUG_TYPE "flang-pft" static llvm::cl::opt clDisableStructuredFir( "no-structured-fir", llvm::cl::desc("disable generation of structured FIR"), llvm::cl::init(false), llvm::cl::Hidden); -static llvm::cl::opt nonRecursiveProcedures( - "non-recursive-procedures", - llvm::cl::desc("Make procedures non-recursive by default. This was the " - "default for all Fortran standards prior to 2018."), - llvm::cl::init(/*2018 standard=*/false)); - using namespace Fortran; namespace { @@ -78,8 +66,8 @@ class PFTBuilder { PFTBuilder(const semantics::SemanticsContext &semanticsContext) : pgm{std::make_unique()}, semanticsContext{ semanticsContext} { - lower::pft::PftNode pftRoot{*pgm.get()}; - pftParentStack.push_back(pftRoot); + lower::pft::ParentVariant parent{*pgm.get()}; + parentVariantStack.push_back(parent); } /// Get the result @@ -95,65 +83,24 @@ class PFTBuilder { } else if constexpr (UnwrapStmt::isStmt) { using T = typename UnwrapStmt::Type; // Node "a" being visited has one of the following types: - // Statement, Statement>, UnlabeledStatement, + // Statement, Statement, UnlabeledStatement, // or UnlabeledStatement> auto stmt{UnwrapStmt(a)}; if constexpr (lower::pft::isConstructStmt || lower::pft::isOtherStmt) { - addEvaluation(lower::pft::Evaluation{ - stmt.unwrapped, pftParentStack.back(), stmt.position, stmt.label}); + addEvaluation(lower::pft::Evaluation{stmt.unwrapped, + parentVariantStack.back(), + stmt.position, stmt.label}); return false; } else if constexpr (std::is_same_v) { - return std::visit( - common::visitors{ - [&](const common::Indirection &x) { - convertIfStmt(x.value(), stmt.position, stmt.label); - return false; - }, - [&](const auto &x) { - addEvaluation(lower::pft::Evaluation{ - removeIndirection(x), pftParentStack.back(), - stmt.position, stmt.label}); - return true; - }, - }, - stmt.unwrapped.u); + addEvaluation( + makeEvaluationAction(stmt.unwrapped, stmt.position, stmt.label)); + return true; } } return true; } - /// Convert an IfStmt into an IfConstruct, retaining the IfStmt as the - /// first statement of the construct. - void convertIfStmt(const parser::IfStmt &ifStmt, parser::CharBlock position, - std::optional label) { - // Generate a skeleton IfConstruct parse node. Its components are never - // referenced. The actual components are available via the IfConstruct - // evaluation's nested evaluationList, with the ifStmt in the position of - // the otherwise normal IfThenStmt. Caution: All other PFT nodes reference - // front end generated parse nodes; this is an exceptional case. - static const auto ifConstruct = parser::IfConstruct{ - parser::Statement{ - std::nullopt, - parser::IfThenStmt{ - std::optional{}, - parser::ScalarLogicalExpr{parser::LogicalExpr{parser::Expr{ - parser::LiteralConstant{parser::LogicalLiteralConstant{ - false, std::optional{}}}}}}}}, - parser::Block{}, std::list{}, - std::optional{}, - parser::Statement{std::nullopt, - parser::EndIfStmt{std::nullopt}}}; - enterConstructOrDirective(ifConstruct); - addEvaluation( - lower::pft::Evaluation{ifStmt, pftParentStack.back(), position, label}); - Pre(std::get>(ifStmt.t)); - static const auto endIfStmt = parser::EndIfStmt{std::nullopt}; - addEvaluation( - lower::pft::Evaluation{endIfStmt, pftParentStack.back(), {}, {}}); - exitConstructOrDirective(); - } - template constexpr void Post(const A &) { if constexpr (lower::pft::isFunctionLike) { @@ -173,16 +120,25 @@ class PFTBuilder { // Block data bool Pre(const parser::BlockData &node) { - addUnit(lower::pft::BlockDataUnit{node, pftParentStack.back(), - semanticsContext}); + addUnit(lower::pft::BlockDataUnit{node, parentVariantStack.back()}); return false; } // Get rid of production wrapper + bool Pre(const parser::UnlabeledStatement + &statement) { + addEvaluation(std::visit( + [&](const auto &x) { + return lower::pft::Evaluation{ + x, parentVariantStack.back(), statement.source, {}}; + }, + statement.statement.u)); + return false; + } bool Pre(const parser::Statement &statement) { addEvaluation(std::visit( [&](const auto &x) { - return lower::pft::Evaluation{x, pftParentStack.back(), + return lower::pft::Evaluation{x, parentVariantStack.back(), statement.source, statement.label}; }, statement.statement.u)); @@ -195,7 +151,7 @@ class PFTBuilder { // Not caught as other AssignmentStmt because it is not // wrapped in a parser::ActionStmt. addEvaluation(lower::pft::Evaluation{stmt.statement, - pftParentStack.back(), + parentVariantStack.back(), stmt.source, stmt.label}); return false; }, @@ -204,69 +160,30 @@ class PFTBuilder { whereBody.u); } - // CompilerDirective have special handling in case they are top level - // directives (i.e. they do not belong to a ProgramUnit). - bool Pre(const parser::CompilerDirective &directive) { - assert(pftParentStack.size() > 0 && - "At least the Program must be a parent"); - if (pftParentStack.back().isA()) { - addUnit( - lower::pft::CompilerDirectiveUnit(directive, pftParentStack.back())); - return false; - } - return enterConstructOrDirective(directive); - } - private: /// Initialize a new module-like unit and make it the builder's focus. template bool enterModule(const A &func) { auto &unit = - addUnit(lower::pft::ModuleLikeUnit{func, pftParentStack.back()}); + addUnit(lower::pft::ModuleLikeUnit{func, parentVariantStack.back()}); functionList = &unit.nestedFunctions; - pftParentStack.emplace_back(unit); + parentVariantStack.emplace_back(unit); return true; } void exitModule() { - pftParentStack.pop_back(); + parentVariantStack.pop_back(); resetFunctionState(); } - /// Add the end statement Evaluation of a sub/program to the PFT. - /// There may be intervening internal subprogram definitions between - /// prior statements and this end statement. + /// Ensure that a function has a branch target after the last user statement. void endFunctionBody() { - if (evaluationListStack.empty()) - return; - auto evaluationList = evaluationListStack.back(); - if (evaluationList->empty() || !evaluationList->back().isEndStmt()) { - const auto &endStmt = - pftParentStack.back().get().endStmt; - endStmt.visit(common::visitors{ - [&](const parser::Statement &s) { - addEvaluation(lower::pft::Evaluation{ - s.statement, pftParentStack.back(), s.source, s.label}); - }, - [&](const parser::Statement &s) { - addEvaluation(lower::pft::Evaluation{ - s.statement, pftParentStack.back(), s.source, s.label}); - }, - [&](const parser::Statement &s) { - addEvaluation(lower::pft::Evaluation{ - s.statement, pftParentStack.back(), s.source, s.label}); - }, - [&](const parser::Statement &s) { - addEvaluation(lower::pft::Evaluation{ - s.statement, pftParentStack.back(), s.source, s.label}); - }, - [&](const auto &s) { - llvm::report_fatal_error("missing end statement or unexpected " - "begin statement reference"); - }, - }); + if (lastLexicalEvaluation) { + static const parser::ContinueStmt endTarget{}; + addEvaluation( + lower::pft::Evaluation{endTarget, parentVariantStack.back(), {}, {}}); + lastLexicalEvaluation = nullptr; } - lastLexicalEvaluation = nullptr; } /// Initialize a new function-like unit and make it the builder's focus. @@ -275,50 +192,47 @@ class PFTBuilder { const semantics::SemanticsContext &semanticsContext) { endFunctionBody(); // enclosing host subprogram body, if any auto &unit = addFunction(lower::pft::FunctionLikeUnit{ - func, pftParentStack.back(), semanticsContext}); + func, parentVariantStack.back(), semanticsContext}); labelEvaluationMap = &unit.labelEvaluationMap; assignSymbolLabelMap = &unit.assignSymbolLabelMap; functionList = &unit.nestedFunctions; pushEvaluationList(&unit.evaluationList); - pftParentStack.emplace_back(unit); + parentVariantStack.emplace_back(unit); return true; } void exitFunction() { - rewriteIfGotos(); endFunctionBody(); analyzeBranches(nullptr, *evaluationListStack.back()); // add branch links - processEntryPoints(); popEvaluationList(); labelEvaluationMap = nullptr; assignSymbolLabelMap = nullptr; - pftParentStack.pop_back(); + parentVariantStack.pop_back(); resetFunctionState(); } /// Initialize a new construct and make it the builder's focus. template bool enterConstructOrDirective(const A &construct) { - auto &eval = - addEvaluation(lower::pft::Evaluation{construct, pftParentStack.back()}); + auto &eval = addEvaluation( + lower::pft::Evaluation{construct, parentVariantStack.back()}); eval.evaluationList.reset(new lower::pft::EvaluationList); pushEvaluationList(eval.evaluationList.get()); - pftParentStack.emplace_back(eval); + parentVariantStack.emplace_back(eval); constructAndDirectiveStack.emplace_back(&eval); return true; } void exitConstructOrDirective() { - rewriteIfGotos(); popEvaluationList(); - pftParentStack.pop_back(); + parentVariantStack.pop_back(); constructAndDirectiveStack.pop_back(); } /// Reset function state to that of an enclosing host function. void resetFunctionState() { - if (!pftParentStack.empty()) { - pftParentStack.back().visit(common::visitors{ + if (!parentVariantStack.empty()) { + parentVariantStack.back().visit(common::visitors{ [&](lower::pft::FunctionLikeUnit &p) { functionList = &p.nestedFunctions; labelEvaluationMap = &p.labelEvaluationMap; @@ -356,8 +270,9 @@ class PFTBuilder { return std::visit( common::visitors{ [&](const auto &x) { - return lower::pft::Evaluation{ - removeIndirection(x), pftParentStack.back(), position, label}; + return lower::pft::Evaluation{removeIndirection(x), + parentVariantStack.back(), position, + label}; }, }, statement.u); @@ -366,13 +281,13 @@ class PFTBuilder { /// Append an Evaluation to the end of the current list. lower::pft::Evaluation &addEvaluation(lower::pft::Evaluation &&eval) { assert(functionList && "not in a function"); - assert(!evaluationListStack.empty() && "empty evaluation list stack"); - if (!constructAndDirectiveStack.empty()) + assert(evaluationListStack.size() > 0); + if (constructAndDirectiveStack.size() > 0) { eval.parentConstruct = constructAndDirectiveStack.back(); - auto &entryPointList = eval.getOwningProcedure()->entryPointList; + } evaluationListStack.back()->emplace_back(std::move(eval)); lower::pft::Evaluation *p = &evaluationListStack.back()->back(); - if (p->isActionStmt() || p->isConstructStmt() || p->isEndStmt()) { + if (p->isActionStmt() || p->isConstructStmt()) { if (lastLexicalEvaluation) { lastLexicalEvaluation->lexicalSuccessor = p; p->printIndex = lastLexicalEvaluation->printIndex + 1; @@ -380,28 +295,18 @@ class PFTBuilder { p->printIndex = 1; } lastLexicalEvaluation = p; - for (auto entryIndex = entryPointList.size() - 1; - entryIndex && !entryPointList[entryIndex].second->lexicalSuccessor; - --entryIndex) - // Link to the entry's first executable statement. - entryPointList[entryIndex].second->lexicalSuccessor = p; - } else if (const auto *entryStmt = p->getIf()) { - const auto *sym = std::get(entryStmt->t).symbol; - assert(sym->has() && - "entry must be a subprogram"); - entryPointList.push_back(std::pair{sym, p}); } - if (p->label.has_value()) + if (p->label.has_value()) { labelEvaluationMap->try_emplace(*p->label, p); + } return evaluationListStack.back()->back(); } /// push a new list on the stack of Evaluation lists - void pushEvaluationList(lower::pft::EvaluationList *evaluationList) { + void pushEvaluationList(lower::pft::EvaluationList *eval) { assert(functionList && "not in a function"); - assert(evaluationList && evaluationList->empty() && - "evaluation list isn't correct"); - evaluationListStack.emplace_back(evaluationList); + assert(eval && eval->empty() && "evaluation list isn't correct"); + evaluationListStack.emplace_back(eval); } /// pop the current list and return to the last Evaluation list @@ -410,119 +315,25 @@ class PFTBuilder { evaluationListStack.pop_back(); } - /// Rewrite IfConstructs containing a GotoStmt to eliminate an unstructured - /// branch and a trivial basic block. The pre-branch-analysis code: - /// - /// <> - /// 1 If[Then]Stmt: if(cond) goto L - /// 2 GotoStmt: goto L - /// 3 EndIfStmt - /// <> - /// 4 Statement: ... - /// 5 Statement: ... - /// 6 Statement: L ... - /// - /// becomes: - /// - /// <> - /// 1 If[Then]Stmt [negate]: if(cond) goto L - /// 4 Statement: ... - /// 5 Statement: ... - /// 3 EndIfStmt - /// <> - /// 6 Statement: L ... - /// - /// The If[Then]Stmt condition is implicitly negated. It is not modified - /// in the PFT. It must be negated when generating FIR. The GotoStmt is - /// deleted. - /// - /// The transformation is only valid for forward branch targets at the same - /// construct nesting level as the IfConstruct. The result must not violate - /// construct nesting requirements or contain an EntryStmt. The result - /// is subject to normal un/structured code classification analysis. The - /// result is allowed to violate the F18 Clause 11.1.2.1 prohibition on - /// transfer of control into the interior of a construct block, as that does - /// not compromise correct code generation. When two transformation - /// candidates overlap, at least one must be disallowed. In such cases, - /// the current heuristic favors simple code generation, which happens to - /// favor later candidates over earlier candidates. That choice is probably - /// not significant, but could be changed. - /// - void rewriteIfGotos() { - using T = struct { - lower::pft::EvaluationList::iterator ifConstructIt; - parser::Label ifTargetLabel; - }; - llvm::SmallVector ifExpansionStack; - auto &evaluationList = *evaluationListStack.back(); - for (auto it = evaluationList.begin(), end = evaluationList.end(); - it != end; ++it) { - auto &eval = *it; - if (eval.isA()) { - ifExpansionStack.clear(); - continue; - } - auto firstStmt = [](lower::pft::Evaluation *e) { - return e->isConstruct() ? &*e->evaluationList->begin() : e; - }; - auto &targetEval = *firstStmt(&eval); - if (targetEval.label) { - while (!ifExpansionStack.empty() && - ifExpansionStack.back().ifTargetLabel == *targetEval.label) { - auto ifConstructIt = ifExpansionStack.back().ifConstructIt; - auto successorIt = std::next(ifConstructIt); - if (successorIt != it) { - auto &ifBodyList = *ifConstructIt->evaluationList; - auto gotoStmtIt = std::next(ifBodyList.begin()); - assert(gotoStmtIt->isA() && "expected GotoStmt"); - ifBodyList.erase(gotoStmtIt); - auto &ifStmt = *ifBodyList.begin(); - ifStmt.negateCondition = true; - ifStmt.lexicalSuccessor = firstStmt(&*successorIt); - auto endIfStmtIt = std::prev(ifBodyList.end()); - std::prev(it)->lexicalSuccessor = &*endIfStmtIt; - endIfStmtIt->lexicalSuccessor = firstStmt(&*it); - ifBodyList.splice(endIfStmtIt, evaluationList, successorIt, it); - for (; successorIt != endIfStmtIt; ++successorIt) - successorIt->parentConstruct = &*ifConstructIt; - } - ifExpansionStack.pop_back(); - } - } - if (eval.isA() && eval.evaluationList->size() == 3) { - if (auto *gotoStmt = std::next(eval.evaluationList->begin()) - ->getIf()) - ifExpansionStack.push_back({it, gotoStmt->v}); - } - } - } - /// Mark I/O statement ERR, EOR, and END specifier branch targets. - /// Mark an I/O statement with an assigned format as unstructured. template void analyzeIoBranches(lower::pft::Evaluation &eval, const A &stmt) { - auto analyzeFormatSpec = [&](const parser::Format &format) { - if (const auto *expr = std::get_if(&format.u)) { - if (semantics::ExprHasTypeCategory(*semantics::GetExpr(*expr), - common::TypeCategory::Integer)) - eval.isUnstructured = true; - } - }; - auto analyzeSpecs{[&](const auto &specList) { - for (const auto &spec : specList) { - std::visit( - Fortran::common::visitors{ - [&](const Fortran::parser::Format &format) { - analyzeFormatSpec(format); - }, - [&](const auto &label) { - using LabelNodes = - std::tuple; - if constexpr (common::HasMember) - markBranchTarget(eval, label.v); - }}, + auto processIfLabel{[&](const auto &specs) { + using LabelNodes = + std::tuple; + for (const auto &spec : specs) { + const auto *label = std::visit( + [](const auto &label) -> const parser::Label * { + using B = std::decay_t; + if constexpr (common::HasMember) { + return &label.v; + } + return nullptr; + }, spec.u); + + if (label) + markBranchTarget(eval, *label); } }}; @@ -533,17 +344,13 @@ class PFTBuilder { if constexpr (std::is_same_v || std::is_same_v) { - if (stmt.format) - analyzeFormatSpec(*stmt.format); - analyzeSpecs(stmt.controls); - } else if constexpr (std::is_same_v) { - analyzeFormatSpec(std::get(stmt.t)); + processIfLabel(stmt.controls); } else if constexpr (std::is_same_v) { - if (const auto *specList = + if (const auto *specs = std::get_if>(&stmt.u)) - analyzeSpecs(*specList); + processIfLabel(*specs); } else if constexpr (common::HasMember) { - analyzeSpecs(stmt.v); + processIfLabel(stmt.v); } else { // Always crash if this is instantiated static_assert(!std::is_same_v, @@ -560,15 +367,16 @@ class PFTBuilder { void markBranchTarget(lower::pft::Evaluation &sourceEvaluation, lower::pft::Evaluation &targetEvaluation) { sourceEvaluation.isUnstructured = true; - if (!sourceEvaluation.controlSuccessor) + if (!sourceEvaluation.controlSuccessor) { sourceEvaluation.controlSuccessor = &targetEvaluation; + } targetEvaluation.isNewBlock = true; // If this is a branch into the body of a construct (usually illegal, // but allowed in some legacy cases), then the targetEvaluation and its // ancestors must be marked as unstructured. auto *sourceConstruct = sourceEvaluation.parentConstruct; auto *targetConstruct = targetEvaluation.parentConstruct; - if (targetConstruct && + if (targetEvaluation.isConstructStmt() && &targetConstruct->getFirstNestedEvaluation() == &targetEvaluation) // A branch to an initial constructStmt is a branch to the construct. targetConstruct = targetConstruct->parentConstruct; @@ -617,15 +425,16 @@ class PFTBuilder { parser::TypeGuardStmt, parser::WhereConstructStmt>; if constexpr (common::HasMember) { - if (auto name = std::get>(stmt.t)) + if (auto name{std::get>(stmt.t)}) return name->ToString(); } // These statements have several std::optional if constexpr (std::is_same_v || std::is_same_v) { - if (auto name = std::get<0>(stmt.t)) + if (auto name{std::get<0>(stmt.t)}) { return name->ToString(); + } } return {}; } @@ -635,9 +444,10 @@ class PFTBuilder { template void insertConstructName(const A &stmt, lower::pft::Evaluation *parentConstruct) { - std::string name = getConstructName(stmt); - if (!name.empty()) + std::string name{getConstructName(stmt)}; + if (!name.empty()) { constructNameMap[name] = parentConstruct; + } } /// Insert branch links for a list of Evaluations. @@ -645,23 +455,24 @@ class PFTBuilder { /// top-level statements of a program. void analyzeBranches(lower::pft::Evaluation *parentConstruct, std::list &evaluationList) { - lower::pft::Evaluation *lastConstructStmtEvaluation{}; + lower::pft::Evaluation *lastConstructStmtEvaluation{nullptr}; + lower::pft::Evaluation *lastIfStmtEvaluation{nullptr}; for (auto &eval : evaluationList) { eval.visit(common::visitors{ - // Action statements (except I/O statements) + // Action statements [&](const parser::CallStmt &s) { // Look for alternate return specifiers. - const auto &args = - std::get>(s.v.t); + const auto &args{std::get>(s.v.t)}; for (const auto &arg : args) { - const auto &actual = std::get(arg.t); - if (const auto *altReturn = - std::get_if(&actual.u)) + const auto &actual{std::get(arg.t)}; + if (const auto *altReturn{ + std::get_if(&actual.u)}) { markBranchTarget(eval, altReturn->v); + } } }, [&](const parser::CycleStmt &s) { - std::string name = getConstructName(s); + std::string name{getConstructName(s)}; lower::pft::Evaluation *construct{name.empty() ? doConstructStack.back() : constructNameMap[name]}; @@ -669,7 +480,7 @@ class PFTBuilder { markBranchTarget(eval, construct->evaluationList->back()); }, [&](const parser::ExitStmt &s) { - std::string name = getConstructName(s); + std::string name{getConstructName(s)}; lower::pft::Evaluation *construct{name.empty() ? doConstructStack.back() : constructNameMap[name]}; @@ -677,10 +488,7 @@ class PFTBuilder { markBranchTarget(eval, *construct->constructExit); }, [&](const parser::GotoStmt &s) { markBranchTarget(eval, s.v); }, - [&](const parser::IfStmt &) { - eval.lexicalSuccessor->isNewBlock = true; - lastConstructStmtEvaluation = &eval; - }, + [&](const parser::IfStmt &) { lastIfStmtEvaluation = &eval; }, [&](const parser::ReturnStmt &) { eval.isUnstructured = true; if (eval.lexicalSuccessor->lexicalSuccessor) @@ -692,13 +500,20 @@ class PFTBuilder { markSuccessorAsNewBlock(eval); }, [&](const parser::ComputedGotoStmt &s) { - for (auto &label : std::get>(s.t)) + for (auto &label : std::get>(s.t)) { markBranchTarget(eval, label); + } }, [&](const parser::ArithmeticIfStmt &s) { markBranchTarget(eval, std::get<1>(s.t)); markBranchTarget(eval, std::get<2>(s.t)); markBranchTarget(eval, std::get<3>(s.t)); + if (semantics::ExprHasTypeCategory( + *semantics::GetExpr(std::get(s.t)), + common::TypeCategory::Real)) { + // Real expression evaluation uses an additional local block. + eval.localBlocks.emplace_back(nullptr); + } }, [&](const parser::AssignStmt &s) { // legacy label assignment auto &label = std::get(s.t); @@ -707,8 +522,9 @@ class PFTBuilder { lower::pft::Evaluation *target{ labelEvaluationMap->find(label)->second}; assert(target && "missing branch target evaluation"); - if (!target->isA()) + if (!target->isA()) { target->isNewBlock = true; + } auto iter = assignSymbolLabelMap->find(*sym); if (iter == assignSymbolLabelMap->end()) { lower::pft::LabelSet labelSet{}; @@ -755,47 +571,60 @@ class PFTBuilder { [&](const parser::NonLabelDoStmt &s) { insertConstructName(s, parentConstruct); doConstructStack.push_back(parentConstruct); - const auto &loopControl = - std::get>(s.t); - if (!loopControl.has_value()) { + auto &control{std::get>(s.t)}; + // eval.block is the loop preheader block, which will be set + // elsewhere if the NonLabelDoStmt is itself a target. + // eval.localBlocks[0] is the loop header block. + eval.localBlocks.emplace_back(nullptr); + if (!control.has_value()) { eval.isUnstructured = true; // infinite loop return; } eval.nonNopSuccessor().isNewBlock = true; eval.controlSuccessor = &evaluationList.back(); - if (const auto *bounds = - std::get_if(&loopControl->u)) { - if (bounds->name.thing.symbol->GetType()->IsNumeric( - common::TypeCategory::Real)) - eval.isUnstructured = true; // real-valued loop control - } else if (std::get_if( - &loopControl->u)) { + if (std::holds_alternative(control->u)) { eval.isUnstructured = true; // while loop } + // Defer additional processing for an unstructured concurrent loop + // to the EndDoStmt, when the loop is known to be unstructured. }, [&](const parser::EndDoStmt &) { - lower::pft::Evaluation &doEval = evaluationList.front(); + lower::pft::Evaluation &doEval{evaluationList.front()}; eval.controlSuccessor = &doEval; doConstructStack.pop_back(); - if (parentConstruct->lowerAsStructured()) + if (parentConstruct->lowerAsStructured()) { return; - // The loop is unstructured, which wasn't known for all cases when - // visiting the NonLabelDoStmt. + } + // Now that the loop is known to be unstructured, finish concurrent + // loop processing, using NonLabelDoStmt information. parentConstruct->constructExit->isNewBlock = true; - const auto &doStmt = *doEval.getIf(); - const auto &loopControl = - std::get>(doStmt.t); - if (!loopControl.has_value()) + const auto &doStmt{doEval.getIf()}; + assert(doStmt && "missing NonLabelDoStmt"); + auto &control{ + std::get>(doStmt->t)}; + if (!control.has_value()) { return; // infinite loop - if (const auto *concurrent = - std::get_if( - &loopControl->u)) { - // If there is a mask, the EndDoStmt starts a new block. - const auto &header = - std::get(concurrent->t); - eval.isNewBlock |= - std::get>(header.t) - .has_value(); + } + const auto *concurrent{ + std::get_if(&control->u)}; + if (!concurrent) { + return; + } + // Unstructured concurrent loop. NonLabelDoStmt code accounts + // for one concurrent loop dimension. Reserve preheader, + // header, and latch blocks for the remaining dimensions, and + // one block for a mask expression. + const auto &header{ + std::get(concurrent->t)}; + auto dims{std::get>(header.t) + .size()}; + for (; dims > 1; --dims) { + doEval.localBlocks.emplace_back(nullptr); // preheader + doEval.localBlocks.emplace_back(nullptr); // header + eval.localBlocks.emplace_back(nullptr); // latch + } + if (std::get>(header.t)) { + doEval.localBlocks.emplace_back(nullptr); // mask } }, [&](const parser::IfThenStmt &s) { @@ -815,8 +644,9 @@ class PFTBuilder { lastConstructStmtEvaluation = nullptr; }, [&](const parser::EndIfStmt &) { - if (parentConstruct->lowerAsUnstructured()) + if (parentConstruct->lowerAsUnstructured()) { parentConstruct->constructExit->isNewBlock = true; + } if (lastConstructStmtEvaluation) { lastConstructStmtEvaluation->controlSuccessor = parentConstruct->constructExit; @@ -861,22 +691,37 @@ class PFTBuilder { eval.isUnstructured = true; }, - // Default - Common analysis for I/O statements; otherwise nop. [&](const auto &stmt) { using A = std::decay_t; - using IoStmts = std::tuple< - parser::BackspaceStmt, parser::CloseStmt, parser::EndfileStmt, - parser::FlushStmt, parser::InquireStmt, parser::OpenStmt, - parser::PrintStmt, parser::ReadStmt, parser::RewindStmt, - parser::WaitStmt, parser::WriteStmt>; - if constexpr (common::HasMember) + using IoStmts = std::tuple; + if constexpr (common::HasMember) { analyzeIoBranches(eval, stmt); + } + + /* do nothing */ }, }); // Analyze construct evaluations. - if (eval.evaluationList) + if (eval.evaluationList) { analyzeBranches(&eval, *eval.evaluationList); + } + + // Insert branch links for an unstructured IF statement. + if (lastIfStmtEvaluation && lastIfStmtEvaluation != &eval) { + // eval is the action substatement of an IfStmt. + if (eval.lowerAsUnstructured()) { + eval.isNewBlock = true; + markSuccessorAsNewBlock(eval); + lastIfStmtEvaluation->isUnstructured = true; + } + lastIfStmtEvaluation->controlSuccessor = &eval.nonNopSuccessor(); + lastIfStmtEvaluation = nullptr; + } // Set the successor of the last statement in an IF or SELECT block. if (!eval.controlSuccessor && eval.lexicalSuccessor && @@ -886,184 +731,141 @@ class PFTBuilder { } // Propagate isUnstructured flag to enclosing construct. - if (parentConstruct && eval.isUnstructured) + if (parentConstruct && eval.isUnstructured) { parentConstruct->isUnstructured = true; + } // The successor of a branch starts a new block. if (eval.controlSuccessor && eval.isActionStmt() && - eval.lowerAsUnstructured()) + eval.lowerAsUnstructured()) { markSuccessorAsNewBlock(eval); - } - } - - /// For multiple entry subprograms, build a list of the dummy arguments that - /// appear in some, but not all entry points. For those that are functions, - /// also find one of the largest function results, since a single result - /// container holds the result for all entries. - void processEntryPoints() { - auto *unit = evaluationListStack.back()->front().getOwningProcedure(); - int entryCount = unit->entryPointList.size(); - if (entryCount == 1) - return; - llvm::DenseMap dummyCountMap; - for (int entryIndex = 0; entryIndex < entryCount; ++entryIndex) { - unit->setActiveEntry(entryIndex); - const auto &details = - unit->getSubprogramSymbol().get(); - for (auto *arg : details.dummyArgs()) { - if (!arg) - continue; // alternate return specifier (no actual argument) - const auto iter = dummyCountMap.find(arg); - if (iter == dummyCountMap.end()) - dummyCountMap.try_emplace(arg, 1); - else - ++iter->second; - } - if (details.isFunction()) { - const auto *resultSym = &details.result(); - assert(resultSym && "missing result symbol"); - if (!unit->primaryResult || - unit->primaryResult->size() < resultSym->size()) - unit->primaryResult = resultSym; } } - unit->setActiveEntry(0); - for (auto arg : dummyCountMap) - if (arg.second < entryCount) - unit->nonUniversalDummyArguments.push_back(arg.first); } std::unique_ptr pgm; - std::vector pftParentStack; + std::vector parentVariantStack; const semantics::SemanticsContext &semanticsContext; /// functionList points to the internal or module procedure function list /// of a FunctionLikeUnit or a ModuleLikeUnit. It may be null. - std::list *functionList{}; + std::list *functionList{nullptr}; std::vector constructAndDirectiveStack{}; std::vector doConstructStack{}; /// evaluationListStack is the current nested construct evaluationList state. std::vector evaluationListStack{}; - llvm::DenseMap *labelEvaluationMap{}; - lower::pft::SymbolLabelMap *assignSymbolLabelMap{}; + llvm::DenseMap *labelEvaluationMap{ + nullptr}; + lower::pft::SymbolLabelMap *assignSymbolLabelMap{nullptr}; std::map constructNameMap{}; - lower::pft::Evaluation *lastLexicalEvaluation{}; + lower::pft::Evaluation *lastLexicalEvaluation{nullptr}; }; class PFTDumper { public: - void dumpPFT(llvm::raw_ostream &outputStream, - const lower::pft::Program &pft) { + void dumpPFT(llvm::raw_ostream &outputStream, lower::pft::Program &pft) { for (auto &unit : pft.getUnits()) { std::visit(common::visitors{ - [&](const lower::pft::BlockDataUnit &unit) { + [&](lower::pft::BlockDataUnit &unit) { outputStream << getNodeIndex(unit) << " "; outputStream << "BlockData: "; - outputStream << "\nEnd BlockData\n\n"; + outputStream << "\nEndBlockData\n\n"; }, - [&](const lower::pft::FunctionLikeUnit &func) { + [&](lower::pft::FunctionLikeUnit &func) { dumpFunctionLikeUnit(outputStream, func); }, - [&](const lower::pft::ModuleLikeUnit &unit) { + [&](lower::pft::ModuleLikeUnit &unit) { dumpModuleLikeUnit(outputStream, unit); }, - [&](const lower::pft::CompilerDirectiveUnit &unit) { - dumpCompilerDirectiveUnit(outputStream, unit); - }, }, unit); } } - llvm::StringRef evaluationName(const lower::pft::Evaluation &eval) { - return eval.visit([](const auto &parseTreeNode) { - return parser::ParseTreeDumper::GetNodeName(parseTreeNode); + llvm::StringRef evaluationName(lower::pft::Evaluation &eval) { + return eval.visit(common::visitors{ + [](const auto &parseTreeNode) { + return parser::ParseTreeDumper::GetNodeName(parseTreeNode); + }, }); } - void dumpEvaluation(llvm::raw_ostream &outputStream, - const lower::pft::Evaluation &eval, - const std::string &indentString, int indent = 1) { - llvm::StringRef name = evaluationName(eval); - std::string bang = eval.isUnstructured ? "!" : ""; - if (eval.isConstruct() || eval.isDirective()) { - outputStream << indentString << "<<" << name << bang << ">>"; - if (eval.constructExit) - outputStream << " -> " << eval.constructExit->printIndex; - outputStream << '\n'; - dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1); - outputStream << indentString << "<>\n"; - return; - } - outputStream << indentString; - if (eval.printIndex) - outputStream << eval.printIndex << ' '; - if (eval.isNewBlock) - outputStream << '^'; - outputStream << name << bang; - if (eval.isActionStmt() || eval.isConstructStmt()) { - if (eval.negateCondition) - outputStream << " [negate]"; - if (eval.controlSuccessor) - outputStream << " -> " << eval.controlSuccessor->printIndex; - } else if (eval.isA() && eval.lexicalSuccessor) { - outputStream << " -> " << eval.lexicalSuccessor->printIndex; - } - if (!eval.position.empty()) - outputStream << ": " << eval.position.ToString(); - outputStream << '\n'; - } - - void dumpEvaluation(llvm::raw_ostream &ostream, - const lower::pft::Evaluation &eval) { - dumpEvaluation(ostream, eval, ""); - } - void dumpEvaluationList(llvm::raw_ostream &outputStream, - const lower::pft::EvaluationList &evaluationList, + lower::pft::EvaluationList &evaluationList, int indent = 1) { - static const auto white = " ++"s; - auto indentString = white.substr(0, indent * 2); - for (const auto &eval : evaluationList) - dumpEvaluation(outputStream, eval, indentString, indent); + static const std::string white{" ++"}; + std::string indentString{white.substr(0, indent * 2)}; + for (lower::pft::Evaluation &eval : evaluationList) { + llvm::StringRef name{evaluationName(eval)}; + std::string bang{eval.isUnstructured ? "!" : ""}; + if (eval.isConstruct() || eval.isDirective()) { + outputStream << indentString << "<<" << name << bang << ">>"; + if (eval.constructExit) { + outputStream << " -> " << eval.constructExit->printIndex; + } + outputStream << '\n'; + dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1); + outputStream << indentString << "<>\n"; + continue; + } + outputStream << indentString; + if (eval.printIndex) { + outputStream << eval.printIndex << ' '; + } + if (eval.isNewBlock) { + outputStream << '^'; + } + if (eval.localBlocks.size()) { + outputStream << '*'; + } + outputStream << name << bang; + if (eval.isActionStmt() || eval.isConstructStmt()) { + if (eval.controlSuccessor) { + outputStream << " -> " << eval.controlSuccessor->printIndex; + } + } + if (eval.position.size()) { + outputStream << ": " << eval.position.ToString(); + } + outputStream << '\n'; + } } - void - dumpFunctionLikeUnit(llvm::raw_ostream &outputStream, - const lower::pft::FunctionLikeUnit &functionLikeUnit) { + void dumpFunctionLikeUnit(llvm::raw_ostream &outputStream, + lower::pft::FunctionLikeUnit &functionLikeUnit) { outputStream << getNodeIndex(functionLikeUnit) << " "; - llvm::StringRef unitKind; - llvm::StringRef name; - llvm::StringRef header; + llvm::StringRef unitKind{}; + std::string name{}; + std::string header{}; if (functionLikeUnit.beginStmt) { functionLikeUnit.beginStmt->visit(common::visitors{ - [&](const parser::Statement &stmt) { + [&](const parser::Statement &statement) { unitKind = "Program"; - name = toStringRef(stmt.statement.v.source); + name = statement.statement.v.ToString(); }, - [&](const parser::Statement &stmt) { + [&](const parser::Statement &statement) { unitKind = "Function"; - name = toStringRef(std::get(stmt.statement.t).source); - header = toStringRef(stmt.source); + name = std::get(statement.statement.t).ToString(); + header = statement.source.ToString(); }, - [&](const parser::Statement &stmt) { + [&](const parser::Statement &statement) { unitKind = "Subroutine"; - name = toStringRef(std::get(stmt.statement.t).source); - header = toStringRef(stmt.source); + name = std::get(statement.statement.t).ToString(); + header = statement.source.ToString(); }, - [&](const parser::Statement &stmt) { + [&](const parser::Statement &statement) { unitKind = "MpSubprogram"; - name = toStringRef(stmt.statement.v.source); - header = toStringRef(stmt.source); + name = statement.statement.v.ToString(); + header = statement.source.ToString(); }, - [&](const auto &) { llvm_unreachable("not a valid begin stmt"); }, + [&](const auto &) {}, }); } else { unitKind = "Program"; name = ""; } outputStream << unitKind << ' ' << name; - if (!header.empty()) + if (header.size()) outputStream << ": " << header; outputStream << '\n'; dumpEvaluationList(outputStream, functionLikeUnit.evaluationList); @@ -1071,38 +873,28 @@ class PFTDumper { outputStream << "\nContains\n"; for (auto &func : functionLikeUnit.nestedFunctions) dumpFunctionLikeUnit(outputStream, func); - outputStream << "End Contains\n"; + outputStream << "EndContains\n"; } - outputStream << "End " << unitKind << ' ' << name << "\n\n"; + outputStream << "End" << unitKind << ' ' << name << "\n\n"; } void dumpModuleLikeUnit(llvm::raw_ostream &outputStream, - const lower::pft::ModuleLikeUnit &moduleLikeUnit) { + lower::pft::ModuleLikeUnit &moduleLikeUnit) { outputStream << getNodeIndex(moduleLikeUnit) << " "; outputStream << "ModuleLike: "; outputStream << "\nContains\n"; for (auto &func : moduleLikeUnit.nestedFunctions) dumpFunctionLikeUnit(outputStream, func); - outputStream << "End Contains\nEnd ModuleLike\n\n"; - } - - // Top level directives - void dumpCompilerDirectiveUnit( - llvm::raw_ostream &outputStream, - const lower::pft::CompilerDirectiveUnit &directive) { - outputStream << getNodeIndex(directive) << " "; - outputStream << "CompilerDirective: !"; - outputStream << directive.get() - .source.ToString(); - outputStream << "\nEnd CompilerDirective\n\n"; + outputStream << "EndContains\nEndModuleLike\n\n"; } template std::size_t getNodeIndex(const T &node) { - auto addr = static_cast(&node); - auto it = nodeIndexes.find(addr); - if (it != nodeIndexes.end()) + auto addr{static_cast(&node)}; + auto it{nodeIndexes.find(addr)}; + if (it != nodeIndexes.end()) { return it->second; + } nodeIndexes.try_emplace(addr, nextIndex); return nextIndex++; } @@ -1129,9 +921,12 @@ static lower::pft::ModuleLikeUnit::ModuleStatement getModuleStmt(const T &mod) { return result; } -template -static const semantics::Symbol *getSymbol(A &beginStmt) { - const auto *symbol = beginStmt.visit(common::visitors{ +static const semantics::Symbol *getSymbol( + std::optional &beginStmt) { + if (!beginStmt) + return nullptr; + + const auto *symbol = beginStmt->visit(common::visitors{ [](const parser::Statement &stmt) -> const semantics::Symbol * { return stmt.statement.v.symbol; }, [](const parser::Statement &stmt) @@ -1144,14 +939,8 @@ static const semantics::Symbol *getSymbol(A &beginStmt) { }, [](const parser::Statement &stmt) -> const semantics::Symbol * { return stmt.statement.v.symbol; }, - [](const parser::Statement &stmt) - -> const semantics::Symbol * { return stmt.statement.v.symbol; }, - [](const parser::Statement &stmt) - -> const semantics::Symbol * { - return std::get(stmt.statement.t).symbol; - }, [](const auto &) -> const semantics::Symbol * { - llvm_unreachable("unknown FunctionLike or ModuleLike beginStmt"); + llvm_unreachable("unknown FunctionLike beginStmt"); return nullptr; }}); assert(symbol && "parser::Name must have resolved symbol"); @@ -1168,25 +957,13 @@ bool Fortran::lower::pft::Evaluation::lowerAsUnstructured() const { lower::pft::FunctionLikeUnit * Fortran::lower::pft::Evaluation::getOwningProcedure() const { - return parent.visit(common::visitors{ + return parentVariant.visit(common::visitors{ [](lower::pft::FunctionLikeUnit &c) { return &c; }, [&](lower::pft::Evaluation &c) { return c.getOwningProcedure(); }, [](auto &) -> lower::pft::FunctionLikeUnit * { return nullptr; }, }); } -bool Fortran::lower::definedInCommonBlock(const semantics::Symbol &sym) { - return semantics::FindCommonBlockContaining(sym); -} - -/// Is the symbol `sym` a global? -static bool symbolIsGlobal(const semantics::Symbol &sym) { - if (const auto *details = sym.detailsIf()) - if (details->init()) - return true; - return semantics::IsSaved(sym) || lower::definedInCommonBlock(sym); -} - namespace { /// This helper class is for sorting the symbols in the symbol table. We want /// the symbols in an order such that a symbol will be visited after those it @@ -1194,112 +971,26 @@ namespace { /// symbol table, which is sorted by name. struct SymbolDependenceDepth { explicit SymbolDependenceDepth( - std::vector> &vars, bool reentrant) - : vars{vars}, reentrant{reentrant} {} - - void analyzeAliasesInCurrentScope(const semantics::Scope &scope) { - for (const auto &iter : scope) { - const auto &ultimate = iter.second.get().GetUltimate(); - if (skipSymbol(ultimate)) - continue; - bool isDeclaration = scope != ultimate.owner(); - analyzeAliases(ultimate.owner(), isDeclaration); - } - // add all aggregate stores to the front of the work list - adjustSize(1); - // The copy in the loop matters, 'stores' will still be used. - for (auto st : stores) { - vars[0].emplace_back(std::move(st)); - } - } - // Analyze the equivalence sets. This analysis need not be performed when the - // scope has no equivalence sets. - void analyzeAliases(const semantics::Scope &scope, bool isDeclaration) { - if (scope.equivalenceSets().empty()) - return; - if (scopeAnlyzedForAliases.find(&scope) != scopeAnlyzedForAliases.end()) - return; - scopeAnlyzedForAliases.insert(&scope); - Fortran::lower::IntervalSet intervals; - llvm::DenseMap> - aliasSets; - llvm::DenseMap setIsGlobal; - - // 1. Construct the intervals. Determine each entity's interval, merging - // overlapping intervals into aggregates. - for (const auto &pair : scope) { - const auto &sym = pair.second.get(); - if (skipSymbol(sym)) - continue; - LLVM_DEBUG(llvm::dbgs() << "symbol: " << sym << '\n'); - intervals.merge(sym.offset(), sym.offset() + sym.size() - 1); - } - - // 2. Compute alias sets. Adds each entity to a set for the interval it - // appears to be mapped into. - for (const auto &pair : scope) { - const auto &sym = pair.second.get(); - if (skipSymbol(sym)) - continue; - auto iter = intervals.find(sym.offset()); - if (iter != intervals.end()) { - LLVM_DEBUG(llvm::dbgs() - << "symbol: " << toStringRef(sym.name()) << " on [" - << iter->first << ".." << iter->second << "]\n"); - aliasSets[iter->first].push_back(&sym); - if (symbolIsGlobal(sym)) - setIsGlobal.insert({iter->first, &sym}); - } - } - - // 3. For each alias set with more than 1 member, add an Interval to the - // stores. The Interval will be lowered into a single memory allocation, - // with the co-located, overlapping variables mapped into that memory range. - for (const auto &pair : aliasSets) { - if (pair.second.size() > 1) { - // Set contains more than 1 aliasing variable. - // 1. Mark the symbols as aliasing for lowering. - for (auto *sym : pair.second) - aliasSyms.insert(sym); - auto gvarIter = setIsGlobal.find(pair.first); - auto iter = intervals.find(pair.first); - auto ibgn = iter->first; - auto ilen = iter->second - ibgn + 1; - // 2. Add an Interval to the list of stores allocated for this unit. - lower::pft::Variable::Interval interval(ibgn, ilen); - if (gvarIter != setIsGlobal.end()) { - LLVM_DEBUG(llvm::dbgs() - << "interval [" << ibgn << ".." << ibgn + ilen - << ") added as global " << *gvarIter->second << '\n'); - stores.emplace_back(std::move(interval), scope, pair.second, - isDeclaration); - } else { - LLVM_DEBUG(llvm::dbgs() << "interval [" << ibgn << ".." << ibgn + ilen - << ") added\n"); - stores.emplace_back(std::move(interval), scope, isDeclaration); - } - } - } - } + std::vector> &vars) + : vars{vars} {} // Recursively visit each symbol to determine the height of its dependence on // other symbols. int analyze(const semantics::Symbol &sym) { auto done = seen.insert(&sym); - LLVM_DEBUG(llvm::dbgs() << "analyze symbol: " << sym << '\n'); if (!done.second) return 0; if (semantics::IsProcedure(sym)) { // TODO: add declaration? return 0; } - auto ultimate = sym.GetUltimate(); - if (!ultimate.has() && - !ultimate.has()) + if (sym.has() || + sym.has() || + sym.has() || + sym.has()) { + // FIXME: do we want to do anything with any of these? return 0; - - if (sym.has()) - llvm_unreachable("not yet implemented - derived type analysis"); + } // Symbol must be something lowering will have to allocate. bool global = semantics::IsSaved(sym); @@ -1309,12 +1000,9 @@ struct SymbolDependenceDepth { // check CHARACTER's length if (symTy->category() == semantics::DeclTypeSpec::Character) - if (auto e = symTy->characterTypeSpec().length().GetExplicit()) { - // turn variable into a global if this unit is not reentrant - global = global || !reentrant; + if (auto e = symTy->characterTypeSpec().length().GetExplicit()) for (const auto &s : evaluate::CollectSymbols(*e)) depth = std::max(analyze(s) + 1, depth); - } if (const auto *details = sym.detailsIf()) { auto doExplicit = [&](const auto &bound) { @@ -1325,15 +1013,11 @@ struct SymbolDependenceDepth { } }; // handle any symbols in array bound declarations - if (!details->shape().empty()) - global = global || !reentrant; for (const auto &subs : details->shape()) { doExplicit(subs.lbound()); doExplicit(subs.ubound()); } // handle any symbols in coarray bound declarations - if (!details->coshape().empty()) - global = global || !reentrant; for (const auto &subs : details->coshape()) { doExplicit(subs.lbound()); doExplicit(subs.ubound()); @@ -1348,69 +1032,23 @@ struct SymbolDependenceDepth { } adjustSize(depth + 1); vars[depth].emplace_back(sym, global, depth); - if (semantics::IsAllocatable(sym)) + if (Fortran::semantics::IsAllocatable(sym)) vars[depth].back().setHeapAlloc(); - if (semantics::IsPointer(sym)) + if (Fortran::semantics::IsPointer(sym)) vars[depth].back().setPointer(); - if (ultimate.attrs().test(semantics::Attr::TARGET)) + if (sym.attrs().test(Fortran::semantics::Attr::TARGET)) vars[depth].back().setTarget(); - - // If there are alias sets, then link the participating variables to their - // aggregate stores when constructing the new variable on the list. - if (auto *store = findStoreIfAlias(sym)) { - vars[depth].back().setAlias(store->getOffset()); - } return depth; } - /// Save the final list of variable allocations as a single vector and free - /// the rest. + // Save the final list of symbols as a single vector and free the rest. void finalize() { for (int i = 1, end = vars.size(); i < end; ++i) vars[0].insert(vars[0].end(), vars[i].begin(), vars[i].end()); vars.resize(1); } - Fortran::lower::pft::Variable::AggregateStore * - findStoreIfAlias(const Fortran::evaluate::Symbol &sym) { - const auto &ultimate = sym.GetUltimate(); - const auto &scope = ultimate.owner(); - // Expect the total number of EQUIVALENCE sets to be small for a typical - // Fortran program. - if (aliasSyms.find(&ultimate) != aliasSyms.end()) { - LLVM_DEBUG(llvm::dbgs() << "symbol: " << ultimate << '\n'); - LLVM_DEBUG(llvm::dbgs() << "scope: " << scope << '\n'); - auto off = ultimate.offset(); - for (auto &v : stores) { - if (v.scope == &scope) { - auto bot = std::get<0>(v.interval); - if (off >= bot && off < bot + std::get<1>(v.interval)) - return &v; - } - } - // clang-format off - LLVM_DEBUG( - llvm::dbgs() << "looking for " << off << "\n{\n"; - for (auto v : stores) { - llvm::dbgs() << " in scope: " << v.scope << "\n"; - llvm::dbgs() << " i = [" << std::get<0>(v.interval) << ".." - << std::get<0>(v.interval) + std::get<1>(v.interval) - << "]\n"; - } - llvm::dbgs() << "}\n"); - // clang-format on - llvm_unreachable("the store must be present"); - } - return nullptr; - } - private: - /// Skip symbol in alias analysis. - bool skipSymbol(const semantics::Symbol &sym) { - return !sym.has() || - lower::definedInCommonBlock(sym); - } - // Make sure the table is of appropriate size. void adjustSize(std::size_t size) { if (vars.size() < size) @@ -1419,102 +1057,93 @@ struct SymbolDependenceDepth { llvm::SmallSet seen; std::vector> &vars; - llvm::SmallSet aliasSyms; - llvm::SmallSet scopeAnlyzedForAliases; - std::vector stores; - bool reentrant; }; } // namespace -static void processSymbolTable( - const semantics::Scope &scope, - std::vector> &varList, - bool reentrant) { - SymbolDependenceDepth sdd{varList, reentrant}; - sdd.analyzeAliasesInCurrentScope(scope); +void Fortran::lower::pft::FunctionLikeUnit::processSymbolTable( + const semantics::Scope &scope) { + // TODO: handle equivalence and common blocks + if (!scope.equivalenceSets().empty()) { + llvm::errs() << "TODO: equivalence not yet handled in lowering.\n" + << "note: equivalence used in " + << (scope.GetName() && !scope.GetName()->empty() + ? scope.GetName()->ToString() + : "unnamed program"s) + << "\n"; + exit(1); + } + SymbolDependenceDepth sdd{varList}; for (const auto &iter : scope) sdd.analyze(iter.second.get()); sdd.finalize(); } Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( - const parser::MainProgram &func, const lower::pft::PftNode &parent, + const parser::MainProgram &func, const lower::pft::ParentVariant &parent, const semantics::SemanticsContext &semanticsContext) : ProgramUnit{func, parent}, endStmt{ getFunctionStmt( func)} { - const auto &programStmt = - std::get>>(func.t); - if (programStmt.has_value()) { - beginStmt = FunctionStatement(programStmt.value()); - const auto *symbol = getSymbol(*beginStmt); - entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope(), varList, isRecursive()); + const auto &ps{ + std::get>>(func.t)}; + if (ps.has_value()) { + FunctionStatement begin{ps.value()}; + beginStmt = begin; + symbol = getSymbol(beginStmt); + processSymbolTable(*symbol->scope()); } else { - processSymbolTable( - semanticsContext.FindScope( - std::get>(func.t).source), - varList, isRecursive()); + processSymbolTable(semanticsContext.FindScope( + std::get>(func.t).source)); } } Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( - const parser::FunctionSubprogram &func, const lower::pft::PftNode &parent, + const parser::FunctionSubprogram &func, + const lower::pft::ParentVariant &parent, const semantics::SemanticsContext &) : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, - endStmt{getFunctionStmt(func)} { - const auto *symbol = getSymbol(*beginStmt); - entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope(), varList, isRecursive()); + endStmt{getFunctionStmt(func)}, symbol{getSymbol( + beginStmt)} { + processSymbolTable(*symbol->scope()); } Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( - const parser::SubroutineSubprogram &func, const lower::pft::PftNode &parent, + const parser::SubroutineSubprogram &func, + const lower::pft::ParentVariant &parent, const semantics::SemanticsContext &) : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, - endStmt{getFunctionStmt(func)} { - const auto *symbol = getSymbol(*beginStmt); - entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope(), varList, isRecursive()); + endStmt{getFunctionStmt(func)}, + symbol{getSymbol(beginStmt)} { + processSymbolTable(*symbol->scope()); } Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( const parser::SeparateModuleSubprogram &func, - const lower::pft::PftNode &parent, const semantics::SemanticsContext &) + const lower::pft::ParentVariant &parent, + const semantics::SemanticsContext &) : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, - endStmt{getFunctionStmt(func)} { - const auto *symbol = getSymbol(*beginStmt); - entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope(), varList, isRecursive()); + endStmt{getFunctionStmt(func)}, + symbol{getSymbol(beginStmt)} { + processSymbolTable(*symbol->scope()); } Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit( - const parser::Module &m, const lower::pft::PftNode &parent) + const parser::Module &m, const lower::pft::ParentVariant &parent) : ProgramUnit{m, parent}, beginStmt{getModuleStmt(m)}, - endStmt{getModuleStmt(m)} { - const auto *symbol = getSymbol(beginStmt); - processSymbolTable(*symbol->scope(), varList, /*reentrant=*/false); -} + endStmt{getModuleStmt(m)} {} Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit( - const parser::Submodule &m, const lower::pft::PftNode &parent) + const parser::Submodule &m, const lower::pft::ParentVariant &parent) : ProgramUnit{m, parent}, beginStmt{getModuleStmt( m)}, - endStmt{getModuleStmt(m)} { - const auto *symbol = getSymbol(beginStmt); - processSymbolTable(*symbol->scope(), varList, /*reentrant=*/false); -} + endStmt{getModuleStmt(m)} {} Fortran::lower::pft::BlockDataUnit::BlockDataUnit( - const parser::BlockData &bd, const lower::pft::PftNode &parent, - const semantics::SemanticsContext &semanticsContext) - : ProgramUnit{bd, parent}, - symTab{semanticsContext.FindScope( - std::get>(bd.t).source)} { -} + const parser::BlockData &bd, const lower::pft::ParentVariant &parent) + : ProgramUnit{bd, parent} {} std::unique_ptr Fortran::lower::createPFT(const parser::Program &root, @@ -1524,67 +1153,9 @@ Fortran::lower::createPFT(const parser::Program &root, return walker.result(); } -// FIXME: FlangDriver -// This option should be integrated with the real driver as the default of -// RECURSIVE vs. NON_RECURSIVE may be changed by other command line options, -// etc., etc. -bool Fortran::lower::defaultRecursiveFunctionSetting() { - return !nonRecursiveProcedures; -} - void Fortran::lower::dumpPFT(llvm::raw_ostream &outputStream, - const lower::pft::Program &pft) { + lower::pft::Program &pft) { PFTDumper{}.dumpPFT(outputStream, pft); } -void Fortran::lower::pft::Program::dump() const { - dumpPFT(llvm::errs(), *this); -} - -void Fortran::lower::pft::Evaluation::dump() const { - PFTDumper{}.dumpEvaluation(llvm::errs(), *this); -} - -void Fortran::lower::pft::Variable::dump() const { - if (auto *s = std::get_if(&var)) { - llvm::errs() << "symbol: " << s->symbol->name(); - llvm::errs() << " (depth: " << s->depth << ')'; - if (s->global) - llvm::errs() << ", global"; - if (s->heapAlloc) - llvm::errs() << ", allocatable"; - if (s->pointer) - llvm::errs() << ", pointer"; - if (s->target) - llvm::errs() << ", target"; - if (s->aliaser) - llvm::errs() << ", equivalence(" << s->aliasOffset << ')'; - } else if (auto *s = std::get_if(&var)) { - llvm::errs() << "interval[" << std::get<0>(s->interval) << ", " - << std::get<1>(s->interval) << "]:"; - if (s->isGlobal()) - llvm::errs() << ", global"; - if (s->vars.size()) { - llvm::errs() << ", vars: {"; - llvm::interleaveComma(s->vars, llvm::errs(), - [](auto *y) { llvm::errs() << *y; }); - llvm::errs() << '}'; - } - } else { - llvm_unreachable("not a Variable"); - } - llvm::errs() << '\n'; -} - -void Fortran::lower::pft::FunctionLikeUnit::dump() const { - PFTDumper{}.dumpFunctionLikeUnit(llvm::errs(), *this); -} - -void Fortran::lower::pft::ModuleLikeUnit::dump() const { - PFTDumper{}.dumpModuleLikeUnit(llvm::errs(), *this); -} - -/// The BlockDataUnit dump is just the associated symbol table. -void Fortran::lower::pft::BlockDataUnit::dump() const { - llvm::errs() << "block data {\n" << symTab << "\n}\n"; -} +void Fortran::lower::pft::Program::dump() { dumpPFT(llvm::errs(), *this); } From 2532568a1567fb80a95bf4197bac7fdc14633963 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 29 Jun 2020 08:05:49 -0700 Subject: [PATCH 0122/1017] put back a lost change --- flang/lib/Lower/Bridge.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index dfbfa79f2c51f..72d664c367609 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1580,7 +1580,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { TODO(); // Derived type / polymorphic } auto symTy = genType(var); - if (symTy.isa()) { + if (symTy.isa()) { if (auto chLit = getCharacterLiteralCopy(details->init().value())) { fir::SequenceType::Shape len; len.push_back(std::get(*chLit)); From 5bb94225ae3456927845447c872fbea1fec67bb2 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 29 Jun 2020 12:50:40 -0700 Subject: [PATCH 0123/1017] implement the force 1 loop trip option --- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 32 ++++++++++++------- flang/test/Fir/{loop.fir => loop01.fir} | 2 -- flang/test/Fir/loop02.fir | 17 ++++++++++ 3 files changed, 37 insertions(+), 14 deletions(-) rename flang/test/Fir/{loop.fir => loop01.fir} (91%) create mode 100644 flang/test/Fir/loop02.fir diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 30e6270d5826c..a6da1515a512f 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -22,6 +22,12 @@ static llvm::cl::opt llvm::cl::desc("disable FIR to CFG pass"), llvm::cl::init(false)); +/// minimum trip count is 1, not 0 +static llvm::cl::opt forceLoopToExecuteOnce( + "always-execute-loop-body", + llvm::cl::desc("force the body of a loop to execute at least once"), + llvm::cl::init(false)); + using namespace fir; namespace { @@ -68,7 +74,16 @@ class CfgLoopConv : public mlir::OpRewritePattern { rewriter.setInsertionPointToEnd(initBlock); auto diff = rewriter.create(loc, high, low); auto distance = rewriter.create(loc, diff, step); - auto iters = rewriter.create(loc, distance, step); + mlir::Value iters = + rewriter.create(loc, distance, step); + + if (forceLoopToExecuteOnce) { + auto zero = rewriter.create(loc, 0); + auto cond = + rewriter.create(loc, CmpIPredicate::sle, iters, zero); + auto one = rewriter.create(loc, 1); + iters = rewriter.create(loc, cond, one, iters); + } llvm::SmallVector loopOperands; loopOperands.push_back(low); @@ -76,14 +91,7 @@ class CfgLoopConv : public mlir::OpRewritePattern { loopOperands.append(operands.begin(), operands.end()); loopOperands.push_back(iters); - // TODO: replace with a command line flag - // onetrip flag determines whether loop should be executed once, before - // conditionals are checked - static const bool onetrip = false; - if (onetrip) - rewriter.create(loc, firstBlock, ArrayRef()); - else - rewriter.create(loc, conditionalBlock, loopOperands); + rewriter.create(loc, conditionalBlock, loopOperands); // Last loop block auto *terminator = lastBlock->getTerminator(); @@ -275,9 +283,9 @@ class CfgConversion : public CFGConversionBase { // apply the patterns target.addIllegalOp(); - target.markUnknownOpDynamicallyLegal([](Operation*) { return true; }); - if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, - patterns))) { + target.markUnknownOpDynamicallyLegal([](Operation *) { return true; }); + if (mlir::failed( + mlir::applyPartialConversion(getFunction(), target, patterns))) { mlir::emitError(mlir::UnknownLoc::get(context), "error in converting to CFG\n"); signalPassFailure(); diff --git a/flang/test/Fir/loop.fir b/flang/test/Fir/loop01.fir similarity index 91% rename from flang/test/Fir/loop.fir rename to flang/test/Fir/loop01.fir index 77026ed0ee571..27c2fd7e713b5 100644 --- a/flang/test/Fir/loop.fir +++ b/flang/test/Fir/loop01.fir @@ -1,5 +1,3 @@ -// Test lowering FIR to LLVM IR of fir.select{|_rank|_case} - // RUN: tco %s | FileCheck %s // CHECK-LABEL: @x diff --git a/flang/test/Fir/loop02.fir b/flang/test/Fir/loop02.fir new file mode 100644 index 0000000000000..a8d4c836dc1b5 --- /dev/null +++ b/flang/test/Fir/loop02.fir @@ -0,0 +1,17 @@ +// RUN: tco --always-execute-loop-body %s | FileCheck %s + +// CHECK-LABEL: @x +func @x(%addr : !fir.ref) { + %bound = constant 452 : index + %step = constant 1 : index + // CHECK: %[[phi:.*]] = phi i64 [{{.*}}], [ 1, + // CHECK: = icmp sgt i64 %[[phi]], 0 + fir.do_loop %iv = %bound to %bound step %step { + // CHECK: call void @y(i64* % + fir.call @y(%addr) : (!fir.ref) -> () + } + // CHECK: ret void + return +} + +func @y(%addr : !fir.ref) From af6b3a089e7f3e2b243e9040085c2f521c073d7b Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Fri, 26 Jun 2020 01:57:16 -0700 Subject: [PATCH 0124/1017] Lower statement functions Lower statement functions directly inlined inside the bridge: - evaluate actual arguments - associate evaluated arguments to dummy symbols in symbol map - evaluate statement function expression - remove symbol association from symbol map --- flang/test/Lower/stmt-function.f90 | 96 ++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) create mode 100644 flang/test/Lower/stmt-function.f90 diff --git a/flang/test/Lower/stmt-function.f90 b/flang/test/Lower/stmt-function.f90 new file mode 100644 index 0000000000000..ed32273efc222 --- /dev/null +++ b/flang/test/Lower/stmt-function.f90 @@ -0,0 +1,96 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test statement function lowering + +! Simple case +!CHECK-LABEL: func @_QPtest_stmt_0(%arg0: !fir.ref) -> f32 +real function test_stmt_0(x) + real :: x, func, arg + func(arg) = arg + 0.123456 + + !CHECK: %[[x:.*]] = fir.load %arg0 + !CHECK: %[[cst:.*]] = constant 1.234560e-01 + !CHECK: %[[eval:.*]] = fir.addf %[[x]], %[[cst]] + !CHECK: fir.store %[[eval]] to %[[resmem:.*]] : !fir.ref + test_stmt_0 = func(x) + + !CHECK: %[[res:.*]] = fir.load %[[resmem]] + !CHECK: return %[[res]] +end function + +! Check this is not lowered as a simple macro: e.g. argument is only +! evaluated once even if it appears in several placed inside the +! statement function expression + +real(4) function test_stmt_only_eval_arg_once() + real(4) :: only_once, x1 + func(x1) = x1 + x1 + !CHECK: %[[x1:.*]] = fir.call @_QPonly_once() + !CHECK: fir.addf %[[x1]], %[[x1]] + test_stmt_only_eval_arg_once = func(only_once()) +end function + +! Test nested statement function (note that they cannot be recursively +! nested as per F2018 C1577). +real function test_stmt_1(x, a) + real :: y, a, b, foo + real :: func1, arg1, func2, arg2 + real :: res1, res2 + func1(arg1) = a + foo(arg1) + func2(arg2) = func1(arg2) + b + !CHECK-DAG: %[[bmem:.*]] = fir.alloca f32 {name = "b"} + !CHECK-DAG: %[[res1:.*]] = fir.alloca f32 {name = "res1"} + !CHECK-DAG: %[[res2:.*]] = fir.alloca f32 {name = "res2"} + + b = 5 + + !CHECK: %[[cst_8:.*]] = constant 8.000000e+00 + !CHECK: fir.store %[[cst_8]] to %[[tmp1:.*]] : !fir.ref + !CHECK-DAG: %[[foocall1:.*]] = fir.call @_QPfoo(%[[tmp1]]) + !CHECK-DAG: %[[aload1:.*]] = fir.load %arg1 + !CHECK-DAG: %[[add1:.*]] = fir.addf %[[aload1]], %[[foocall1]] + !CHECK: fir.store %[[add1]] to %[[res1]] + res1 = func1(8.) + + !CHECK: %[[x:.*]] = fir.load %arg0 + !CHECK-DAG: fir.store %[[x]] to %[[tmp2:.*]] : !fir.ref + !CHECK-DAG: %[[foocall2:.*]] = fir.call @_QPfoo(%[[tmp2]]) + !CHECK-DAG: %[[aload2:.*]] = fir.load %arg1 + !CHECK-DAG: %[[add2:.*]] = fir.addf %[[aload2]], %[[foocall2]] + !CHECK-DAG: %[[b:.*]] = fir.load %[[bmem]] + !CHECK: %[[add3:.*]] = fir.addf %[[add2]], %[[b]] + !CHECK: fir.store %[[add3]] to %[[res2]] + res2 = func2(x) + + test_stmt_1 = res1 + res2 +end function + + +! Test statement functions with no argument. +! Test that they are not pre-evaluated. +!CHECK-LABEL: func @_QPtest_stmt_no_args +real function test_stmt_no_args(x, y) + func() = x + y + !CHECK: fir.addf + a = func() + !CHECK: fir.call @_QPfoo_may_modify_xy + call foo_may_modify_xy(x, y) + !CHECK: fir.addf + !CHECK: fir.addf + test_stmt_no_args = func() + a +end function + +! Test statement function with character arguments +integer function test_stmt_character(c, j, n) + integer :: i, j, func, argj + integer(8) :: n + character(n) :: c, arg + func(arg, argj) = len(arg) + argj + !CHECK: %[[j:.*]] = fir.load %arg1 + !CHECK: %[[n:.*]] = fir.load %arg2 + !CHECK: %[[n32:.*]] = fir.convert %[[n]] : (i64) -> i32 + !CHECK: addi %[[n32]], %[[j]] + test_stmt_character = func(c, j) +end function + + From 71b5bcaef041ac7224dd4894e5e9af8a8e64ac4a Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Wed, 24 Jun 2020 10:20:39 -0700 Subject: [PATCH 0125/1017] lower passing unrestricted intrnsics as arguments Unrestricted intrinsic are created on the fly with intrinsic lowering using the wrappers. The only trick is that unrestricted intrinsic takes references, so the wrapper must be modified to load the values in such cases. - Refactor intrinsic library for better wrapper creation handling and to return symbolRefAttr of created wrappers. - Extend the CallInterface to produce function type outside of call sites/function definition (This is needed for function pointers/dummy arguments not yet defined and intrinsics) --- flang/include/flang/Lower/CallInterface.h | 14 ++- .../flang/Optimizer/Support/InternalNames.h | 15 +++ flang/lib/Lower/CallInterface.cpp | 105 +++++++++++++++++- flang/test/Lower/dummy-procedure.f90 | 58 +++++++++- 4 files changed, 180 insertions(+), 12 deletions(-) diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index 7d451f5c6c7f8..d6424fbe5304d 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -35,6 +35,7 @@ class Symbol; namespace Fortran::evaluate { class ProcedureRef; +struct ProcedureDesignator; class ActualArgument; namespace characteristics { struct Procedure; @@ -161,10 +162,6 @@ class CallInterface { std::optional getPassedResult() const { return passedResult; } /// Returns the mlir function type mlir::FunctionType genFunctionType() const; - -private: - /// CRTP handle. - T &side() { return *static_cast(this); } /// buildImplicitInterface and buildExplicitInterface are the entry point /// of the first pass that define the interface and is required to get /// the mlir::FuncOp. @@ -172,6 +169,10 @@ class CallInterface { buildImplicitInterface(const Fortran::evaluate::characteristics::Procedure &); void buildExplicitInterface(const Fortran::evaluate::characteristics::Procedure &); + +private: + /// CRTP handle. + T &side() { return *static_cast(this); } /// Second pass entry point, once the mlir::FuncOp is created void mapBackInputToPassedEntity(const FirPlaceHolder &, FirValue); @@ -274,6 +275,11 @@ class CalleeInterface : public CallInterface { Fortran::lower::pft::FunctionLikeUnit &funit; }; +/// Translate a procedure characteristics to an mlir::FunctionType signature. +mlir::FunctionType +translateSignature(const Fortran::evaluate::ProcedureDesignator &, + Fortran::lower::AbstractConverter &); + } // namespace Fortran::lower #endif // FORTRAN_LOWER_FIRBUILDER_H diff --git a/flang/include/flang/Optimizer/Support/InternalNames.h b/flang/include/flang/Optimizer/Support/InternalNames.h index fa98cc2a8e490..591436a37b5e4 100644 --- a/flang/include/flang/Optimizer/Support/InternalNames.h +++ b/flang/include/flang/Optimizer/Support/InternalNames.h @@ -14,6 +14,10 @@ #include "llvm/ADT/StringRef.h" #include +namespace mlir { +class FunctionType; +} + namespace fir { /// Internal name mangling of identifiers @@ -132,6 +136,17 @@ struct NameUniquer { NameUniquer &operator=(const NameUniquer &) = delete; }; +/// Returns a name suitable to define mlir functions for Fortran intrinsic +/// Procedure. These names are guaranteed to not conflict with user defined +/// procedures. This is needed to implement Fortran generic intrinsics as +/// several mlir functions specialized for the argument types. +/// The result is guaranteed to be distinct for different mlir::FunctionType +/// arguments. The mangling pattern is: +/// fir...... +/// e.g ACOS(COMPLEX(4)) is mangled as fir.acos.z4.z4 +std::string mangleIntrinsicProcedure(llvm::StringRef genericName, + mlir::FunctionType); + } // namespace fir #endif // FORTRAN_OPTIMIZER_SUPPORT_INTERNALNAMES_H diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index 77a5372dcf568..364a50e276dcb 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -282,8 +282,23 @@ getResultEntity(Fortran::lower::pft::FunctionLikeUnit &funit) { return details.result(); } +/// Bypass helpers to manipulate entities since they are not any symbol/actual +/// argument to associate. See SignatureBuilder below. +using FakeEntity = bool; +using FakeEntities = llvm::SmallVector; +static FakeEntities +getEntityContainer(const Fortran::evaluate::characteristics::Procedure &proc) { + FakeEntities enities(proc.dummyArguments.size()); + return enities; +} +static const FakeEntity &getDataObjectEntity(const FakeEntity &e) { return e; } +static FakeEntity +getResultEntity(const Fortran::evaluate::characteristics::Procedure &proc) { + return false; +} + /// This is the actual part that defines the FIR interface based on the -/// charcteristic. It directly mutates the CallInterface members. +/// characteristic. It directly mutates the CallInterface members. template class Fortran::lower::CallInterfaceImpl { using CallInterface = Fortran::lower::CallInterface; @@ -360,7 +375,7 @@ class Fortran::lower::CallInterfaceImpl { auto boxCharTy = fir::BoxCharType::get(&mlirContext, type.kind()); addFirInput(charRefTy, resultPosition, Property::CharAddress); addFirInput(lenTy, resultPosition, Property::CharLength); - /// For now, still also return it by boxchar + /// For now, also return it by boxchar addFirOutput(boxCharTy, resultPosition, Property::BoxChar); } @@ -486,3 +501,89 @@ Fortran::lower::CallInterface::getResultType() const { template class Fortran::lower::CallInterface; template class Fortran::lower::CallInterface; + +//===----------------------------------------------------------------------===// +// Function Type Translation +//===----------------------------------------------------------------------===// + +/// Build signature from characteristics when there is no Fortran entity to +/// associate with the arguments (i.e, this is not a call site or a procedure +/// declaration. This is needed when dealing with function pointers/dummy +/// arguments. + +class SignatureBuilder; +template <> +struct Fortran::lower::PassedEntityTypes { + using FortranEntity = FakeEntity; + using FirValue = int; +}; + +/// SignatureBuilder is a CRTP implementation of CallInterface intended to +/// help translating characteristics::Procedure to mlir::FunctionType using +/// the CallInterface translation. +class SignatureBuilder + : public Fortran::lower::CallInterface { +public: + SignatureBuilder(const Fortran::evaluate::characteristics::Procedure &p, + Fortran::lower::AbstractConverter &c, bool forceImplicit) + : CallInterface{c}, proc{p} { + if (forceImplicit || proc.CanBeCalledViaImplicitInterface()) + buildImplicitInterface(proc); + else + buildExplicitInterface(proc); + } + /// Does the procedure characteristics being translated have alternate + /// returns ? + bool hasAlternateReturns() const { + for (const auto &dummy : proc.dummyArguments) + if (std::holds_alternative< + Fortran::evaluate::characteristics::AlternateReturn>(dummy.u)) + return true; + return false; + }; + + /// This is only here to fulfill CRTP dependencies and should not be called. + std::string getMangledName() const { + llvm_unreachable("trying to get name from SignatureBuilder"); + } + + /// This is only here to fulfill CRTP dependencies and should not be called. + mlir::Location getCalleeLocation() const { + llvm_unreachable("trying to get callee location from SignatureBuilder"); + } + Fortran::evaluate::characteristics::Procedure characterize() const { + return proc; + } + /// SignatureBuilder cannot be used on main program. + bool isMainProgram() const { return false; } + + /// Return the characteristics::Procedure that is being translated to + /// mlir::FunctionType. + const Fortran::evaluate::characteristics::Procedure & + getCallDescription() const { + return proc; + } + + /// This is not the description of an indirect call. + bool isIndirectCall() const { return false; } + + /// Return the translated signature. + mlir::FunctionType getFunctionType() const { return genFunctionType(); } + +private: + const Fortran::evaluate::characteristics::Procedure &proc; +}; + +mlir::FunctionType Fortran::lower::translateSignature( + const Fortran::evaluate::ProcedureDesignator &proc, + Fortran::lower::AbstractConverter &converter) { + auto characteristics = + Fortran::evaluate::characteristics::Procedure::Characterize( + proc, converter.getFoldingContext().intrinsics()); + // Most unrestricted intrinsic characteristic has the Elemental attribute + // which triggers CanBeCalledViaImplicitInterface to return false. However, + // using implicit interface rules is just fine here. + bool forceImplicit = proc.GetSpecificIntrinsic(); + return SignatureBuilder{characteristics.value(), converter, forceImplicit} + .getFunctionType(); +} diff --git a/flang/test/Lower/dummy-procedure.f90 b/flang/test/Lower/dummy-procedure.f90 index 269429b4011b7..c4b1f6ee52cff 100644 --- a/flang/test/Lower/dummy-procedure.f90 +++ b/flang/test/Lower/dummy-procedure.f90 @@ -75,18 +75,64 @@ subroutine test_sub() call prefoo_sub(sub) end subroutine +! Test passing unrestricted intrinsics + +! Intrinsic using runtime +! CHECK-LABEL: func @_QPtest_acos +subroutine test_acos(x) + intrinsic :: acos + !CHECK: %[[f:.*]] = constant @fir.acos.f32.ref_f32 : (!fir.ref) -> f32 + !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> f32) -> (() -> ()) + !CHECK: fir.call @_QPfoo_acos(%[[fcast]]) : (() -> ()) -> () + call foo_acos(acos) +end subroutine + +! CHECK-LABEL: func @fir.acos.f32.ref_f32(%arg0: !fir.ref) -> f32 + !CHECK: %[[load:.*]] = fir.load %arg0 + !CHECK: %[[res:.*]] = call @__fs_acos_1(%[[load]]) : (f32) -> f32 + !CHECK: return %[[res]] : f32 + +! Intrinsic implemented inlined +! CHECK-LABEL: func @_QPtest_aimag +subroutine test_aimag() + intrinsic :: aimag + !CHECK: %[[f:.*]] = constant @fir.aimag.f32.ref_z4 : (!fir.ref>) -> f32 + !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref>) -> f32) -> (() -> ()) + !CHECK: fir.call @_QPfoo_aimag(%[[fcast]]) : (() -> ()) -> () + call foo_aimag(aimag) +end subroutine + +!CHECK-LABEL: func @fir.aimag.f32.ref_z4(%arg0: !fir.ref>) + !CHECK: %[[load:.*]] = fir.load %arg0 + !CHECK: %[[cst1:.*]] = constant 1 + !CHECK: %[[imag:.*]] = fir.extract_value %[[load]], %[[cst1]] : (!fir.complex<4>, index) -> f32 + !CHECK: return %[[imag]] : f32 + + +! Character Intrinsic implemented inlined +! CHECK-LABEL: func @_QPtest_len +subroutine test_len() + intrinsic :: len + ! CHECK: %[[f:.*]] = constant @fir.len.i32.bc1 : (!fir.boxchar<1>) -> i32 + ! CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.boxchar<1>) -> i32) -> (() -> ()) + !CHECK: fir.call @_QPfoo_len(%[[fcast]]) : (() -> ()) -> () + call foo_len(len) +end subroutine + +!CHECK-LABEL: func @fir.len.i32.bc1(%arg0: !fir.boxchar<1>) + !CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) + !CHECK: %[[len:.*]] = fir.convert %[[unboxed]]#1 : (index) -> i32 + !CHECK: return %[[len]] : i32 + + +! TODO: exhaustive test of unrestricted intrinsic table 16.2 + ! FIXME: create funcOp if not defined in file !subroutine todo1() ! external proc_not_defined_in_file ! call prefoo_sub(proc_not_defined_in_file) !end subroutine -! FIXME: pass intrinsics -!subroutine todo2() -! intrinsic :: acos -! print *, prefoo(acos) -!end subroutine - ! TODO: improve dummy procedure types when interface is given. ! CHECK: func @_QPtodo3(%arg0: () -> ()) ! SHOULD-CHECK: func @_QPtodo3(%arg0: (!fir.ref) -> f32) From 43becb2314a33f8b9e31e725279765c0d6c365d0 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 30 Jun 2020 07:44:52 -0700 Subject: [PATCH 0126/1017] bug fixes for fcvs lowering of globals --- flang/lib/Lower/CharacterExpr.cpp | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index ab720475183cf..de547460f3810 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -35,8 +35,11 @@ static fir::CharacterType getCharacterType(const fir::CharBoxValue &box) { } static bool needToMaterialize(const fir::CharBoxValue &box) { - return box.getBuffer().getType().isa() || - box.getBuffer().getType().isa(); + auto buffTy = box.getBuffer().getType(); + if (auto seqTy = buffTy.dyn_cast()) + if (seqTy.getShape().size() == 1) + buffTy = seqTy.getEleTy(); + return buffTy.isa(); } static std::optional From b54c1d8ddac64a14dd936cf15fd624dd400fef28 Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 30 Jun 2020 08:51:43 -0700 Subject: [PATCH 0127/1017] fix comment --- flang/lib/Lower/PFTBuilder.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 075fa04f97910..f1908ad6eb215 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -83,7 +83,7 @@ class PFTBuilder { } else if constexpr (UnwrapStmt::isStmt) { using T = typename UnwrapStmt::Type; // Node "a" being visited has one of the following types: - // Statement, Statement, UnlabeledStatement, + // Statement, Statement>, UnlabeledStatement, // or UnlabeledStatement> auto stmt{UnwrapStmt(a)}; if constexpr (lower::pft::isConstructStmt || From af8221e922c54425f10edbdd5e5381f8b67582d3 Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 30 Jun 2020 14:30:11 -0700 Subject: [PATCH 0128/1017] fix for CSE bug #208 --- flang/lib/Optimizer/Transforms/CSE.cpp | 17 +++++++++------- flang/test/Fir/cse.fir | 27 ++++++++++++++++++++++++++ 2 files changed, 37 insertions(+), 7 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp index 641015935dbbb..0365562b88121 100644 --- a/flang/lib/Optimizer/Transforms/CSE.cpp +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -174,6 +174,14 @@ struct BasicCSE : public fir::BasicCSEBase { /// Attempt to eliminate a redundant operation. LogicalResult BasicCSE::simplifyOperation(ScopedMapTy &knownValues, Operation *op) { + if (op->isKnownTerminator()) + return failure(); + + if (isOpTriviallyDead(op)) { + opsToErase.push_back(op); + return success(); + } + // Don't simplify operations with nested blocks. We don't currently model // equality comparisons correctly among other things. It is also unclear // whether we would want to CSE such operations. @@ -184,12 +192,6 @@ LogicalResult BasicCSE::simplifyOperation(ScopedMapTy &knownValues, !fir::pureCall(op)) return failure(); - // If the operation is already trivially dead just add it to the erase list. - if (isOpTriviallyDead(op)) { - opsToErase.push_back(op); - return success(); - } - // Look for an existing definition for the operation. if (auto *existing = knownValues.lookup(op)) { // If we find one then replace all uses of the current operation with the @@ -220,7 +222,8 @@ void BasicCSE::simplifyBlock(ScopedMapTy &knownValues, DominanceInfo &domInfo, if (fir::nonVolatileLoad(&inst) || fir::pureCall(&inst)) inst.setAttr("effects_token", IntegerAttr::get(IndexType::get(inst.getContext()), token)); - if (dyn_cast(&inst) || fir::impureCall(&inst)) + if (isa(&inst) || fir::impureCall(&inst) || + inst.getNumRegions() != 0) token = reinterpret_cast(&inst); } for (auto &inst : *bb) { diff --git a/flang/test/Fir/cse.fir b/flang/test/Fir/cse.fir index 91272292a118e..10819cca1ed2e 100644 --- a/flang/test/Fir/cse.fir +++ b/flang/test/Fir/cse.fir @@ -48,3 +48,30 @@ func @fun2(%a : !fir.ref) -> i64 { // CHECK-NEXT: ret i64 return %13 : i64 } + +// Negative test: do not merge loads when an op with regions is between +// CHECK-LABEL: @foo +func @foo(%arg0: !fir.ref) -> f32 { + // CHECK: %[[var:.*]] = alloca float + %0 = fir.alloca f32 {name = "x"} + %1 = fir.load %arg0 : !fir.ref + fir.store %1 to %0 : !fir.ref + %cst = constant 0.000000e+00 : f32 + // CHECK: load float, float* %[[var]], + %2 = fir.load %0 : !fir.ref + %3 = fir.cmpf "olt", %2, %cst : f32 + fir.if %3 { + // CHECK: load float, float* %[[var]] + %7 = fir.load %0 : !fir.ref + %8 = fir.negf %7 : f32 + fir.store %8 to %0 : !fir.ref + } + %cst_0 = constant 1.000000e+00 : f32 + // CHECK: load float, float* %[[var]] + %4 = fir.load %0 : !fir.ref + %5 = fir.addf %4, %cst_0 : f32 + fir.store %5 to %0 : !fir.ref + // CHECK: load float, float* %[[var]] + %6 = fir.load %0 : !fir.ref + return %6 : f32 +} From 440b91e6fb75ee38511dcdacc6faacd10a40fe4f Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 30 Jun 2020 19:18:28 -0700 Subject: [PATCH 0129/1017] revert change to needsToMaterialize() --- flang/lib/Lower/CharacterExpr.cpp | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index de547460f3810..ab720475183cf 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -35,11 +35,8 @@ static fir::CharacterType getCharacterType(const fir::CharBoxValue &box) { } static bool needToMaterialize(const fir::CharBoxValue &box) { - auto buffTy = box.getBuffer().getType(); - if (auto seqTy = buffTy.dyn_cast()) - if (seqTy.getShape().size() == 1) - buffTy = seqTy.getEleTy(); - return buffTy.isa(); + return box.getBuffer().getType().isa() || + box.getBuffer().getType().isa(); } static std::optional From e35c02a95df11255b29a10d229b3dab74ec662f9 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Wed, 1 Jul 2020 04:37:38 -0700 Subject: [PATCH 0130/1017] Fix stmt-func test: do not hard code operand evaluation order --- flang/test/Lower/stmt-function.f90 | 33 +++++++++++++++--------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/flang/test/Lower/stmt-function.f90 b/flang/test/Lower/stmt-function.f90 index ed32273efc222..4d6f5be4f1d36 100644 --- a/flang/test/Lower/stmt-function.f90 +++ b/flang/test/Lower/stmt-function.f90 @@ -1,4 +1,4 @@ -! RUN: bbc -emit-fir %s -o - | FileCheck %s +! RUN: bbc -emit-fir -outline-intrinsics %s -o - | FileCheck %s ! Test statement function lowering @@ -44,15 +44,15 @@ real function test_stmt_1(x, a) b = 5 - !CHECK: %[[cst_8:.*]] = constant 8.000000e+00 - !CHECK: fir.store %[[cst_8]] to %[[tmp1:.*]] : !fir.ref + !CHECK-DAG: %[[cst_8:.*]] = constant 8.000000e+00 + !CHECK-DAG: fir.store %[[cst_8]] to %[[tmp1:.*]] : !fir.ref !CHECK-DAG: %[[foocall1:.*]] = fir.call @_QPfoo(%[[tmp1]]) !CHECK-DAG: %[[aload1:.*]] = fir.load %arg1 - !CHECK-DAG: %[[add1:.*]] = fir.addf %[[aload1]], %[[foocall1]] + !CHECK: %[[add1:.*]] = fir.addf %[[aload1]], %[[foocall1]] !CHECK: fir.store %[[add1]] to %[[res1]] res1 = func1(8.) - !CHECK: %[[x:.*]] = fir.load %arg0 + !CHECK-DAG: %[[x:.*]] = fir.load %arg0 !CHECK-DAG: fir.store %[[x]] to %[[tmp2:.*]] : !fir.ref !CHECK-DAG: %[[foocall2:.*]] = fir.call @_QPfoo(%[[tmp2]]) !CHECK-DAG: %[[aload2:.*]] = fir.load %arg1 @@ -81,16 +81,17 @@ real function test_stmt_no_args(x, y) end function ! Test statement function with character arguments -integer function test_stmt_character(c, j, n) +integer function test_stmt_character(c, j) integer :: i, j, func, argj - integer(8) :: n - character(n) :: c, arg - func(arg, argj) = len(arg) + argj - !CHECK: %[[j:.*]] = fir.load %arg1 - !CHECK: %[[n:.*]] = fir.load %arg2 - !CHECK: %[[n32:.*]] = fir.convert %[[n]] : (i64) -> i32 - !CHECK: addi %[[n32]], %[[j]] + character(10) :: c, argc + !CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : + !CHECK-DAG: %[[c10:.*]] = constant 10 : + !CHECK: %[[c:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10]] + + func(argc, argj) = len_trim(argc, 4) + argj + !CHECK-DAG: %[[j:.*]] = fir.load %arg1 + !CHECK-DAG: %[[c4:.*]] = constant 4 : + !CHECK-DAG: %[[len_trim:.*]] = call @fir.len_trim.i32.bc1.i32(%[[c]], %[[c4]]) + !CHECK: addi %[[len_trim]], %[[j]] test_stmt_character = func(c, j) -end function - - +end function From ebc855805a770501ee93e9ffeb8d4b0f7632b569 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 1 Jul 2020 12:49:14 -0700 Subject: [PATCH 0131/1017] prep work so we can upstream a trivial inlining pass --- flang/test/Fir/inline.fir | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/test/Fir/inline.fir b/flang/test/Fir/inline.fir index bd4136c974591..93a186a12ac3d 100644 --- a/flang/test/Fir/inline.fir +++ b/flang/test/Fir/inline.fir @@ -1,4 +1,4 @@ -// RUN: tco --enable-inlining %s -o - | FileCheck %s +// RUN: tco --inline-all %s -o - | FileCheck %s // CHECK-LABEL: @add func @add(%a : i32, %b : i32) -> i32 { From 3cee3302d78effcae437dce4acc77c649c66b4d7 Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 1 Jul 2020 16:14:17 -0700 Subject: [PATCH 0132/1017] fix fm203 --- flang/lib/Lower/Bridge.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 72d664c367609..77780b825cca4 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1378,7 +1378,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (isCharacterCategory(lhsType->category())) { // Fortran 2018 10.2.1.3 p10 and p11 // Generating value for lhs to get fir.boxchar. - auto lhs = genExprValue(assign.lhs); + auto lhs = genExprAddr(assign.lhs); auto rhs = genExprValue(assign.rhs); Fortran::lower::CharacterExprHelper{*builder, loc}.createAssign( lhs, rhs); From 46c7308a70f050c310912dcdcf4ea6d5e8351359 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 1 Jul 2020 16:36:57 -0700 Subject: [PATCH 0133/1017] fix warning --- flang/lib/Optimizer/Transforms/CSE.cpp | 3 --- 1 file changed, 3 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp index 0365562b88121..5146f1f30aff1 100644 --- a/flang/lib/Optimizer/Transforms/CSE.cpp +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -114,9 +114,6 @@ struct SimpleOperationInfo : public llvm::DenseMapInfo { /// Basic common sub-expression elimination. struct BasicCSE : public fir::BasicCSEBase { - BasicCSE() {} - BasicCSE(const BasicCSE &) {} - /// Shared implementation of operation elimination and scoped map definitions. using AllocatorTy = llvm::RecyclingAllocator< llvm::BumpPtrAllocator, From b6d61137e93ee6d00b654076228ecfba86a7a581 Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Thu, 2 Jul 2020 08:46:09 -0700 Subject: [PATCH 0134/1017] Fix spelling of hasAlternateReturns --- flang/lib/Lower/CallInterface.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index 364a50e276dcb..6d1e8d89e9ceb 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -22,7 +22,7 @@ //===----------------------------------------------------------------------===// bool Fortran::lower::CallerInterface::hasAlternateReturns() const { - return procRef.HasAlternateReturns(); + return procRef.hasAlternateReturns(); } std::string Fortran::lower::CallerInterface::getMangledName() const { From e74492d32205d398d83006ea86d3c4fbf38c1412 Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Fri, 26 Jun 2020 20:25:46 +0530 Subject: [PATCH 0135/1017] [flang] Lower InquireStmt. Fix a bug in PFT builder to support IoLength. Add comments. git-clang-formatted --- flang/lib/Lower/Bridge.cpp | 7 ++++--- flang/test/Lower/io-stmt01.f90 | 18 +++++++++++++++++- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 77780b825cca4..5cfd357f1091b 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1106,9 +1106,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(const Fortran::parser::InquireStmt &stmt) { auto iostat = genInquireStatement(*this, stmt); - genIoConditionBranches( - getEval(), std::get>(stmt.u), - iostat); + if (const auto *specs = + std::get_if>(&stmt.u)) { + genIoConditionBranches(getEval(), *specs, iostat); + } } void genFIR(const Fortran::parser::OpenStmt &stmt) { auto iostat = genOpenStatement(*this, stmt); diff --git a/flang/test/Lower/io-stmt01.f90 b/flang/test/Lower/io-stmt01.f90 index cceacc958931b..2accde3bdfca2 100644 --- a/flang/test/Lower/io-stmt01.f90 +++ b/flang/test/Lower/io-stmt01.f90 @@ -1,5 +1,9 @@ ! RUN: bbc %s -o - | FileCheck %s + logical :: existsvar + integer :: length + real :: a(100) + ! CHECK-LABEL: _QQmain ! CHECK: call {{.*}}BeginOpenUnit ! CHECK-DAG: call {{.*}}SetFile @@ -35,7 +39,7 @@ read (8,*) i, f ! CHECK: call {{.*}}BeginExternalListOutput -! 32 bit integers are output as 64 bits in the runtime API +! 32 bit integers are output as 64 bits in the runtime API ! CHECK: call {{.*}}OutputInteger64 ! CHECK: call {{.*}}OutputReal32 ! CHECK: call {{.*}}EndIoStatement @@ -49,4 +53,16 @@ ! CHECK: call {{.*}}OutputAscii ! CHECK: call {{.*}}EndIoStatement print *, "A literal string" + +! CHECK: call {{.*}}BeginInquireUnit +! CHECK: call {{.*}}EndIoStatement + inquire(4, EXIST=existsvar) + +! CHECK: call {{.*}}BeginInquireFile +! CHECK: call {{.*}}EndIoStatement + inquire(FILE="fail.f90", EXIST=existsvar) + +! CHECK: call {{.*}}BeginInquireIoLength +! CHECK: call {{.*}}EndIoStatement + inquire (iolength=length) a end From f530626542a8e54918ebbe2ae1c862c160b7ee1e Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 6 Jul 2020 09:44:50 -0700 Subject: [PATCH 0136/1017] make requested changes to facilitate the merge --- flang/lib/Lower/Bridge.cpp | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 5cfd357f1091b..5bfe546815af5 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -788,11 +788,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { info.isStructured() ? builder->getIndexType() : info.loopVariableType; auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); auto upperValue = genFIRLoopIndex(info.upperExpr, type); - info.stepValue = - info.stepExpr.has_value() ? genFIRLoopIndex(*info.stepExpr, type) - : info.isStructured() - ? builder->create(loc, 1) - : builder->createIntegerConstant(loc, info.loopVariableType, 1); + info.stepValue = info.stepExpr.has_value() + ? genFIRLoopIndex(*info.stepExpr, type) + : info.isStructured() + ? builder->create(loc, 1) + : builder->createIntegerConstant( + loc, info.loopVariableType, 1); assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(loc, *info.loopVariableSym); @@ -1107,9 +1108,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::InquireStmt &stmt) { auto iostat = genInquireStatement(*this, stmt); if (const auto *specs = - std::get_if>(&stmt.u)) { + std::get_if>(&stmt.u)) genIoConditionBranches(getEval(), *specs, iostat); - } } void genFIR(const Fortran::parser::OpenStmt &stmt) { auto iostat = genOpenStatement(*this, stmt); From 4b0597e034a091737b817ed22b2766da8ecd8024 Mon Sep 17 00:00:00 2001 From: AlexisPerry Date: Thu, 2 Jul 2020 09:06:22 -0600 Subject: [PATCH 0137/1017] Added an implementation for the DPROD intrinsic Updates to DPROD implementation to better match the standard and in response to reviewer comments added test for DPROD intrinsic DPROD - removed hard-coded kind check and ran through clang-format --- flang/test/Lower/intrinsics.f90 | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index e5f703e7eb760..5141954051676 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -86,6 +86,20 @@ subroutine dim_testi(i, j, k) k = dim(i, j) end subroutine +! DPROD +! CHECK-LABEL: dprod_test +subroutine dprod_test (x, y, z) + real :: x,y + double precision :: z + z = dprod(x,y) + ! CHECK-DAG: %[[x:.*]] = fir.load %arg0 + ! CHECK-DAG: %[[y:.*]] = fir.load %arg1 + ! CHECK-DAG: %[[a:.*]] = fir.convert %[[x]] : (f32) -> f64 + ! CHECK-DAG: %[[b:.*]] = fir.convert %[[y]] : (f32) -> f64 + ! CHECK: %[[res:.*]] = fir.mulf %[[a]], %[[b]] + ! CHECK: fir.store %[[res]] to %arg2 +end subroutine + ! CEILING ! CHECK-LABEL: ceiling_test1 subroutine ceiling_test1(i, a) From 29c9e42a626d7eeb0c696b255a3275dea6bd5134 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 7 Jul 2020 09:36:20 -0700 Subject: [PATCH 0138/1017] add coding style comment --- flang/include/flang/Lower/AbstractConverter.h | 4 ++++ flang/include/flang/Lower/Bridge.h | 10 +++------- flang/include/flang/Lower/CallInterface.h | 4 ++++ flang/include/flang/Lower/ComplexExpr.h | 4 ++++ flang/include/flang/Lower/ConvertExpr.h | 6 ++++-- flang/include/flang/Lower/ConvertType.h | 10 ++++++---- flang/include/flang/Lower/DoLoopHelper.h | 4 ++++ flang/include/flang/Lower/PFTBuilder.h | 4 ++++ flang/include/flang/Lower/Support/BoxValue.h | 4 ++++ flang/include/flang/Lower/Support/Verifier.h | 4 ++++ flang/include/flang/Lower/Utils.h | 4 ++++ 11 files changed, 45 insertions(+), 13 deletions(-) diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h index 4fcf0f5cd3cc8..4effec70b9f68 100644 --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_ABSTRACTCONVERTER_H #define FORTRAN_LOWER_ABSTRACTCONVERTER_H diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h index 28ce992fb49a5..e724a2f338587 100644 --- a/flang/include/flang/Lower/Bridge.h +++ b/flang/include/flang/Lower/Bridge.h @@ -5,13 +5,9 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// -/// -/// \file -/// Implements lowering. Convert Fortran source to -/// [MLIR](https://github.com/tensorflow/mlir). -/// -/// [Coding style](https://llvm.org/docs/CodingStandards.html) -/// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// //===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_BRIDGE_H diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index d6424fbe5304d..2585455af6750 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -6,6 +6,10 @@ // //===----------------------------------------------------------------------===// // +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// +// // Utility that defines fir call interface for procedure both on caller and // and callee side and get the related FuncOp. // It does not emit any FIR code but for the created mlir::FuncOp, instead it diff --git a/flang/include/flang/Lower/ComplexExpr.h b/flang/include/flang/Lower/ComplexExpr.h index d3600a0cda6a5..1a9d068462228 100644 --- a/flang/include/flang/Lower/ComplexExpr.h +++ b/flang/include/flang/Lower/ComplexExpr.h @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_COMPLEXEXPR_H #define FORTRAN_LOWER_COMPLEXEXPR_H diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h index ff322aa231e9b..c441b32b42b78 100644 --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -5,11 +5,13 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// /// /// Implements the conversion from Fortran::evaluate::Expr trees to FIR. /// -/// [Coding style](https://llvm.org/docs/CodingStandards.html) -/// //===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_CONVERT_EXPR_H diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h index b807d62038186..20e1cd3f80695 100644 --- a/flang/include/flang/Lower/ConvertType.h +++ b/flang/include/flang/Lower/ConvertType.h @@ -4,7 +4,11 @@ // See https://llvm.org/LICENSE.txt for license information. // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // -//----------------------------------------------------------------------------// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// /// /// Conversion of front-end TYPE, KIND, ATTRIBUTE (TKA) information to FIR/MLIR. /// This is meant to be the single point of truth (SPOT) for all type @@ -12,9 +16,7 @@ /// tree TKA to the FIR type system. If one is converting front-end types and /// not using one of the routines provided here, it's being done wrong. /// -/// [Coding style](https://llvm.org/docs/CodingStandards.html) -/// -//----------------------------------------------------------------------------// +//===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_CONVERT_TYPE_H #define FORTRAN_LOWER_CONVERT_TYPE_H diff --git a/flang/include/flang/Lower/DoLoopHelper.h b/flang/include/flang/Lower/DoLoopHelper.h index 12901e9eb7a6d..b1d4a78abe552 100644 --- a/flang/include/flang/Lower/DoLoopHelper.h +++ b/flang/include/flang/Lower/DoLoopHelper.h @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_DOLOOPHELPER_H #define FORTRAN_LOWER_DOLOOPHELPER_H diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 044e6084330fa..60866e630dc5f 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -6,6 +6,10 @@ // //===----------------------------------------------------------------------===// // +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// +// // PFT (Pre-FIR Tree) interface. // //===----------------------------------------------------------------------===// diff --git a/flang/include/flang/Lower/Support/BoxValue.h b/flang/include/flang/Lower/Support/BoxValue.h index 0d5dec97ef097..36c20e7648469 100644 --- a/flang/include/flang/Lower/Support/BoxValue.h +++ b/flang/include/flang/Lower/Support/BoxValue.h @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #ifndef LOWER_SUPPORT_BOXVALUE_H #define LOWER_SUPPORT_BOXVALUE_H diff --git a/flang/include/flang/Lower/Support/Verifier.h b/flang/include/flang/Lower/Support/Verifier.h index 55449f43f051a..70a9e1fd5368a 100644 --- a/flang/include/flang/Lower/Support/Verifier.h +++ b/flang/include/flang/Lower/Support/Verifier.h @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #ifndef LOWER_SUPPORT_VERIFIER_H #define LOWER_SUPPORT_VERIFIER_H diff --git a/flang/include/flang/Lower/Utils.h b/flang/include/flang/Lower/Utils.h index d7c7b565dbc6a..e40d6eba4f539 100644 --- a/flang/include/flang/Lower/Utils.h +++ b/flang/include/flang/Lower/Utils.h @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_UTILS_H #define FORTRAN_LOWER_UTILS_H From 2168f84762c67ffaed537d90c1fae66f2796ea19 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Sun, 5 Jul 2020 22:59:01 +0530 Subject: [PATCH 0139/1017] [flang][OpenMP] Added support for lowering OpenMP barrier construct This patch adds lowering support for OpenMP barrier construct to OpenMP Dialect operations. In order to support lowering, this patch registers OpenMPDialect and also adds OpenMPDialect to the legalizer. switched to visitor pattern Addressed schweitzpgi review comments - Replace switch case with individual case statement as per enum. - Modified test case to use tco tool for validating lowering to llvmir. --- flang/include/flang/Lower/OpenMP.h | 12 ++++++++++++ flang/lib/Optimizer/CodeGen/CodeGen.cpp | 1 + flang/test/Lower/omp-barrier.f90 | 24 ++++++++++++++++++++++++ 3 files changed, 37 insertions(+) create mode 100644 flang/test/Lower/omp-barrier.f90 diff --git a/flang/include/flang/Lower/OpenMP.h b/flang/include/flang/Lower/OpenMP.h index a056443aeda31..615193ab6ed55 100644 --- a/flang/include/flang/Lower/OpenMP.h +++ b/flang/include/flang/Lower/OpenMP.h @@ -16,6 +16,9 @@ namespace Fortran { namespace parser { struct OpenMPConstruct; +struct OpenMPStandaloneConstruct; +struct OpenMPSimpleStandaloneConstruct; +struct OmpEndLoopDirective; } // namespace parser namespace lower { @@ -29,6 +32,15 @@ struct Evaluation; void genOpenMPConstruct(AbstractConverter &, pft::Evaluation &, const parser::OpenMPConstruct &); +void genOMP(AbstractConverter &, pft::Evaluation &, + const parser::OpenMPStandaloneConstruct &); + +void genOMP(AbstractConverter &, pft::Evaluation &, + const parser::OpenMPSimpleStandaloneConstruct &); + +void genOpenMPEndLoop(AbstractConverter &, pft::Evaluation &, + const parser::OmpEndLoopDirective &); + } // namespace lower } // namespace Fortran diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 39b06deb4c3a4..353eba5cc48a2 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -2697,6 +2697,7 @@ struct FIRToLLVMLoweringPass mlir::populateStdToLLVMConversionPatterns(typeConverter, pattern); mlir::ConversionTarget target{*context}; target.addLegalDialect(); + target.addLegalDialect(); // required NOPs for applying a full conversion target.addLegalOp(); diff --git a/flang/test/Lower/omp-barrier.f90 b/flang/test/Lower/omp-barrier.f90 new file mode 100644 index 0000000000000..0aeae6ab21479 --- /dev/null +++ b/flang/test/Lower/omp-barrier.f90 @@ -0,0 +1,24 @@ +! This test checks lowering of OpenMP Barrier Directive. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: tco | FileCheck %s --check-prefix=LLVMIR + +program barrier + + integer :: a,b,c + +!$OMP BARRIER +!FIRDialect: omp.barrier +!LLVMIRDialect: omp.barrier +!LLVMIR: call void @__kmpc_barrier(%struct.ident_t* @1, i32 %omp_global_thread_num) + c = a + b +!$OMP BARRIER +!FIRDialect: omp.barrier +!LLVMIRDialect: omp.barrier +!LLVMIR: call void @__kmpc_barrier(%struct.ident_t* @1, i32 %omp_global_thread_num1) + +end program From 949b5a7355fbdaab8586871f0eb0444ced388ce8 Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Sat, 4 Jul 2020 00:27:57 +0530 Subject: [PATCH 0140/1017] [flang] Support --always-execute-loop-body for unstructured loops. Fix for issue #214 [flang] Move end-to-end test from Examples/ to Lower/. --- flang/lib/Lower/Bridge.cpp | 12 ++++++++++- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 1 + flang/test/Examples/hello.f90 | 4 ++-- .../Lower/end-to-end-always-exec-loopbody.f90 | 17 +++++++++++++++ flang/test/Lower/unstructured-loop.f90 | 21 +++++++++++++++++++ 5 files changed, 52 insertions(+), 3 deletions(-) create mode 100644 flang/test/Lower/end-to-end-always-exec-loopbody.f90 create mode 100644 flang/test/Lower/unstructured-loop.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 5bfe546815af5..163ef6a38fb81 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -25,6 +25,7 @@ #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Optimizer/Transforms/Passes.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/tools.h" #include "mlir/Dialect/LLVMIR/LLVMDialect.h" @@ -818,8 +819,17 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto distance = builder->create(loc, upperValue, lowerValue); auto adjusted = builder->create(loc, distance, info.stepValue); - auto tripCount = + mlir::Value tripCount = builder->create(loc, adjusted, info.stepValue); + // Unstructured loop - `--always-execute-loop-body`. + if (fir::isAlwaysExecuteLoopBody()) { + auto tripCountType = tripCount.getType(); + mlir::Value zero = builder->createIntegerConstant(loc, tripCountType, 0); + auto cond = builder->create(loc, CmpIPredicate::sle, + tripCount, zero); + auto one = builder->createIntegerConstant(loc, tripCountType, 1); + tripCount = builder->create(loc, cond, one, tripCount); + } info.tripVariable = builder->createTemporary(loc, info.loopVariableType); builder->create(loc, tripCount, info.tripVariable); builder->create(loc, lowerValue, info.loopVariable); diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index a6da1515a512f..c89d2672755d1 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -294,6 +294,7 @@ class CfgConversion : public CFGConversionBase { }; } // namespace +bool fir::isAlwaysExecuteLoopBody() { return forceLoopToExecuteOnce; } /// Convert FIR's structured control flow ops to CFG ops. This /// conversion enables the `createLowerToCFGPass` to transform these to CFG /// form. diff --git a/flang/test/Examples/hello.f90 b/flang/test/Examples/hello.f90 index 85341f36eb685..8547eed6b58e4 100644 --- a/flang/test/Examples/hello.f90 +++ b/flang/test/Examples/hello.f90 @@ -8,8 +8,8 @@ ! RUN: bbc %s -o - | tco | llc --relocation-model=pic --filetype=obj -o %t.o ! RUN: %CC -I%S/../.. %S/main.c -c -o %t.main.o -! RUN: %CC %t.o %t.main.o -L%L -lFortranRuntime -lFortranDecimal -lstdc++ -lm -! RUN: ./a.out | FileCheck %s +! RUN: %CC %t.o %t.main.o -L%L -lFortranRuntime -lFortranDecimal -lstdc++ -lm -o hello +! RUN: ./hello | FileCheck %s ! CHECK: Hello, World! print *, "Hello, World!" diff --git a/flang/test/Lower/end-to-end-always-exec-loopbody.f90 b/flang/test/Lower/end-to-end-always-exec-loopbody.f90 new file mode 100644 index 0000000000000..4b4debbe1cf95 --- /dev/null +++ b/flang/test/Lower/end-to-end-always-exec-loopbody.f90 @@ -0,0 +1,17 @@ +! RUN: bbc --always-execute-loop-body %s -o - | tco | llc --relocation-model=pic --filetype=obj -o %temp.o +! RUN: %CC -I%S/../.. %S/../Examples/main.c -c -o %t.main.o +! RUN: %CC %temp.o %t.main.o -L%L -lFortranRuntime -lFortranDecimal -lstdc++ -lm -o loop +! RUN: ./loop | FileCheck %s + +program alwaysexecuteloopbody + implicit none + integer :: i,j + do i=4, 1, 1 + ! CHECK: In goto loop + print *, "In goto loop" + return + end do + ! CHECK-NOT: Should not exec + print *, "Should not exec" +end program + diff --git a/flang/test/Lower/unstructured-loop.f90 b/flang/test/Lower/unstructured-loop.f90 new file mode 100644 index 0000000000000..73333b1ca52b6 --- /dev/null +++ b/flang/test/Lower/unstructured-loop.f90 @@ -0,0 +1,21 @@ +! RUN: bbc --always-execute-loop-body --emit-fir %s -o - | FileCheck %s + +! Given the flag `--always-execute-loop-body` the compiler emits an extra +! code to change to tripcount, test tries to verify the extra emitted FIR. + +! CHECK-LABEL: func @_QPsome +subroutine some() + integer :: i + + ! CHECK: [[tripcount:%[0-9]+]] = divi_signed + ! CHECK: [[zero:%c0_i32]] = constant 0 : i32 + ! CHECK: [[cmp:%5]] = cmpi "sle", [[tripcount]], [[zero]] : i32 + ! CHECK: [[one:%c1_i32_1]] = constant 1 : i32 + ! CHECK: [[newtripcount:%6]] = select [[cmp]], [[one]], [[tripcount]] : i32 + ! CHECK: fir.store [[newtripcount]] to %0 : !fir.ref + do i=4,1,1 + stop 2 + end do + return +end + From 72eca0040b34a50f8de4b949d24de182036c2416 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 7 Jul 2020 14:23:47 -0700 Subject: [PATCH 0141/1017] move omp-barrier.f90 test to expected fail --- flang/test/Lower/omp-barrier.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/flang/test/Lower/omp-barrier.f90 b/flang/test/Lower/omp-barrier.f90 index 0aeae6ab21479..0951da4c96848 100644 --- a/flang/test/Lower/omp-barrier.f90 +++ b/flang/test/Lower/omp-barrier.f90 @@ -1,5 +1,8 @@ ! This test checks lowering of OpenMP Barrier Directive. +! https://github.com/flang-compiler/f18-llvm-project/issues/250 +! XFAIL: * + ! RUN: bbc -fopenmp -emit-fir %s -o - | \ ! RUN: FileCheck %s --check-prefix=FIRDialect ! RUN: bbc -fopenmp -emit-llvm %s -o - | \ From 607d4b34b0e554515a9dd6bf9a0e5bdcfae2690a Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 7 Jul 2020 15:37:42 -0700 Subject: [PATCH 0142/1017] move intrinsic call mangling to the bridge for upstreaming --- .../flang/Optimizer/Support/InternalNames.h | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/flang/include/flang/Optimizer/Support/InternalNames.h b/flang/include/flang/Optimizer/Support/InternalNames.h index 591436a37b5e4..fa98cc2a8e490 100644 --- a/flang/include/flang/Optimizer/Support/InternalNames.h +++ b/flang/include/flang/Optimizer/Support/InternalNames.h @@ -14,10 +14,6 @@ #include "llvm/ADT/StringRef.h" #include -namespace mlir { -class FunctionType; -} - namespace fir { /// Internal name mangling of identifiers @@ -136,17 +132,6 @@ struct NameUniquer { NameUniquer &operator=(const NameUniquer &) = delete; }; -/// Returns a name suitable to define mlir functions for Fortran intrinsic -/// Procedure. These names are guaranteed to not conflict with user defined -/// procedures. This is needed to implement Fortran generic intrinsics as -/// several mlir functions specialized for the argument types. -/// The result is guaranteed to be distinct for different mlir::FunctionType -/// arguments. The mangling pattern is: -/// fir...... -/// e.g ACOS(COMPLEX(4)) is mangled as fir.acos.z4.z4 -std::string mangleIntrinsicProcedure(llvm::StringRef genericName, - mlir::FunctionType); - } // namespace fir #endif // FORTRAN_OPTIMIZER_SUPPORT_INTERNALNAMES_H From 6493dc4de2b635bcbd11143921a24ef3ec44a363 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Wed, 8 Jul 2020 10:46:54 +0530 Subject: [PATCH 0143/1017] Fix for #250 --- flang/test/Lower/omp-barrier.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/flang/test/Lower/omp-barrier.f90 b/flang/test/Lower/omp-barrier.f90 index 0951da4c96848..0aeae6ab21479 100644 --- a/flang/test/Lower/omp-barrier.f90 +++ b/flang/test/Lower/omp-barrier.f90 @@ -1,8 +1,5 @@ ! This test checks lowering of OpenMP Barrier Directive. -! https://github.com/flang-compiler/f18-llvm-project/issues/250 -! XFAIL: * - ! RUN: bbc -fopenmp -emit-fir %s -o - | \ ! RUN: FileCheck %s --check-prefix=FIRDialect ! RUN: bbc -fopenmp -emit-llvm %s -o - | \ From a41ee920d8824e8a27f0aa6ca989a0d9dd513719 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 9 Jul 2020 09:30:50 -0700 Subject: [PATCH 0144/1017] restore the complex support code that was removed after upstreaming --- flang/lib/Lower/RTBuilder.h | 13 ++++++++++++ flang/runtime/pgmath.h.inc | 41 +++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) diff --git a/flang/lib/Lower/RTBuilder.h b/flang/lib/Lower/RTBuilder.h index 38dfa6034bdd3..d41a45cfee35e 100644 --- a/flang/lib/Lower/RTBuilder.h +++ b/flang/lib/Lower/RTBuilder.h @@ -157,6 +157,19 @@ constexpr TypeBuilderFunc getModel() { }; } +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::CplxType::get(context, sizeof(float)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::CplxType::get(context, sizeof(double)); + }; +} + template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { diff --git a/flang/runtime/pgmath.h.inc b/flang/runtime/pgmath.h.inc index 4985005bb68bf..c7b60ac749224 100644 --- a/flang/runtime/pgmath.h.inc +++ b/flang/runtime/pgmath.h.inc @@ -33,6 +33,8 @@ #ifdef PGMATH_USE_ALL_TYPES #define PGMATH_USE_S(name, func) PGMATH_USE_ALL_TYPES(name, func) #define PGMATH_USE_D(name, func) PGMATH_USE_ALL_TYPES(name, func) +#define PGMATH_USE_C(name, func) PGMATH_USE_ALL_TYPES(name, func) +#define PGMATH_USE_Z(name, func) PGMATH_USE_ALL_TYPES(name, func) #define PGMATH_USE_OTHER(name, func) PGMATH_USE_ALL_TYPES(name, func) #endif @@ -62,8 +64,15 @@ PGMATH_USE_S(func, __##impl##s_##func##_1) \ PGMATH_USE_D(func, __##impl##d_##func##_1) +#define PGMATH_COMPLEX_IMPL(impl, func) \ + PGMATH_DECLARE(float _Complex __##impl##c_##func##_1(float _Complex)) \ + PGMATH_DECLARE(double _Complex __##impl##z_##func##_1(double _Complex)) \ + PGMATH_USE_C(func, __##impl##c_##func##_1) \ + PGMATH_USE_Z(func, __##impl##z_##func##_1) + #define PGMATH_ALL_FP_IMPL(impl, func) \ PGMATH_REAL_IMPL(impl, func) \ + PGMATH_FAST_COMPLEX_IMPL(impl, func) #define PGMATH_REAL2_IMPL(impl, func) \ PGMATH_DECLARE(float __##impl##s_##func##_1(float, float)) \ @@ -71,8 +80,17 @@ PGMATH_USE_S(func, __##impl##s_##func##_1) \ PGMATH_USE_D(func, __##impl##d_##func##_1) +#define PGMATH_COMPLEX2_IMPL(impl, func) \ + PGMATH_DECLARE( \ + float _Complex __##impl##c_##func##_1(float _Complex, float _Complex)) \ + PGMATH_DECLARE(double _Complex __##impl##z_##func##_1( \ + double _Complex, double _Complex)) \ + PGMATH_USE_C(func, __##impl##c_##func##_1) \ + PGMATH_USE_Z(func, __##impl##z_##func##_1) + #define PGMATH_ALL_FP2_IMPL(impl, func) \ PGMATH_REAL2_IMPL(func) \ + PGMATH_COMPLEX2_IMPL(func) #undef PGMATH_FAST_REAL #undef PGMATH_FAST_COMPLEX @@ -82,8 +100,10 @@ #undef PGMATH_FAST_ALL_FP2 #ifdef PGMATH_FAST #define PGMATH_FAST_REAL(func) PGMATH_REAL_IMPL(f, func) +#define PGMATH_FAST_COMPLEX(func) PGMATH_COMPLEX_IMPL(f, func) #define PGMATH_FAST_ALL_FP(func) PGMATH_ALL_IMPL(f, func) #define PGMATH_FAST_REAL2(func) PGMATH_REAL2_IMPL(f, func) +#define PGMATH_FAST_COMPLEX2(func) PGMATH_COMPLEX2_IMPL(f, func) #define PGMATH_FAST_ALL_FP2(func) PGMATH_ALL_FP2_IMPL(f, func) #else #define PGMATH_FAST_REAL(func) @@ -102,8 +122,10 @@ #undef PGMATH_RELAXED_ALL_FP2 #ifdef PGMATH_RELAXED #define PGMATH_RELAXED_REAL(func) PGMATH_REAL_IMPL(r, func) +#define PGMATH_RELAXED_COMPLEX(func) PGMATH_COMPLEX_IMPL(r, func) #define PGMATH_RELAXED_ALL_FP(func) PGMATH_ALL_IMPL(r, func) #define PGMATH_RELAXED_REAL2(func) PGMATH_REAL2_IMPL(r, func) +#define PGMATH_RELAXED_COMPLEX2(func) PGMATH_COMPLEX2_IMPL(r, func) #define PGMATH_RELAXED_ALL_FP2(func) PGMATH_ALL_FP2_IMPL(r, func) #else #define PGMATH_RELAXED_REAL(func) @@ -122,8 +144,10 @@ #undef PGMATH_PRECISE_ALL_FP2 #ifdef PGMATH_PRECISE #define PGMATH_PRECISE_REAL(func) PGMATH_REAL_IMPL(p, func) +#define PGMATH_PRECISE_COMPLEX(func) PGMATH_COMPLEX_IMPL(p, func) #define PGMATH_PRECISE_ALL_FP(func) PGMATH_ALL_IMPL(p, func) #define PGMATH_PRECISE_REAL2(func) PGMATH_REAL2_IMPL(p, func) +#define PGMATH_PRECISE_COMPLEX2(func) PGMATH_COMPLEX2_IMPL(p, func) #define PGMATH_PRECISE_ALL_FP2(func) PGMATH_ALL_FP2_IMPL(p, func) #else #define PGMATH_PRECISE_REAL(func) @@ -139,16 +163,28 @@ PGMATH_PRECISE_REAL(func) \ PGMATH_RELAXED_REAL(func) +#define PGMATH_COMPLEX(func) \ + PGMATH_FAST_COMPLEX(func) \ + PGMATH_PRECISE_COMPLEX(func) \ + PGMATH_RELAXED_COMPLEX(func) + #define PGMATH_ALL(func) \ PGMATH_REAL(func) \ + PGMATH_COMPLEX(func) #define PGMATH_REAL2(func) \ PGMATH_FAST_REAL2(func) \ PGMATH_PRECISE_REAL2(func) \ PGMATH_RELAXED_REAL2(func) +#define PGMATH_COMPLEX2(func) \ + PGMATH_FAST_COMPLEX2(func) \ + PGMATH_PRECISE_COMPLEX2(func) \ + PGMATH_RELAXED_COMPLEX2(func) + #define PGMATH_ALL2(func) \ PGMATH_REAL2(func) \ + PGMATH_COMPLEX2(func) // Marcos to declare __mth_i libpgmath variants #define PGMATH_MTH_VERSION_REAL(func) \ @@ -207,12 +243,16 @@ PGMATH_ALL2(pow) #define PGMATH_DELCARE_POW(impl) \ PGMATH_DECLARE(float __##impl##s_powi_1(float, int)) \ PGMATH_DECLARE(double __##impl##d_powi_1(double, int)) \ + PGMATH_DECLARE(float _Complex __##impl##c_powi_1(float _Complex, int)) \ + PGMATH_DECLARE(double _Complex __##impl##z_powi_1(double _Complex, int)) \ PGMATH_USE_S(pow, __##impl##s_powi_1) \ PGMATH_USE_D(pow, __##impl##d_powi_1) \ PGMATH_USE_C(pow, __##impl##c_powi_1) \ PGMATH_USE_Z(pow, __##impl##z_powi_1) \ PGMATH_DECLARE(float __##impl##s_powk_1(float, int64_t)) \ PGMATH_DECLARE(double __##impl##d_powk_1(double, int64_t)) \ + PGMATH_DECLARE(float _Complex __##impl##c_powk_1(float _Complex, int64_t)) \ + PGMATH_DECLARE(double _Complex __##impl##z_powk_1(double _Complex, int64_t)) \ PGMATH_USE_S(pow, __##impl##s_powk_1) \ PGMATH_USE_D(pow, __##impl##d_powk_1) \ PGMATH_USE_C(pow, __##impl##c_powk_1) \ @@ -237,6 +277,7 @@ PGMATH_USE_OTHER(pow, __mth_i_kpowk) PGMATH_ALL(sin) PGMATH_ALL(sinh) PGMATH_MTH_VERSION_REAL(sqrt) +PGMATH_COMPLEX(sqrt) // real versions are __mth_i... PGMATH_ALL(tan) PGMATH_ALL(tanh) From ba9f7dfe09548ee410ff9f11bb372592ba8cbfa2 Mon Sep 17 00:00:00 2001 From: Steve Scalpone Date: Wed, 8 Jul 2020 23:10:29 -0700 Subject: [PATCH 0145/1017] The file fortran_main.c is a wrapper for the Fortran main program. Move it from the Examples directory to the runtime. The examples that use the wrapper now get it from the runtime. --- flang/runtime/CMakeLists.txt | 1 + flang/{test/Examples/main.c => runtime/fortran_main.c} | 4 ++-- flang/test/Examples/hello.f90 | 3 +-- flang/test/Lower/end-to-end-always-exec-loopbody.f90 | 3 +-- 4 files changed, 5 insertions(+), 6 deletions(-) rename flang/{test/Examples/main.c => runtime/fortran_main.c} (81%) diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index 47618231056f9..e1c0db51c5c67 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -65,6 +65,7 @@ add_flang_library(FortranRuntime type-code.cpp unit.cpp unit-map.cpp + fortran_main.c LINK_LIBS FortranDecimal diff --git a/flang/test/Examples/main.c b/flang/runtime/fortran_main.c similarity index 81% rename from flang/test/Examples/main.c rename to flang/runtime/fortran_main.c index 7742730637c88..4954bdc039814 100644 --- a/flang/test/Examples/main.c +++ b/flang/runtime/fortran_main.c @@ -1,5 +1,5 @@ -#include "runtime/main.h" -#include "runtime/stop.h" +#include "main.h" +#include "stop.h" /* main entry into PROGRAM */ void _QQmain(); diff --git a/flang/test/Examples/hello.f90 b/flang/test/Examples/hello.f90 index 8547eed6b58e4..1c5b2f5e44ea3 100644 --- a/flang/test/Examples/hello.f90 +++ b/flang/test/Examples/hello.f90 @@ -7,8 +7,7 @@ ! default when they are available. ! RUN: bbc %s -o - | tco | llc --relocation-model=pic --filetype=obj -o %t.o -! RUN: %CC -I%S/../.. %S/main.c -c -o %t.main.o -! RUN: %CC %t.o %t.main.o -L%L -lFortranRuntime -lFortranDecimal -lstdc++ -lm -o hello +! RUN: %CC %t.o -L%L -lFortranRuntime -lFortranDecimal -lstdc++ -lm -o hello ! RUN: ./hello | FileCheck %s ! CHECK: Hello, World! diff --git a/flang/test/Lower/end-to-end-always-exec-loopbody.f90 b/flang/test/Lower/end-to-end-always-exec-loopbody.f90 index 4b4debbe1cf95..9d6518c44084d 100644 --- a/flang/test/Lower/end-to-end-always-exec-loopbody.f90 +++ b/flang/test/Lower/end-to-end-always-exec-loopbody.f90 @@ -1,6 +1,5 @@ ! RUN: bbc --always-execute-loop-body %s -o - | tco | llc --relocation-model=pic --filetype=obj -o %temp.o -! RUN: %CC -I%S/../.. %S/../Examples/main.c -c -o %t.main.o -! RUN: %CC %temp.o %t.main.o -L%L -lFortranRuntime -lFortranDecimal -lstdc++ -lm -o loop +! RUN: %CC %temp.o -L%L -lFortranRuntime -lFortranDecimal -lstdc++ -lm -o loop ! RUN: ./loop | FileCheck %s program alwaysexecuteloopbody From e96545951a960318e3a3fde452925b077b808eab Mon Sep 17 00:00:00 2001 From: rajan Date: Thu, 9 Jul 2020 17:41:58 -0400 Subject: [PATCH 0146/1017] converting fir where operation to affine if for affine promotion. (#240) * converting fir.whereOp to affine.if in affine promotion * filecheck tests for affine promotion (loop fusion and unswitching) * refactoring rewriteLoad, rewriteStore for reuse in if conversion --- .../Optimizer/Transforms/AffinePromotion.cpp | 315 ++++++++++++++---- flang/test/Fir/affine-loop-fusion.fir | 59 ++++ flang/test/Fir/affine-loop-unswitch.fir | 52 +++ 3 files changed, 366 insertions(+), 60 deletions(-) create mode 100644 flang/test/Fir/affine-loop-fusion.fir create mode 100644 flang/test/Fir/affine-loop-unswitch.fir diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index a7ba75eb04f32..3446dc680b5ba 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -14,6 +14,7 @@ #include "mlir/Dialect/Affine/IR/AffineOps.h" #include "mlir/Dialect/StandardOps/IR/Ops.h" #include "mlir/IR/Attributes.h" +#include "mlir/IR/IntegerSet.h" #include "mlir/IR/Visitors.h" #include "mlir/Pass/Pass.h" #include "mlir/Transforms/DialectConversion.h" @@ -33,6 +34,8 @@ using namespace fir; namespace { class AffineFunctionAnalysis; class AffineLoopAnalysis; +class AffineIfAnalysis; +class AffineIfConversion; class AffineLoopAnalysis { public: @@ -49,7 +52,7 @@ class AffineLoopAnalysis { bool analyzeBody(fir::LoopOp, AffineFunctionAnalysis &); bool analyzeLoop(fir::LoopOp loopOperation, AffineFunctionAnalysis &functionAnalysis) { - LLVM_DEBUG(llvm::dbgs() << "AffinLoopAnalysis: \n"; loopOperation.dump();); + LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: \n"; loopOperation.dump();); return analyzeMemoryAccess(loopOperation) && analyzeBody(loopOperation, functionAnalysis); } @@ -65,7 +68,120 @@ class AffineLoopAnalysis { } }; -/// builds analysis for all loop operations within a function +/// Calculates arguments for creating an IntegerSet symCount, dimCount are the +/// final number of symbols and dimensions of the affine map. If integer set if +/// possible is in Optional IntegerSet +class AffineIfCondition { +public: + typedef Optional MaybeAffineExpr; + AffineIfCondition(mlir::Value fc) + : firCondition(fc), symCount(0), dimCount(0) { + if (auto condDef = firCondition.getDefiningOp()) + fromCmpIOp(condDef); + } + AffineIfCondition() {} + llvm::SmallVector affineArgs; + friend AffineIfAnalysis; + friend AffineIfConversion; + +private: + mlir::Value firCondition; + Optional integerSet; + unsigned symCount, dimCount; + template + MaybeAffineExpr affineBinaryOp(mlir::AffineExprKind kind, T1 lhs, T2 rhs) { + return affineBinaryOp( + kind, toAffineExpr(lhs), toAffineExpr(rhs)); + } + template <> + MaybeAffineExpr affineBinaryOp( + mlir::AffineExprKind kind, MaybeAffineExpr lhs, MaybeAffineExpr rhs) { + if (lhs.hasValue() && rhs.hasValue()) + return mlir::getAffineBinaryOpExpr(kind, lhs.getValue(), rhs.getValue()); + else + return {}; + } + MaybeAffineExpr toAffineExpr(MaybeAffineExpr e) { return e; } + MaybeAffineExpr toAffineExpr(int64_t value) { + return {mlir::getAffineConstantExpr(value, firCondition.getContext())}; + } + /// Returns an AffineExpr if it is a result of operations that can be done + /// in an affine expression, this includes -, +, *, rem, constant. + /// block arguments of a loopOp or forOp are used as dimensions + MaybeAffineExpr toAffineExpr(mlir::Value value) { + if (auto op = value.getDefiningOp()) + return affineBinaryOp( + mlir::AffineExprKind::Add, op.lhs(), + affineBinaryOp(mlir::AffineExprKind::Mul, op.rhs(), -1)); + if (auto op = value.getDefiningOp()) + return affineBinaryOp(mlir::AffineExprKind::Add, op.lhs(), op.rhs()); + if (auto op = value.getDefiningOp()) + return affineBinaryOp(mlir::AffineExprKind::Mul, op.lhs(), op.rhs()); + if (auto op = value.getDefiningOp()) + return affineBinaryOp(mlir::AffineExprKind::Mod, op.lhs(), op.rhs()); + if (auto op = value.getDefiningOp()) + if (auto intConstant = op.getValue().dyn_cast()) + return toAffineExpr(intConstant.getInt()); + if (auto blockArg = value.dyn_cast()) { + affineArgs.push_back(value); + if (isa(blockArg.getOwner()->getParentOp()) || + isa(blockArg.getOwner()->getParentOp())) + return {mlir::getAffineDimExpr(dimCount++, value.getContext())}; + return {mlir::getAffineSymbolExpr(symCount++, value.getContext())}; + } + return {}; + } + void fromCmpIOp(mlir::CmpIOp cmpOp) { + auto lhsAffine = toAffineExpr(cmpOp.lhs()); + auto rhsAffine = toAffineExpr(cmpOp.rhs()); + if (!lhsAffine.hasValue() || !rhsAffine.hasValue()) + return; + auto constraintPair = constraint( + cmpOp.predicate(), rhsAffine.getValue() - lhsAffine.getValue()); + if (!constraintPair) + return; + integerSet = mlir::IntegerSet::get(dimCount, symCount, + {constraintPair.getValue().first}, + {constraintPair.getValue().second}); + return; + } + + Optional> + constraint(mlir::CmpIPredicate predicate, mlir::AffineExpr basic) { + switch (predicate) { + case mlir::CmpIPredicate::slt: + return {std::make_pair(basic - 1, false)}; + case mlir::CmpIPredicate::sle: + return {std::make_pair(basic, false)}; + case mlir::CmpIPredicate::sgt: + return {std::make_pair(1 - basic, false)}; + case mlir::CmpIPredicate::sge: + return {std::make_pair(0 - basic, false)}; + case mlir::CmpIPredicate::eq: + return {std::make_pair(basic, true)}; + default: + return {}; + } + } +}; + +/// Analysis for affine promotion of fir.if +class AffineIfAnalysis { +public: + AffineIfAnalysis(fir::WhereOp op, AffineFunctionAnalysis &afa) + : legality(analyzeIf(op, afa)) {} + bool canPromoteToAffine() { return legality; } + friend AffineFunctionAnalysis; + +private: + bool legality; + AffineIfAnalysis(bool forcedLegality) : legality(forcedLegality) {} + bool analyzeIf(fir::WhereOp, AffineFunctionAnalysis &); +}; + +/// Stores analysis objects for all loops and where operations inside a function +/// these analysis are used twice, first for marking operations for rewrite and +/// second when doing rewrite. class AffineFunctionAnalysis { public: AffineFunctionAnalysis(mlir::FuncOp funcOp) { @@ -83,11 +199,24 @@ class AffineFunctionAnalysis { } return it->getSecond(); } + AffineIfAnalysis getChildIfAnalysis(fir::WhereOp op) const { + auto it = ifAnalysisMap.find_as(op); + if (it == ifAnalysisMap.end()) { + LLVM_DEBUG(llvm::dbgs() << "AffineFunctionAnalysis: not computed for:\n"; + op.dump();); + op.emitError("error in fetching if analysis in AffineFunctionAnalysis\n"); + return AffineIfAnalysis(false); + } + return it->getSecond(); + } friend AffineLoopAnalysis; + friend AffineIfAnalysis; private: llvm::DenseMap loopAnalysisMap; + llvm::DenseMap ifAnalysisMap; }; + bool analyzeCoordinate(mlir::Value coordinate) { if (auto blockArg = coordinate.dyn_cast()) { if (isa(blockArg.getOwner()->getParentOp())) { @@ -125,9 +254,24 @@ bool AffineLoopAnalysis::analyzeBody(fir::LoopOp loopOperation, if (!analysis.canPromoteToAffine()) return false; } + for (auto whereOp : loopOperation.getOps()) + functionAnalysis.ifAnalysisMap.try_emplace(whereOp, whereOp, + functionAnalysis); return true; } +bool AffineIfAnalysis::analyzeIf(fir::WhereOp op, AffineFunctionAnalysis &afa) { + if (op.getNumResults() == 0) + return true; + LLVM_DEBUG( + llvm::dbgs() << "AffineIfAnalysis: not promoting as op has results\n";); + return false; +} + +/// AffineMap rewriting fir.array_coor operation to affine apply, +/// %dim = fir.gendim %lowerBound, %upperBound, %stride +/// %a = fir.array_coor %arr(%dim) %i +/// returning affineMap = affine_map<(i)[lb, ub, st] -> (i*st - lb)> mlir::AffineMap createArrayIndexAffineMap(unsigned dimensions, MLIRContext *context) { auto index = mlir::getAffineConstantExpr(0, context); @@ -144,6 +288,7 @@ mlir::AffineMap createArrayIndexAffineMap(unsigned dimensions, } return mlir::AffineMap::get(dimensions, dimensions * 3, index); } + Optional constantIntegerLike(const mlir::Value value) { if (auto definition = value.getDefiningOp()) if (auto stepAttr = definition.getValue().dyn_cast()) @@ -151,7 +296,63 @@ Optional constantIntegerLike(const mlir::Value value) { return {}; } -/// Convert `fir.loop` to `affine.for` +mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) { + if (auto refType = op.ref().getType().dyn_cast_or_null()) { + if (auto seqType = refType.getEleTy().dyn_cast_or_null()) { + return seqType.getEleTy(); + } + } + op.emitError( + "AffineLoopConversion: array type in coordinate operation not valid\n"); + return mlir::Type(); +} + +/// Returns affine.apply and fir.convert from array_coor and gendims +std::pair +createAffineOps(mlir::Value arrayRef, mlir::PatternRewriter &rewriter) { + auto acoOp = arrayRef.getDefiningOp(); + auto genDim = acoOp.dims().getDefiningOp(); + auto affineMap = + createArrayIndexAffineMap(acoOp.coor().size(), acoOp.getContext()); + SmallVector indexArgs; + indexArgs.append(acoOp.coor().begin(), acoOp.coor().end()); + indexArgs.append(genDim.triples().begin(), genDim.triples().end()); + auto affineApply = rewriter.create(acoOp.getLoc(), + affineMap, indexArgs); + auto arrayElementType = coordinateArrayElement(acoOp); + auto newType = mlir::MemRefType::get({-1}, arrayElementType); + auto arrayConvert = + rewriter.create(acoOp.getLoc(), newType, acoOp.ref()); + return std::make_pair(affineApply, arrayConvert); +} + +void rewriteLoad(fir::LoadOp loadOp, mlir::PatternRewriter &rewriter) { + rewriter.setInsertionPoint(loadOp); + auto affineOps = createAffineOps(loadOp.memref(), rewriter); + rewriter.replaceOpWithNewOp( + loadOp, affineOps.second.getResult(), affineOps.first.getResult()); +} + +void rewriteStore(fir::StoreOp storeOp, mlir::PatternRewriter &rewriter) { + rewriter.setInsertionPoint(storeOp); + auto affineOps = createAffineOps(storeOp.memref(), rewriter); + rewriter.replaceOpWithNewOp(storeOp, storeOp.value(), + affineOps.second.getResult(), + affineOps.first.getResult()); +} + +void rewriteMemoryOps(Block *block, mlir::PatternRewriter &rewriter) { + for (auto &bodyOp : block->getOperations()) { + if (isa(bodyOp)) + rewriteLoad(cast(bodyOp), rewriter); + if (isa(bodyOp)) + rewriteStore(cast(bodyOp), rewriter); + } +} + +/// Convert `fir.loop` to `affine.for`, creates fir.convert for arrays to +/// memref, rewrites array_coor to affine.apply with affine_map. Rewrites fir +/// loads and stores to affine. class AffineLoopConversion : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -168,6 +369,7 @@ class AffineLoopConversion : public mlir::OpRewritePattern { auto loopAndIndex = createAffineFor(loop, rewriter); auto affineFor = loopAndIndex.first; auto inductionVar = loopAndIndex.second; + rewriter.startRootUpdate(affineFor.getOperation()); affineFor.getBody()->getOperations().splice(--affineFor.getBody()->end(), loopOps, loopOps.begin(), @@ -178,23 +380,11 @@ class AffineLoopConversion : public mlir::OpRewritePattern { loop.getInductionVar().replaceAllUsesWith(inductionVar); rewriter.finalizeRootUpdate(loop.getOperation()); - for (auto &bodyOp : affineFor.getBody()->getOperations()) { - if (isa(bodyOp)) { - if (failed(rewriteLoad(cast(bodyOp), rewriter))) { - return failure(); - } - } - if (isa(bodyOp)) { - if (failed(rewriteStore(cast(bodyOp), rewriter))) { - return failure(); - } - } - } - - rewriter.replaceOp(loop, affineFor.getOperation()->getResults()); + rewriteMemoryOps(affineFor.getBody(), rewriter); LLVM_DEBUG(llvm::dbgs() << "AffineLoopConversion: loop rewriten to:\n"; affineFor.dump();); + rewriter.replaceOp(loop, affineFor.getOperation()->getResults()); return success(); } @@ -206,6 +396,7 @@ class AffineLoopConversion : public mlir::OpRewritePattern { return positiveConstantStep(op, constantStep.getValue(), rewriter); return genericBounds(op, rewriter); } + // when step for the loop is positive compile time constant std::pair positiveConstantStep(fir::LoopOp op, int64_t step, mlir::PatternRewriter &rewriter) const { @@ -224,8 +415,8 @@ class AffineLoopConversion : public mlir::OpRewritePattern { auto lowerBound = mlir::getAffineSymbolExpr(0, op.getContext()); auto upperBound = mlir::getAffineSymbolExpr(1, op.getContext()); auto step = mlir::getAffineSymbolExpr(2, op.getContext()); - mlir::AffineMap upperBoundMap = - mlir::AffineMap::get(0, 3, (upperBound - lowerBound + step).floorDiv(step)); + mlir::AffineMap upperBoundMap = mlir::AffineMap::get( + 0, 3, (upperBound - lowerBound + step).floorDiv(step)); auto genericUpperBound = rewriter.create( op.getLoc(), upperBoundMap, ValueRange({op.lowerBound(), op.upperBound(), op.step()})); @@ -247,51 +438,50 @@ class AffineLoopConversion : public mlir::OpRewritePattern { ValueRange({affineFor.getInductionVar(), op.lowerBound(), op.step()})); return std::make_pair(affineFor, actualIndex.getResult()); } - mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) const { - if (auto refType = op.ref().getType().dyn_cast_or_null()) { - if (auto seqType = refType.getEleTy().dyn_cast_or_null()) { - return seqType.getEleTy(); - } + AffineFunctionAnalysis &functionAnalysis; +}; + +class AffineIfConversion : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + AffineIfConversion(mlir::MLIRContext *context, AffineFunctionAnalysis &afa) + : OpRewritePattern(context), functionAnalysis(afa) {} + mlir::LogicalResult + matchAndRewrite(fir::WhereOp op, + mlir::PatternRewriter &rewriter) const override { + LLVM_DEBUG(llvm::dbgs() << "AffineIfConversion: rewriting where:\n"; + op.dump();); + auto &whereOps = op.whereRegion().front().getOperations(); + auto affineCondition = AffineIfCondition(op.condition()); + if (!affineCondition.integerSet) { + LLVM_DEBUG( + llvm::dbgs() + << "AffineIfConversion: couldn't calculate affine condition\n";); + return failure(); } - op.emitError( - "AffineLoopConversion: array type in coordinate operation not valid\n"); - return mlir::Type(); - } - std::pair - createAffineOps(mlir::Value arrayRef, mlir::PatternRewriter &rewriter) const { - auto acoOp = arrayRef.getDefiningOp(); - auto genDim = acoOp.dims().getDefiningOp(); - auto affineMap = - createArrayIndexAffineMap(acoOp.coor().size(), acoOp.getContext()); - SmallVector indexArgs; - indexArgs.append(acoOp.coor().begin(), acoOp.coor().end()); - indexArgs.append(genDim.triples().begin(), genDim.triples().end()); - auto affineApply = rewriter.create( - acoOp.getLoc(), affineMap, indexArgs); - auto arrayElementType = coordinateArrayElement(acoOp); - auto newType = mlir::MemRefType::get({-1}, arrayElementType); - auto arrayConvert = - rewriter.create(acoOp.getLoc(), newType, acoOp.ref()); - return std::make_pair(affineApply, arrayConvert); - } + auto affineIf = rewriter.create( + op.getLoc(), affineCondition.integerSet.getValue(), + affineCondition.affineArgs, !op.otherRegion().empty()); + rewriter.startRootUpdate(affineIf); + affineIf.getThenBlock()->getOperations().splice( + --affineIf.getThenBlock()->end(), whereOps, whereOps.begin(), + --whereOps.end()); + if (!op.otherRegion().empty()) { + auto &otherOps = op.otherRegion().front().getOperations(); + affineIf.getElseBlock()->getOperations().splice( + --affineIf.getElseBlock()->end(), otherOps, otherOps.begin(), + --otherOps.end()); + } + rewriter.finalizeRootUpdate(affineIf); + rewriteMemoryOps(affineIf.getBody(), rewriter); - mlir::LogicalResult rewriteLoad(fir::LoadOp loadOp, - mlir::PatternRewriter &rewriter) const { - rewriter.setInsertionPoint(loadOp); - auto affineOps = createAffineOps(loadOp.memref(), rewriter); - rewriter.replaceOpWithNewOp( - loadOp, affineOps.second.getResult(), affineOps.first.getResult()); - return success(); - } - mlir::LogicalResult rewriteStore(fir::StoreOp storeOp, - mlir::PatternRewriter &rewriter) const { - rewriter.setInsertionPoint(storeOp); - auto affineOps = createAffineOps(storeOp.memref(), rewriter); - rewriter.replaceOpWithNewOp( - storeOp, storeOp.value(), affineOps.second.getResult(), - affineOps.first.getResult()); + LLVM_DEBUG(llvm::dbgs() << "AffineIfConversion: where converted to:\n"; + affineIf.dump();); + rewriter.replaceOp(op, affineIf.getOperation()->getResults()); return success(); } + +private: AffineFunctionAnalysis &functionAnalysis; }; @@ -308,13 +498,18 @@ class AffineDialectPromotion auto function = getFunction(); auto functionAnalysis = AffineFunctionAnalysis(function); mlir::OwningRewritePatternList patterns; + patterns.insert(context, functionAnalysis); patterns.insert(context, functionAnalysis); mlir::ConversionTarget target = *context; target.addLegalDialect(); + target.addDynamicallyLegalOp([&functionAnalysis](fir::WhereOp op) { + return !(functionAnalysis.getChildIfAnalysis(op).canPromoteToAffine()); + }); target.addDynamicallyLegalOp([&functionAnalysis](fir::LoopOp op) { return !(functionAnalysis.getChildLoopAnalysis(op).canPromoteToAffine()); }); + LLVM_DEBUG(llvm::dbgs() << "AffineDialectPromotion: running promotion on: \n"; function.print(llvm::dbgs());); diff --git a/flang/test/Fir/affine-loop-fusion.fir b/flang/test/Fir/affine-loop-fusion.fir new file mode 100644 index 0000000000000..75b3537f047d2 --- /dev/null +++ b/flang/test/Fir/affine-loop-fusion.fir @@ -0,0 +1,59 @@ +// Test loop fusion after affine promotion + +// RUN: tco --promote-to-affine --disable-affine-promotion=false --affine-loop-invariant-code-motion --cse --affine-loop-fusion --simplify-affine-structures --cse --memref-dataflow-opt %s | FileCheck %s + +!arr_d1 = type !fir.ref> +#arr_len = affine_map<()[j1,k1] -> (k1 - j1 + 1)> + +// CHECK-LABEL: func @calc +func @calc(%a1: !arr_d1, %a2: !arr_d1, %a3: !arr_d1) { + %c1 = constant 1 : index + %c0 = constant 0 : index + %len = constant 100 : index + %dims = fir.gendims %c1, %len, %c1 + : (index, index, index) -> !fir.dims<1> + %siz = affine.apply #arr_len()[%c1,%len] + %t1 = fir.alloca !fir.array, %siz + + fir.do_loop %i = %c1 to %len step %c1 { + %a1_idx = fir.array_coor %a1(%dims) %i + : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + %a1_v = fir.load %a1_idx : !fir.ref + + %a2_idx = fir.array_coor %a2(%dims) %i + : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + %a2_v = fir.load %a2_idx : !fir.ref + + %v = addf %a1_v, %a2_v : f32 + %t1_idx = fir.array_coor %t1(%dims) %i + : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + + fir.store %v to %t1_idx : !fir.ref + } + fir.do_loop %i = %c1 to %len step %c1 { + %t1_idx = fir.array_coor %t1(%dims) %i + : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + %t1_v = fir.load %t1_idx : !fir.ref + + %a2_idx = fir.array_coor %a2(%dims) %i + : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + %a2_v = fir.load %a2_idx : !fir.ref + + %v = mulf %t1_v, %a2_v : f32 + %a3_idx = fir.array_coor %a3(%dims) %i + : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + + fir.store %v to %a3_idx : !fir.ref + } +// CHECK: affine.for %{{.*}} = 1 to 101 { +// CHECK-NEXT: affine.apply affine_map<(d0) -> (d0 - 1)>(%{{.*}}) +// CHECK-NEXT: affine.load %{{.*}}[%{{.*}}] : memref +// CHECK-NEXT: affine.load %{{.*}}[%{{.*}}] : memref +// CHECK-NEXT: addf +// CHECK-NEXT: affine.load %{{.*}}[%{{.*}}] : memref +// CHECK-NEXT: mulf +// CHECK-NEXT: affine.store %{{.*}}, %{{.*}}[%{{.*}}] : memref +// CHECK-NEXT: } +// CHECK-NEXT: return + return +} diff --git a/flang/test/Fir/affine-loop-unswitch.fir b/flang/test/Fir/affine-loop-unswitch.fir new file mode 100644 index 0000000000000..29762e8021300 --- /dev/null +++ b/flang/test/Fir/affine-loop-unswitch.fir @@ -0,0 +1,52 @@ +// Test code motion for affine if + +// RUN: tco -debug-only=flang-affine-promotion --print-ir-after-all --promote-to-affine --disable-affine-promotion=false --affine-loop-invariant-code-motion --cse %s | FileCheck %s + +!arr_d1 = type !fir.ref> +#arr_len = affine_map<()[j1,k1] -> (k1 - j1 + 1)> + +// CHECK-LABEL: func @calc +func @calc(%a: !arr_d1, %v: f32) { + %c0 = constant 0 : index + %c1 = constant 1 : index + %c2 = constant 2 : index + %len = constant 100 : index + %dims = fir.gendims %c1, %len, %c1 + : (index, index, index) -> !fir.dims<1> + + fir.do_loop %i = %c1 to %len step %c1 { + fir.do_loop %j = %c1 to %len step %c1 { + fir.do_loop %k = %c1 to %len step %c1 { + %im2 = subi %i, %c2 : index + %cond = cmpi "sgt", %im2, %c0 : index + fir.if %cond { + %a_idx = fir.array_coor %a(%dims) %i + : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + fir.store %v to %a_idx : !fir.ref + } + %aj_idx = fir.array_coor %a(%dims) %j + : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + fir.store %v to %aj_idx : !fir.ref + %ak_idx = fir.array_coor %a(%dims) %k + : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + fir.store %v to %ak_idx : !fir.ref + } + } + } + // CHECK: affine.for + // CHECK-NEXT: subi + // CHECK-NEXT: affine.if + // CHECK-NEXT: affine.apply + // CHECK-NEXT: affine.store + // CHECK-NEXT: } + // CHECK-NEXT: affine.for + // CHECK-NEXT: affine.apply + // CHECK-NEXT: affine.store + // CHECK-NEXT: affine.for + // CHECK-NEXT: affine.apply + // CHECK-NEXT: affine.store + // CHECK-NEXT: } + // CHECK-NEXT: } + // CHECK-NEXT: } + return +} From 04fa7c053ab35f464336f22cbadabbe634b05897 Mon Sep 17 00:00:00 2001 From: Rajan Walia Date: Thu, 9 Jul 2020 18:30:26 -0400 Subject: [PATCH 0147/1017] removing template specialization inside class --- .../Optimizer/Transforms/AffinePromotion.cpp | 21 ++++++++++--------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index 3446dc680b5ba..8bbab851fd48a 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -88,14 +88,14 @@ class AffineIfCondition { mlir::Value firCondition; Optional integerSet; unsigned symCount, dimCount; - template - MaybeAffineExpr affineBinaryOp(mlir::AffineExprKind kind, T1 lhs, T2 rhs) { - return affineBinaryOp( - kind, toAffineExpr(lhs), toAffineExpr(rhs)); + + MaybeAffineExpr affineBinaryOp(mlir::AffineExprKind kind, mlir::Value lhs, + mlir::Value rhs) { + return affineBinaryOp(kind, toAffineExpr(lhs), toAffineExpr(rhs)); } - template <> - MaybeAffineExpr affineBinaryOp( - mlir::AffineExprKind kind, MaybeAffineExpr lhs, MaybeAffineExpr rhs) { + + MaybeAffineExpr affineBinaryOp(mlir::AffineExprKind kind, MaybeAffineExpr lhs, + MaybeAffineExpr rhs) { if (lhs.hasValue() && rhs.hasValue()) return mlir::getAffineBinaryOpExpr(kind, lhs.getValue(), rhs.getValue()); else @@ -110,9 +110,10 @@ class AffineIfCondition { /// block arguments of a loopOp or forOp are used as dimensions MaybeAffineExpr toAffineExpr(mlir::Value value) { if (auto op = value.getDefiningOp()) - return affineBinaryOp( - mlir::AffineExprKind::Add, op.lhs(), - affineBinaryOp(mlir::AffineExprKind::Mul, op.rhs(), -1)); + return affineBinaryOp(mlir::AffineExprKind::Add, toAffineExpr(op.lhs()), + affineBinaryOp(mlir::AffineExprKind::Mul, + toAffineExpr(op.rhs()), + toAffineExpr(-1))); if (auto op = value.getDefiningOp()) return affineBinaryOp(mlir::AffineExprKind::Add, op.lhs(), op.rhs()); if (auto op = value.getDefiningOp()) From 99c5fa66736b39a6e08d6ece988225ca9c341346 Mon Sep 17 00:00:00 2001 From: Rajan Walia Date: Fri, 10 Jul 2020 13:04:11 -0400 Subject: [PATCH 0148/1017] removing unnecessary tco flags --- flang/test/Fir/affine-loop-unswitch.fir | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/test/Fir/affine-loop-unswitch.fir b/flang/test/Fir/affine-loop-unswitch.fir index 29762e8021300..aff51fc0301b8 100644 --- a/flang/test/Fir/affine-loop-unswitch.fir +++ b/flang/test/Fir/affine-loop-unswitch.fir @@ -1,6 +1,6 @@ // Test code motion for affine if -// RUN: tco -debug-only=flang-affine-promotion --print-ir-after-all --promote-to-affine --disable-affine-promotion=false --affine-loop-invariant-code-motion --cse %s | FileCheck %s +// RUN: tco --promote-to-affine --disable-affine-promotion=false --affine-loop-invariant-code-motion --cse %s | FileCheck %s !arr_d1 = type !fir.ref> #arr_len = affine_map<()[j1,k1] -> (k1 - j1 + 1)> From e48f0ddf56946566b69150dacf3521f7e0bc190c Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 8 Jul 2020 16:55:22 -0700 Subject: [PATCH 0149/1017] lowering and codegen of COMMON blocks --- flang/lib/Lower/Bridge.cpp | 135 ++++++++++++++++++++---- flang/lib/Lower/CMakeLists.txt | 1 + flang/lib/Lower/Mangler.cpp | 8 +- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 2 + flang/test/Lower/common.f90 | 31 ++++++ 5 files changed, 151 insertions(+), 26 deletions(-) create mode 100644 flang/test/Lower/common.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 163ef6a38fb81..bd7bb98cfbfef 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -789,12 +789,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { info.isStructured() ? builder->getIndexType() : info.loopVariableType; auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); auto upperValue = genFIRLoopIndex(info.upperExpr, type); - info.stepValue = info.stepExpr.has_value() - ? genFIRLoopIndex(*info.stepExpr, type) - : info.isStructured() - ? builder->create(loc, 1) - : builder->createIntegerConstant( - loc, info.loopVariableType, 1); + info.stepValue = + info.stepExpr.has_value() ? genFIRLoopIndex(*info.stepExpr, type) + : info.isStructured() + ? builder->create(loc, 1) + : builder->createIntegerConstant(loc, info.loopVariableType, 1); assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(loc, *info.loopVariableSym); @@ -1577,10 +1576,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// the correct value. It will be referenced on demand using `fir.addr_of`. void instantiateGlobal(const Fortran::lower::pft::Variable &var) { const auto &sym = var.getSymbol(); - std::string globalName = mangleName(sym); + auto globalName = mangleName(sym); fir::GlobalOp global; bool isConst = sym.attrs().test(Fortran::semantics::Attr::PARAMETER); - auto loc = toLocation(); + auto loc = genLocation(sym.name()); + auto idxTy = builder->getIndexType(); // FIXME: name returned does not consider subprogram's scope, is not unique if (builder->getNamedGlobal(globalName)) return; @@ -1624,7 +1624,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { addSymbol(sym, addrOf); return; } - auto idxTy = builder->getIndexType(); mlir::Value len; if (sia.isChar) { auto c = sia.getCharLenConst(); @@ -1650,8 +1649,72 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(sia.isArray); localSymbols.addSymbolWithBounds(sym, addrOf, extents, lbounds); } + } else if (const auto *details = + sym.detailsIf()) { + const int64_t sz = static_cast(sym.size()); + bool hasInit = [&]() { + for (const auto &obj : details->objects()) + if (const auto *objDet = + obj->detailsIf()) + if (objDet->init()) + return true; + return false; + }(); + if (!sym.name().size() || !hasInit) { + // anonymous COMMON must always be initialized to zero + // a named COMMON sans initializers is also initialized to zero + auto linkage = builder->getStringAttr("common"); + fir::SequenceType::Shape shape = {sz}; + auto i8Ty = builder->getIntegerType(8); + auto commonTy = fir::SequenceType::get(shape, i8Ty); + auto vecTy = mlir::VectorType::get(sz, i8Ty); + mlir::Attribute zero = builder->getIntegerAttr(i8Ty, 0); + auto init = + mlir::DenseElementsAttr::get(vecTy, llvm::makeArrayRef(zero)); + global = + builder->createGlobal(loc, commonTy, globalName, linkage, init); + } else { + // FIXME? For now let the layout be determined by the target data + // layout. This may need to be revisited if the target data layout is + // insufficient to layout Fortran COMMON blocks. + // The target data layout is the better solution because it is selected + // by the instance of flang's chosen target rather than by properties of + // the build machine. + mlir::Type commonTy = [&]() { + llvm::SmallVector members; + for (const auto &obj : details->objects()) + members.push_back(genType(*obj)); + return mlir::TupleType::get(members, builder->getContext()); + }(); + auto linkage = builder->getStringAttr("linkonce"); + auto initFunc = [&](Fortran::lower::FirOpBuilder &builder) { + mlir::Value cb = builder.create(loc, commonTy); + unsigned offset = 0; + // Assume that the members of the COMMON block will appear in an order + // that is sorted by offset. + std::int64_t lastByteOff = -1; + for (const auto &obj : details->objects()) { + assert(lastByteOff < static_cast(obj->offset())); + lastByteOff = static_cast(obj->offset()); + if (const auto *objDet = + obj->detailsIf()) + if (objDet->init()) { + auto initVal = genExprValue(objDet->init().value()); + auto off = builder.createIntegerConstant(loc, idxTy, offset++); + cb = builder.create(loc, commonTy, cb, + initVal, off); + } + } + builder.create(loc, cb); + }; + global = builder->createGlobal(loc, commonTy, globalName, + /*isConstant=*/false, initFunc, linkage); + } + auto addrOf = builder->create(loc, global.resultType(), + global.getSymbol()); + addSymbol(sym, addrOf); } else { - TODO(); // Procedure pointer + TODO(); // Procedure pointer or something else } } @@ -1660,7 +1723,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// constructed. mlir::Value createNewLocal(mlir::Location loc, const Fortran::lower::pft::Variable &var, + mlir::Value *preAlloc, llvm::ArrayRef shape = {}) { + if (preAlloc) + return *preAlloc; auto nm = var.getSymbol().name().ToString(); auto ty = genType(var); if (shape.size()) @@ -1688,7 +1754,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// Instantiate a local variable. Precondition: Each variable will be visited /// such that if it's properties depend on other variables, the variables upon /// which its properties depend will already have been visited. - void instantiateLocal(const Fortran::lower::pft::Variable &var) { + void instantiateLocal(const Fortran::lower::pft::Variable &var, + mlir::Value *preAlloc = nullptr) { const auto &sym = var.getSymbol(); const auto loc = genLocation(sym.name()); auto idxTy = builder->getIndexType(); @@ -1708,7 +1775,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // to be handled as dummy parameters.) // Otherwise, it's a local variable. - auto local = createNewLocal(loc, var); + auto local = createNewLocal(loc, var, preAlloc); addSymbol(sym, local); return; } @@ -1781,7 +1848,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { return; } // local CHARACTER array with constant size - auto local = createNewLocal(loc, var); + auto local = createNewLocal(loc, var, preAlloc); localSymbols.addCharSymbolWithShape(sym, local, len, shape); return; } @@ -1790,7 +1857,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { return; } // local array with constant size - auto local = createNewLocal(loc, var); + auto local = createNewLocal(loc, var, preAlloc); localSymbols.addSymbolWithShape(sym, local, shape); return; } @@ -1851,7 +1918,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::SmallVector shape; shape.push_back(len); shape.append(extents.begin(), extents.end()); - auto local = createNewLocal(loc, var, shape); + auto local = createNewLocal(loc, var, preAlloc, shape); localSymbols.addCharSymbolWithBounds(sym, local, len, extents, lbounds); return; } @@ -1861,7 +1928,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // local array with computed bounds assert(!mustBeDummy); - auto local = createNewLocal(loc, var, extents); + auto local = createNewLocal(loc, var, preAlloc, extents); localSymbols.addSymbolWithBounds(sym, local, extents, lbounds); return; } @@ -1884,17 +1951,39 @@ class FirConverter : public Fortran::lower::AbstractConverter { addSymbol(sym, addr, true); return; } - auto local = createNewLocal(loc, var); + auto local = createNewLocal(loc, var, preAlloc); addSymbol(sym, local); } - void instantiateVar(const Fortran::lower::pft::Variable &var) { - if (Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) { - mlir::emitError(toLocation(), - "Common blocks not yet handled in lowering"); - exit(1); + /// The COMMON block is a global structure. `var` will be at some offset + /// within the COMMON block. Adds the address of `var` (COMMON + offset) to + /// the symbol map. + void instantiateCommon(const Fortran::semantics::Symbol &common, + const Fortran::lower::pft::Variable &var) { + auto commonName = mangleName(common); + if (!builder->getNamedGlobal(commonName)) { + Fortran::lower::pft::Variable commonVar{common, true}; + instantiateGlobal(commonVar); } - if (var.isGlobal()) + auto commonAddr = lookupSymbol(common); + const auto &varSym = var.getSymbol(); + auto byteOffset = varSym.offset(); + auto loc = genLocation(varSym.name()); + auto i8Ptr = fir::ReferenceType::get(builder->getIntegerType(8)); + auto base = builder->createConvert(loc, i8Ptr, commonAddr); + llvm::SmallVector offs{builder->createIntegerConstant( + loc, builder->getIndexType(), byteOffset)}; + auto varAddr = builder->create(loc, i8Ptr, base, offs); + auto localTy = fir::ReferenceType::get(genType(var)); + mlir::Value local = builder->createConvert(loc, localTy, varAddr); + instantiateLocal(var, &local); + } + + void instantiateVar(const Fortran::lower::pft::Variable &var) { + if (auto *common = + Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) + instantiateCommon(*common, var); + else if (var.isGlobal()) instantiateGlobal(var); else instantiateLocal(var); diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt index a3514b11ad11a..0a893a04e15a8 100644 --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -1,3 +1,4 @@ + get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) add_flang_library(FortranLower diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp index b590fc9324413..6731a5855087d 100644 --- a/flang/lib/Lower/Mangler.cpp +++ b/flang/lib/Lower/Mangler.cpp @@ -18,6 +18,8 @@ #include "llvm/ADT/StringRef.h" #include "llvm/ADT/Twine.h" +#define TODO() llvm_unreachable("not implemented") + // recursively build the vector of module scopes static void moduleNames(const Fortran::semantics::Scope &scope, llvm::SmallVector &result) { @@ -108,10 +110,10 @@ Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer, return uniquer.doConstant(modNames, optHost, symbolName); return uniquer.doVariable(modNames, optHost, symbolName); }, - [](const auto &) -> std::string { - assert(false); - return {}; + [&](const Fortran::semantics::CommonBlockDetails &) { + return uniquer.doCommonBlock(symbolName); }, + [](const auto &) -> std::string { TODO(); }, }, ultimateSymbol.details()); } diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 353eba5cc48a2..c6b0e970e4e38 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -2080,6 +2080,8 @@ struct GlobalOpConversion : public FIROpConversion { auto name = optLinkage.getValue(); if (name == "internal") return mlir::LLVM::Linkage::Internal; + if (name == "linkonce") + return mlir::LLVM::Linkage::Linkonce; if (name == "common") return mlir::LLVM::Linkage::Common; if (name == "weak") diff --git a/flang/test/Lower/common.f90 b/flang/test/Lower/common.f90 new file mode 100644 index 0000000000000..db03576d4d42a --- /dev/null +++ b/flang/test/Lower/common.f90 @@ -0,0 +1,31 @@ +! RUN: bbc %s -o - | tco | FileCheck %s + +! CHECK: @_QB = common global [8 x i8] zeroinitializer +! CHECK: @_QBx = linkonce global { float, float } { float 1.0{{.*}}, float 2.0{{.*}} } +! CHECK: @_QBy = common global [12 x i8] zeroinitializer + +! CHECK-LABEL: _QPs0 +subroutine s0 + common // a0, b0 + + ! CHECK: call void @_QPs(float* bitcast ([8 x i8]* @_QB to float*), float* bitcast (i8* getelementptr inbounds ([8 x i8], [8 x i8]* @_QB, i32 0, i64 4) to float*)) + call s(a0, b0) +end subroutine s0 + + +! CHECK-LABEL: _QPs1 +subroutine s1 + common /x/ a1, b1 + data a1 /1.0/, b1 /2.0/ + + ! CHECK: call void @_QPs(float* getelementptr inbounds ({ float, float }, { float, float }* @_QBx, i32 0, i32 0), float* bitcast (i8* getelementptr (i8, i8* bitcast ({ float, float }* @_QBx to i8*), i64 4) to float*)) + call s(a1, b1) +end subroutine s1 + +! CHECK-LABEL: _QPs2 +subroutine s2 + common /y/ a2, b2, c2 + + ! CHECK: call void @_QPs(float* bitcast ([12 x i8]* @_QBy to float*), float* bitcast (i8* getelementptr inbounds ([12 x i8], [12 x i8]* @_QBy, i32 0, i64 4) to float*)) + call s(a2, b2) +end subroutine s2 From a4220f2dd27e64d46c79e97f7d8393f5b2fc5137 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 10 Jul 2020 10:36:40 -0700 Subject: [PATCH 0150/1017] take clang-format out of the equation wrt info.stepValue --- flang/lib/Lower/Bridge.cpp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index bd7bb98cfbfef..46a56d85915c3 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -789,11 +789,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { info.isStructured() ? builder->getIndexType() : info.loopVariableType; auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); auto upperValue = genFIRLoopIndex(info.upperExpr, type); + // clang-format off info.stepValue = info.stepExpr.has_value() ? genFIRLoopIndex(*info.stepExpr, type) : info.isStructured() ? builder->create(loc, 1) : builder->createIntegerConstant(loc, info.loopVariableType, 1); + // clang-format on assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(loc, *info.loopVariableSym); From 06179812b71948fd6db3f315308c65330196bae9 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 10 Jul 2020 10:33:19 -0700 Subject: [PATCH 0151/1017] add runtime call to pause --- flang/lib/Lower/IO.cpp | 2 -- flang/lib/Lower/Runtime.cpp | 55 ++++++++++++++++++------------------- 2 files changed, 27 insertions(+), 30 deletions(-) diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp index cca8561b81683..f81cc5503395c 100644 --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -24,8 +24,6 @@ using namespace Fortran::runtime::io; -#define NAMIFY_HELPER(X) #X -#define NAMIFY(X) NAMIFY_HELPER(IONAME(X)) #define mkIOKey(X) mkKey(IONAME(X)) namespace Fortran::lower { diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index 2dd74158362a3..098efdf44bac5 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -15,39 +15,37 @@ #include "flang/Semantics/tools.h" #include "llvm/ADT/SmallVector.h" -#define MakeRuntimeEntry(X) mkKey(RTNAME(X)) +#define mkRTKey(X) mkKey(RTNAME(X)) + +static constexpr std::tuple + newRTTable; + +template +static constexpr const char *getName() { + return std::get(newRTTable).name; +} + +template +static constexpr Fortran::lower::FuncTypeBuilderFunc getTypeModel() { + return std::get(newRTTable).getTypeModel(); +} template static mlir::FuncOp genRuntimeFunction(mlir::Location loc, Fortran::lower::FirOpBuilder &builder) { - auto func = builder.getNamedFunction(RuntimeEntry::name); + auto name = getName(); + auto func = builder.getNamedFunction(name); if (func) return func; - auto funTy = RuntimeEntry::getTypeModel()(builder.getContext()); - func = builder.createFunction(loc, RuntimeEntry::name, funTy); + auto funTy = getTypeModel()(builder.getContext()); + func = builder.createFunction(loc, name, funTy); func.setAttr("fir.runtime", builder.getUnitAttr()); return func; } -static mlir::FuncOp -genStopStatementRuntime(mlir::Location loc, - Fortran::lower::FirOpBuilder &builder) { - return genRuntimeFunction(loc, builder); -} - -static mlir::FuncOp -genStopStatementTextRuntime(mlir::Location loc, - Fortran::lower::FirOpBuilder &builder) { - return genRuntimeFunction(loc, builder); -} - -static mlir::FuncOp -genProgramEndStatementRuntime(mlir::Location loc, - Fortran::lower::FirOpBuilder &builder) { - return genRuntimeFunction(loc, - builder); -} - // TODO: We don't have runtime library support for various features. When they // are encountered, we emit an error message and exit immediately. static void noRuntimeSupport(mlir::Location loc, llvm::StringRef stmt) { @@ -65,7 +63,7 @@ void Fortran::lower::genStopStatement( const Fortran::parser::StopStmt &stmt) { auto &builder = converter.getFirOpBuilder(); auto loc = converter.getCurrentLocation(); - auto callee = genStopStatementRuntime(loc, builder); + auto callee = genRuntimeFunction(loc, builder); auto calleeType = callee.getType(); llvm::SmallVector operands; assert(calleeType.getNumInputs() == 3 && @@ -111,8 +109,7 @@ void Fortran::lower::genFailImageStatement( Fortran::lower::AbstractConverter &converter) { auto &bldr = converter.getFirOpBuilder(); auto loc = converter.getCurrentLocation(); - auto callee = - genRuntimeFunction(loc, bldr); + auto callee = genRuntimeFunction(loc, bldr); bldr.create(loc, callee, llvm::None); } @@ -175,6 +172,8 @@ void Fortran::lower::genSyncTeamStatement( void Fortran::lower::genPauseStatement( Fortran::lower::AbstractConverter &converter, const Fortran::parser::PauseStmt &) { - // FIXME: There is no runtime call to make for this yet. - noRuntimeSupport(converter.getCurrentLocation(), "PAUSE"); + auto &bldr = converter.getFirOpBuilder(); + auto loc = converter.getCurrentLocation(); + auto callee = genRuntimeFunction(loc, bldr); + bldr.create(loc, callee, llvm::None); } From 2a5e78bfc1ae11af339bc1df699ec32e4566f759 Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Tue, 7 Jul 2020 19:09:44 +0530 Subject: [PATCH 0152/1017] [flang] Implement genBuffer. fix for #222 Review comments addressed. add test case. --- flang/lib/Lower/IO.cpp | 23 +++++++++++++++++++---- flang/test/Lower/read-write-buffer.f90 | 16 ++++++++++++++++ 2 files changed, 35 insertions(+), 4 deletions(-) create mode 100644 flang/test/Lower/read-write-buffer.f90 diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp index f81cc5503395c..9eeaa37ab1d67 100644 --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -963,15 +963,30 @@ getFormat( strTy, lenTy, labelMap, assignMap); } -static std::tuple +/// Generate a reference to a buffer and the length of buffer.There are 3 cases +/// An IoUnit can be variable, a ScalarIntExpr (i.e FileUnitNumber) or a *. +/// The first is handled here, rest 2 are somewhere else. +static std::tuple genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, const Fortran::parser::IoUnit &iounit, mlir::Type strTy, mlir::Type lenTy) { - [[maybe_unused]] auto &var = std::get(iounit.u); - TODO(); + // Variable + auto *var = std::get_if(&iounit.u); + assert(var && "Has to be a variable"); + auto e = Fortran::semantics::GetExpr(*var); + auto &builder = converter.getFirOpBuilder(); + if (Fortran::semantics::ExprHasTypeCategory( + *e, Fortran::common::TypeCategory::Character)) { + // Helper to query [BUFFER, LEN]. + Fortran::lower::CharacterExprHelper helper(builder, loc); + auto dataLen = helper.materializeCharacter(converter.genExprValue(*e)); + auto buff = builder.createConvert(loc, strTy, dataLen.first); + auto len = builder.createConvert(loc, lenTy, dataLen.second); + return {buff, len}; + } } template -std::tuple +std::tuple getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, const A &stmt, mlir::Type strTy, mlir::Type lenTy) { if (stmt.iounit) diff --git a/flang/test/Lower/read-write-buffer.f90 b/flang/test/Lower/read-write-buffer.f90 new file mode 100644 index 0000000000000..296c2158909d1 --- /dev/null +++ b/flang/test/Lower/read-write-buffer.f90 @@ -0,0 +1,16 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s +! A test to check the buffer and it's length. + +! CHECK-LABEL: @_QPsome +subroutine some() + character(LEN=255):: buffer + character(LEN=255):: greeting +10 format (A255) + ! CHECK: fir.address_of(@{{.*}}) : + write (buffer, 10) "compiler" + read (buffer, 10) greeting +end +! CHECK-LABEL: fir.global @_QQcl.636F6D70696C6572 +! CHECK: %[[lit:.*]] = fir.string_lit "compiler"(8) : !fir.char<1> +! CHECK: fir.has_value %[[lit]] : !fir.array<8x!fir.char<1>> +! CHECK: } From 06b88b45efa6bf5a159c6a9d130997fa03a810c5 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 10 Jul 2020 11:07:57 -0700 Subject: [PATCH 0153/1017] get rid of warnings --- flang/lib/Lower/IO.cpp | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp index 9eeaa37ab1d67..728a35eba7278 100644 --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -975,16 +975,16 @@ genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, assert(var && "Has to be a variable"); auto e = Fortran::semantics::GetExpr(*var); auto &builder = converter.getFirOpBuilder(); - if (Fortran::semantics::ExprHasTypeCategory( - *e, Fortran::common::TypeCategory::Character)) { - // Helper to query [BUFFER, LEN]. - Fortran::lower::CharacterExprHelper helper(builder, loc); - auto dataLen = helper.materializeCharacter(converter.genExprValue(*e)); - auto buff = builder.createConvert(loc, strTy, dataLen.first); - auto len = builder.createConvert(loc, lenTy, dataLen.second); - return {buff, len}; - } + assert(Fortran::semantics::ExprHasTypeCategory( + *e, Fortran::common::TypeCategory::Character)); + // Helper to query [BUFFER, LEN]. + Fortran::lower::CharacterExprHelper helper(builder, loc); + auto dataLen = helper.materializeCharacter(converter.genExprValue(*e)); + auto buff = builder.createConvert(loc, strTy, dataLen.first); + auto len = builder.createConvert(loc, lenTy, dataLen.second); + return {buff, len}; } + template std::tuple getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, From 9e1acc67734606d8256b931dbd92c851e60ead2d Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 10 Jul 2020 11:10:59 -0700 Subject: [PATCH 0154/1017] edit a comment --- flang/lib/Lower/IO.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp index 728a35eba7278..31701d92d85aa 100644 --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -964,8 +964,8 @@ getFormat( } /// Generate a reference to a buffer and the length of buffer.There are 3 cases -/// An IoUnit can be variable, a ScalarIntExpr (i.e FileUnitNumber) or a *. -/// The first is handled here, rest 2 are somewhere else. +/// An IoUnit can be variable, a ScalarIntExpr (i.e FileUnitNumber) or a *. The +/// first is handled here, the other 2 are somewhere else. static std::tuple genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, const Fortran::parser::IoUnit &iounit, mlir::Type strTy, From 11b1ded524b177587438e1646d9662be2f113f11 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 10 Jul 2020 13:54:40 -0700 Subject: [PATCH 0155/1017] refactoring to allow hash consing of string literals --- flang/include/flang/Lower/ConvertExpr.h | 32 +++++++++++++++++++++---- 1 file changed, 27 insertions(+), 5 deletions(-) diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h index c441b32b42b78..fb4c1eed8e0f7 100644 --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -14,10 +14,11 @@ /// //===----------------------------------------------------------------------===// -#ifndef FORTRAN_LOWER_CONVERT_EXPR_H -#define FORTRAN_LOWER_CONVERT_EXPR_H +#ifndef FORTRAN_LOWER_CONVERTEXPR_H +#define FORTRAN_LOWER_CONVERTEXPR_H #include "flang/Lower/Support/BoxValue.h" +#include namespace mlir { class Location; @@ -51,6 +52,21 @@ class AbstractConverter; class FirOpBuilder; class SymMap; +/// The evaluation of some expressions implies a surrounding context. This +/// context is abstracted by this class. +class ExpressionContext { +public: + ExpressionContext() = default; + ExpressionContext(llvm::ArrayRef lcvs) + : loopVars{lcvs.begin(), lcvs.end()} {} + + bool inArrayContext() const { return loopVars.size() > 0; } + const std::vector &getLoopVars() const { return loopVars; } + +private: + std::vector loopVars{}; +}; + /// Create an expression. /// Lowers `expr` to the FIR dialect of MLIR. The expression is lowered to a /// value result. @@ -63,7 +79,7 @@ mlir::Value createSomeExpression(mlir::Location loc, fir::ExtendedValue createSomeExtendedExpression(mlir::Location loc, AbstractConverter &converter, const evaluate::Expr &expr, - SymMap &symMap, llvm::ArrayRef lcvs); + SymMap &symMap, const ExpressionContext &context); /// Create an address. /// Lowers `expr` to the FIR dialect of MLIR. The expression must be an entity @@ -76,9 +92,15 @@ mlir::Value createSomeAddress(mlir::Location loc, AbstractConverter &converter, fir::ExtendedValue createSomeExtendedAddress(mlir::Location loc, AbstractConverter &converter, const evaluate::Expr &expr, - SymMap &symMap, llvm::ArrayRef lcvs); + SymMap &symMap, const ExpressionContext &context); + +/// Create a string literal. Lowers `str` to the MLIR representation of a +/// literal CHARACTER value. (KIND is assumed to be 1.) +fir::ExtendedValue createStringLiteral(mlir::Location loc, + AbstractConverter &converter, + llvm::StringRef str, std::uint64_t len); } // namespace lower } // namespace Fortran -#endif // FORTRAN_LOWER_CONVERT_EXPR_H +#endif // FORTRAN_LOWER_CONVERTEXPR_H From 2a4288e819011eb7ae7dd01a6115fc052de5dfac Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 10 Jul 2020 16:12:18 -0700 Subject: [PATCH 0156/1017] add dump for improved debugging experience --- flang/include/flang/Semantics/symbol.h | 1 + 1 file changed, 1 insertion(+) diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index 309a1558480a0..600a10ec362b8 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -653,6 +653,7 @@ class Symbol { const DerivedTypeSpec *GetParentTypeSpec(const Scope * = nullptr) const; SemanticsContext &GetSemanticsContext() const; + LLVM_DUMP_METHOD void dump() { llvm::errs() << *this << '\n'; } private: const Scope *owner_; From 2a8b64c1cae3d2354134133a395dc12738f43577 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 10 Jul 2020 16:14:37 -0700 Subject: [PATCH 0157/1017] handle flushing of local map --- flang/lib/Lower/Bridge.cpp | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 46a56d85915c3..ecbe4a96863f6 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1963,14 +1963,18 @@ class FirConverter : public Fortran::lower::AbstractConverter { void instantiateCommon(const Fortran::semantics::Symbol &common, const Fortran::lower::pft::Variable &var) { auto commonName = mangleName(common); - if (!builder->getNamedGlobal(commonName)) { - Fortran::lower::pft::Variable commonVar{common, true}; - instantiateGlobal(commonVar); - } + auto global = builder->getNamedGlobal(commonName); + if (!global) + instantiateGlobal(Fortran::lower::pft::Variable{common, true}); auto commonAddr = lookupSymbol(common); const auto &varSym = var.getSymbol(); - auto byteOffset = varSym.offset(); auto loc = genLocation(varSym.name()); + if (!commonAddr) { + commonAddr = builder->create(loc, global.resultType(), + global.getSymbol()); + addSymbol(common, commonAddr); + } + auto byteOffset = varSym.offset(); auto i8Ptr = fir::ReferenceType::get(builder->getIntegerType(8)); auto base = builder->createConvert(loc, i8Ptr, commonAddr); llvm::SmallVector offs{builder->createIntegerConstant( From 19c4f6588d6f5a4c28b592d90ae808be22442158 Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Sat, 11 Jul 2020 13:12:20 +0530 Subject: [PATCH 0158/1017] Fix for #177. Use createStringLiteral from PR #259. --- flang/lib/Lower/IO.cpp | 1185 +++++++++++++------- flang/test/Lower/global-format-strings.f90 | 14 + 2 files changed, 785 insertions(+), 414 deletions(-) create mode 100644 flang/test/Lower/global-format-strings.f90 diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp index 31701d92d85aa..3bba5381dfb26 100644 --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -5,22 +5,31 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #include "flang/Lower/IO.h" #include "../../runtime/io-api.h" #include "RTBuilder.h" +#include "StatementContext.h" #include "flang/Lower/Bridge.h" #include "flang/Lower/CharacterExpr.h" #include "flang/Lower/ComplexExpr.h" +#include "flang/Lower/ConvertExpr.h" #include "flang/Lower/FIRBuilder.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" -#include "flang/Lower/Utils.h" +#include "flang/Lower/Support/Utils.h" +#include "flang/Lower/Todo.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/tools.h" #include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "llvm/Support/Debug.h" -#define TODO() llvm_unreachable("not yet implemented") +#define DEBUG_TYPE "flang-lower-io" using namespace Fortran::runtime::io; @@ -53,20 +62,25 @@ static constexpr std::tuple< mkIOKey(OutputUnformattedBlock), mkIOKey(InputUnformattedBlock), mkIOKey(OutputInteger64), mkIOKey(InputInteger), mkIOKey(OutputReal32), mkIOKey(InputReal32), mkIOKey(OutputReal64), mkIOKey(InputReal64), - mkIOKey(OutputComplex64), mkIOKey(OutputComplex32), mkIOKey(OutputAscii), - mkIOKey(InputAscii), mkIOKey(OutputLogical), mkIOKey(InputLogical), - mkIOKey(SetAccess), mkIOKey(SetAction), mkIOKey(SetAsynchronous), - mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding), mkIOKey(SetForm), - mkIOKey(SetPosition), mkIOKey(SetRecl), mkIOKey(SetStatus), - mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize), - mkIOKey(GetIoLength), mkIOKey(GetIoMsg), mkIOKey(InquireCharacter), - mkIOKey(InquireLogical), mkIOKey(InquirePendingId), - mkIOKey(InquireInteger64), mkIOKey(EndIoStatement)> + mkIOKey(OutputComplex32), mkIOKey(InputComplex32), mkIOKey(OutputComplex64), + mkIOKey(InputComplex64), mkIOKey(OutputAscii), mkIOKey(InputAscii), + mkIOKey(OutputLogical), mkIOKey(InputLogical), mkIOKey(SetAccess), + mkIOKey(SetAction), mkIOKey(SetAsynchronous), mkIOKey(SetCarriagecontrol), + mkIOKey(SetEncoding), mkIOKey(SetForm), mkIOKey(SetPosition), + mkIOKey(SetRecl), mkIOKey(SetStatus), mkIOKey(SetFile), mkIOKey(GetNewUnit), + mkIOKey(GetSize), mkIOKey(GetIoLength), mkIOKey(GetIoMsg), + mkIOKey(InquireCharacter), mkIOKey(InquireLogical), + mkIOKey(InquirePendingId), mkIOKey(InquireInteger64), + mkIOKey(EndIoStatement)> newIOTable; } // namespace Fortran::lower namespace { -struct ConditionSpecifierInfo { +/// Fortran IO statements may have optional handling of exceptional conditions +/// which can change the control-flow of the program, etc. For example, +/// ERR=(newIOTable).name; + return std::get(Fortran::lower::newIOTable).name; } /// Helper function to retrieve the type model signature builder of the IO /// function as defined by the key `A` template -static constexpr FuncTypeBuilderFunc getTypeModel() { - return std::get(newIOTable).getTypeModel(); +static constexpr Fortran::lower::FuncTypeBuilderFunc getTypeModel() { + return std::get(Fortran::lower::newIOTable).getTypeModel(); } inline int64_t getLength(mlir::Type argTy) { @@ -128,32 +145,32 @@ static mlir::FuncOp getIORuntimeFunc(mlir::Location loc, /// It is the caller's responsibility to generate branches on that value. static mlir::Value genEndIO(Fortran::lower::AbstractConverter &converter, mlir::Location loc, mlir::Value cookie, - const ConditionSpecifierInfo &csi) { + const ConditionSpecInfo &csi, + Fortran::lower::StatementContext &stmtCtx) { auto &builder = converter.getFirOpBuilder(); if (csi.ioMsgExpr) { auto getIoMsg = getIORuntimeFunc(loc, builder); - auto ioMsgVar = - Fortran::lower::CharacterExprHelper{builder, loc}.createUnboxChar( - converter.genExprAddr(csi.ioMsgExpr, loc)); - llvm::SmallVector args{ - cookie, - builder.createConvert(loc, getIoMsg.getType().getInput(1), - ioMsgVar.first), - builder.createConvert(loc, getIoMsg.getType().getInput(2), - ioMsgVar.second)}; - builder.create(loc, getIoMsg, args); + auto ioMsgVar = converter.genExprAddr(csi.ioMsgExpr, stmtCtx, loc); + builder.create( + loc, getIoMsg, + mlir::ValueRange{ + cookie, + builder.createConvert(loc, getIoMsg.getType().getInput(1), + fir::getBase(ioMsgVar)), + builder.createConvert(loc, getIoMsg.getType().getInput(2), + fir::getLen(ioMsgVar))}); } auto endIoStatement = getIORuntimeFunc(loc, builder); - llvm::SmallVector endArgs{cookie}; - auto call = builder.create(loc, endIoStatement, endArgs); + auto call = builder.create(loc, endIoStatement, + mlir::ValueRange{cookie}); if (csi.ioStatExpr) { - auto ioStatVar = converter.genExprAddr(csi.ioStatExpr, loc); + auto ioStatVar = + fir::getBase(converter.genExprAddr(csi.ioStatExpr, stmtCtx, loc)); auto ioStatResult = builder.createConvert( loc, converter.genType(*csi.ioStatExpr), call.getResult(0)); builder.create(loc, ioStatResult, ioStatVar); } - return csi.hasTransferConditionSpecifier() ? call.getResult(0) - : mlir::Value{}; + return csi.hasTransferConditionSpec() ? call.getResult(0) : mlir::Value{}; } /// Make the next call in the IO statement conditional on runtime result `ok`. @@ -167,29 +184,28 @@ static void makeNextConditionalOn(Fortran::lower::FirOpBuilder &builder, bool inIterWhileLoop = false) { if (!checkResult || !ok) // Either I/O calls do not need to be checked, or the next I/O call is the - // first potentially fallable call. + // first potentially erroneous call. return; + // A previous I/O call for a statement returned the bool `ok`. If this call // is in a fir.iterate_while loop, the result must be propagated up to the // loop scope. That is done in genIoLoop, but it is enabled here. - auto whereOp = - inIterWhileLoop - ? builder.create(loc, builder.getI1Type(), ok, true) - : builder.create(loc, ok, /*withOtherwise=*/false); + mlir::TypeRange resTys; + if (inIterWhileLoop) + resTys = builder.getI1Type(); + auto ifOp = builder.create(loc, resTys, ok, + /*withElseRegion=*/inIterWhileLoop); if (!insertPt.isSet()) insertPt = builder.saveInsertionPoint(); - builder.setInsertionPointToStart(&whereOp.thenRegion().front()); + builder.setInsertionPointToStart(&ifOp.thenRegion().front()); } -template -static void genIoLoop(Fortran::lower::AbstractConverter &converter, - mlir::Value cookie, const D &ioImpliedDo, - bool checkResult, mlir::Value &ok, bool inIterWhileLoop); - /// Get the OutputXyz routine to output a value of the given type. static mlir::FuncOp getOutputFunc(mlir::Location loc, Fortran::lower::FirOpBuilder &builder, - mlir::Type type) { + mlir::Type type, bool isFormatted) { + if (!isFormatted) + return getIORuntimeFunc(loc, builder); if (auto ty = type.dyn_cast()) return ty.getWidth() == 1 ? getIORuntimeFunc(loc, builder) @@ -206,9 +222,14 @@ static mlir::FuncOp getOutputFunc(mlir::Location loc, return getIORuntimeFunc(loc, builder); if (type.isa()) return getIORuntimeFunc(loc, builder); - if (Fortran::lower::CharacterExprHelper::isCharacter(type)) + if (Fortran::lower::CharacterExprHelper::isCharacterScalar(type)) return getIORuntimeFunc(loc, builder); - // TODO: handle arrays + // Use descriptors for arrays + if (auto refTy = type.dyn_cast()) + type = refTy.getEleTy(); + if (type.isa()) + return getIORuntimeFunc(loc, builder); + // Any unaccounted for types are to be handled here. mlir::emitError(loc, "output for entity type ") << type << " not implemented"; return {}; } @@ -218,42 +239,64 @@ static void genOutputItemList(Fortran::lower::AbstractConverter &converter, mlir::Value cookie, const std::list &items, - mlir::OpBuilder::InsertPoint &insertPt, bool checkResult, - mlir::Value &ok, bool inIterWhileLoop) { + mlir::OpBuilder::InsertPoint &insertPt, bool isFormatted, + bool checkResult, mlir::Value &ok, bool inIterWhileLoop, + Fortran::lower::StatementContext &stmtCtx) { auto &builder = converter.getFirOpBuilder(); for (auto &item : items) { if (const auto &impliedDo = std::get_if<1>(&item.u)) { - genIoLoop(converter, cookie, impliedDo->value(), checkResult, ok, - inIterWhileLoop); + genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult, + ok, inIterWhileLoop, stmtCtx); continue; } auto &pExpr = std::get(item.u); auto loc = converter.genLocation(pExpr.source); makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, inIterWhileLoop); - auto itemValue = - converter.genExprValue(Fortran::semantics::GetExpr(pExpr), loc); - auto itemType = itemValue.getType(); - auto outputFunc = getOutputFunc(loc, builder, itemType); + + const auto *expr = Fortran::semantics::GetExpr(pExpr); + if (!expr) { + mlir::emitError(loc, + "Lowering internal error: could not get evaluate::Expr"); + break; + } + auto itemTy = converter.genType(*expr); + auto outputFunc = getOutputFunc(loc, builder, itemTy, isFormatted); auto argType = outputFunc.getType().getInput(1); + assert((isFormatted || argType.isa()) && + "expect descriptor for unformatted IO runtime"); llvm::SmallVector outputFuncArgs = {cookie}; Fortran::lower::CharacterExprHelper helper{builder, loc}; - if (helper.isCharacter(itemType)) { - auto dataLen = helper.materializeCharacter(itemValue); + if (argType.isa()) { + auto exv = converter.genExprAddr(expr, stmtCtx, loc); + auto box = builder.createBox(loc, exv); + outputFuncArgs.push_back(builder.createConvert(loc, argType, box)); + } else if (helper.isCharacterScalar(itemTy)) { + auto exv = converter.genExprAddr(expr, stmtCtx, loc); + // scalar allocatable/pointer may also get here, not clear if + // genExprAddr will lower them as CharBoxValue or BoxValue. + if (!exv.getCharBox()) + llvm::report_fatal_error( + "internal IO lowering: scalar character not in CharBox"); outputFuncArgs.push_back(builder.createConvert( - loc, outputFunc.getType().getInput(1), dataLen.first)); + loc, outputFunc.getType().getInput(1), fir::getBase(exv))); outputFuncArgs.push_back(builder.createConvert( - loc, outputFunc.getType().getInput(2), dataLen.second)); - } else if (fir::isa_complex(itemType)) { - auto parts = Fortran::lower::ComplexExprHelper{builder, loc}.extractParts( - itemValue); - outputFuncArgs.push_back(parts.first); - outputFuncArgs.push_back(parts.second); + loc, outputFunc.getType().getInput(2), fir::getLen(exv))); } else { - itemValue = builder.createConvert(loc, argType, itemValue); - outputFuncArgs.push_back(itemValue); + auto itemBox = converter.genExprValue(expr, stmtCtx, loc); + auto itemValue = fir::getBase(itemBox); + if (fir::isa_complex(itemTy)) { + auto parts = + Fortran::lower::ComplexExprHelper{builder, loc}.extractParts( + itemValue); + outputFuncArgs.push_back(parts.first); + outputFuncArgs.push_back(parts.second); + } else { + itemValue = builder.createConvert(loc, argType, itemValue); + outputFuncArgs.push_back(itemValue); + } } - ok = builder.create(loc, outputFunc, outputFuncArgs) + ok = builder.create(loc, outputFunc, outputFuncArgs) .getResult(0); } } @@ -261,7 +304,9 @@ genOutputItemList(Fortran::lower::AbstractConverter &converter, /// Get the InputXyz routine to input a value of the given type. static mlir::FuncOp getInputFunc(mlir::Location loc, Fortran::lower::FirOpBuilder &builder, - mlir::Type type) { + mlir::Type type, bool isFormatted) { + if (!isFormatted) + return getIORuntimeFunc(loc, builder); if (auto ty = type.dyn_cast()) return ty.getWidth() == 1 ? getIORuntimeFunc(loc, builder) @@ -272,15 +317,17 @@ static mlir::FuncOp getInputFunc(mlir::Location loc, : getIORuntimeFunc(loc, builder); if (auto ty = type.dyn_cast()) return ty.getFKind() <= 4 - ? getIORuntimeFunc(loc, builder) - : getIORuntimeFunc(loc, builder); + ? getIORuntimeFunc(loc, builder) + : getIORuntimeFunc(loc, builder); if (type.isa()) return getIORuntimeFunc(loc, builder); if (type.isa()) return getIORuntimeFunc(loc, builder); - if (Fortran::lower::CharacterExprHelper::isCharacter(type)) + if (Fortran::lower::CharacterExprHelper::isCharacterScalar(type)) return getIORuntimeFunc(loc, builder); - // TODO: handle arrays + if (type.isa()) + return getIORuntimeFunc(loc, builder); + // Any unaccounted for types are to be handled here. mlir::emitError(loc, "input for entity type ") << type << " not implemented"; return {}; } @@ -290,60 +337,49 @@ static void genInputItemList(Fortran::lower::AbstractConverter &converter, mlir::Value cookie, const std::list &items, mlir::OpBuilder::InsertPoint &insertPt, - bool checkResult, mlir::Value &ok, - bool inIterWhileLoop) { + bool isFormatted, bool checkResult, + mlir::Value &ok, bool inIterWhileLoop, + Fortran::lower::StatementContext &stmtCtx) { auto &builder = converter.getFirOpBuilder(); for (auto &item : items) { if (const auto &impliedDo = std::get_if<1>(&item.u)) { - genIoLoop(converter, cookie, impliedDo->value(), checkResult, ok, - inIterWhileLoop); + genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult, + ok, inIterWhileLoop, stmtCtx); continue; } auto &pVar = std::get(item.u); auto loc = converter.genLocation(pVar.GetSource()); makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, inIterWhileLoop); - auto itemAddr = - converter.genExprAddr(Fortran::semantics::GetExpr(pVar), loc); - auto itemType = itemAddr.getType().cast().getEleTy(); - auto inputFunc = getInputFunc(loc, builder, itemType); + Fortran::lower::CharacterExprHelper charHelper{builder, loc}; + auto itemBox = + converter.genExprAddr(Fortran::semantics::GetExpr(pVar), stmtCtx, loc); + auto itemAddr = fir::getBase(itemBox); + auto itemTy = fir::dyn_cast_ptrEleTy(itemAddr.getType()); + if (!itemTy) { + mlir::emitError(loc, "internal: unhandled input item type ") + << itemAddr.getType(); + return; + } + auto inputFunc = getInputFunc(loc, builder, itemTy, isFormatted); auto argType = inputFunc.getType().getInput(1); - auto originalItemAddr = itemAddr; - mlir::Type complexPartType; - if (itemType.isa()) - complexPartType = builder.getRefType( - Fortran::lower::ComplexExprHelper{builder, loc}.getComplexPartType( - itemType)); - auto complexPartAddr = [&](int index) { - return builder.create( - loc, complexPartType, originalItemAddr, - llvm::SmallVector{builder.create( - loc, builder.getI32IntegerAttr(index))}); - }; - if (complexPartType) - itemAddr = complexPartAddr(0); // real part + if (argType.isa()) + itemAddr = builder.createBox(loc, itemBox); itemAddr = builder.createConvert(loc, argType, itemAddr); - llvm::SmallVector inputFuncArgs = {cookie, itemAddr}; - Fortran::lower::CharacterExprHelper helper{builder, loc}; - if (helper.isCharacter(itemType)) { - auto len = helper.materializeCharacter(originalItemAddr).second; + llvm::SmallVector inputFuncArgs = {cookie, itemAddr}; + if (argType.isa()) { + // do nothing + } else if (charHelper.isCharacterScalar(itemTy)) { + auto len = fir::getLen(itemBox); inputFuncArgs.push_back( builder.createConvert(loc, inputFunc.getType().getInput(2), len)); - } else if (itemType.isa()) { + } else if (itemTy.isa()) { inputFuncArgs.push_back(builder.create( loc, builder.getI32IntegerAttr( - itemType.cast().getWidth() / 8))); - } - ok = builder.create(loc, inputFunc, inputFuncArgs) - .getResult(0); - if (complexPartType) { // imaginary part - makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, - inIterWhileLoop); - inputFuncArgs = {cookie, - builder.createConvert(loc, argType, complexPartAddr(1))}; - ok = builder.create(loc, inputFunc, inputFuncArgs) - .getResult(0); + itemTy.cast().getWidth() / 8))); } + ok = + builder.create(loc, inputFunc, inputFuncArgs).getResult(0); } } @@ -351,53 +387,62 @@ static void genInputItemList(Fortran::lower::AbstractConverter &converter, template static void genIoLoop(Fortran::lower::AbstractConverter &converter, mlir::Value cookie, const D &ioImpliedDo, - bool checkResult, mlir::Value &ok, bool inIterWhileLoop) { + bool isFormatted, bool checkResult, mlir::Value &ok, + bool inIterWhileLoop, + Fortran::lower::StatementContext &stmtCtx) { mlir::OpBuilder::InsertPoint insertPt; auto &builder = converter.getFirOpBuilder(); auto loc = converter.getCurrentLocation(); makeNextConditionalOn(builder, loc, insertPt, checkResult, ok, inIterWhileLoop); - auto parentInsertPt = builder.saveInsertionPoint(); const auto &itemList = std::get<0>(ioImpliedDo.t); const auto &control = std::get<1>(ioImpliedDo.t); const auto &loopSym = *control.name.thing.thing.symbol; auto loopVar = converter.getSymbolAddress(loopSym); - auto genFIRLoopIndex = [&](const Fortran::parser::ScalarIntExpr &expr) { - return builder.createConvert( - loc, builder.getIndexType(), - converter.genExprValue(*Fortran::semantics::GetExpr(expr))); + auto genControlValue = [&](const Fortran::parser::ScalarIntExpr &expr) { + auto v = fir::getBase( + converter.genExprValue(*Fortran::semantics::GetExpr(expr), stmtCtx)); + return builder.createConvert(loc, builder.getIndexType(), v); }; - auto lowerValue = genFIRLoopIndex(control.lower); - auto upperValue = genFIRLoopIndex(control.upper); + auto lowerValue = genControlValue(control.lower); + auto upperValue = genControlValue(control.upper); auto stepValue = control.step.has_value() - ? genFIRLoopIndex(*control.step) + ? genControlValue(*control.step) : builder.create(loc, 1); - auto genItemList = [&](const D &ioImpliedDo, bool inIterWhileLoop) { + auto genItemList = [&](const D &ioImpliedDo) { if constexpr (std::is_same_v) - genInputItemList(converter, cookie, itemList, insertPt, checkResult, ok, - true); + genInputItemList(converter, cookie, itemList, insertPt, isFormatted, + checkResult, ok, /*inIterWhile=*/true, stmtCtx); else - genOutputItemList(converter, cookie, itemList, insertPt, checkResult, ok, - true); + genOutputItemList(converter, cookie, itemList, insertPt, isFormatted, + checkResult, ok, /*inIterWhile=*/true, stmtCtx); }; if (!checkResult) { // No I/O call result checks - the loop is a fir.do_loop op. - auto loopOp = - builder.create(loc, lowerValue, upperValue, stepValue); - builder.setInsertionPointToStart(loopOp.getBody()); + auto doLoopOp = builder.create( + loc, lowerValue, upperValue, stepValue, /*unordered=*/false, + /*finalCountValue=*/true); + builder.setInsertionPointToStart(doLoopOp.getBody()); auto lcv = builder.createConvert(loc, converter.genType(loopSym), - loopOp.getInductionVar()); + doLoopOp.getInductionVar()); + builder.create(loc, lcv, loopVar); + genItemList(ioImpliedDo); + builder.setInsertionPointToEnd(doLoopOp.getBody()); + mlir::Value result = builder.create( + loc, doLoopOp.getInductionVar(), doLoopOp.step()); + builder.create(loc, result); + builder.setInsertionPointAfter(doLoopOp); + // The loop control variable may be used after the loop. + lcv = builder.createConvert(loc, converter.genType(loopSym), + doLoopOp.getResult(0)); builder.create(loc, lcv, loopVar); - insertPt = builder.saveInsertionPoint(); - genItemList(ioImpliedDo, false); - builder.restoreInsertionPoint(parentInsertPt); return; } // Check I/O call results - the loop is a fir.iterate_while op. if (!ok) ok = builder.createIntegerConstant(loc, builder.getI1Type(), 1); - fir::IterWhileOp iterWhileOp = builder.create( - loc, lowerValue, upperValue, stepValue, ok); + auto iterWhileOp = builder.create( + loc, lowerValue, upperValue, stepValue, ok, /*finalCountValue*/ true); builder.setInsertionPointToStart(iterWhileOp.getBody()); auto lcv = builder.createConvert(loc, converter.genType(loopSym), iterWhileOp.getInductionVar()); @@ -405,38 +450,49 @@ static void genIoLoop(Fortran::lower::AbstractConverter &converter, insertPt = builder.saveInsertionPoint(); ok = iterWhileOp.getIterateVar(); auto falseValue = builder.createIntegerConstant(loc, builder.getI1Type(), 0); - genItemList(ioImpliedDo, true); + genItemList(ioImpliedDo); // Unwind nested I/O call scopes, filling in true and false ResultOp's. for (auto *op = builder.getBlock()->getParentOp(); isa(op); op = op->getBlock()->getParentOp()) { - auto whereOp = dyn_cast(op); - auto *lastOp = &whereOp.thenRegion().front().back(); + auto ifOp = dyn_cast(op); + auto *lastOp = &ifOp.thenRegion().front().back(); builder.setInsertionPointAfter(lastOp); builder.create(loc, lastOp->getResult(0)); // runtime result - builder.setInsertionPointToStart(&whereOp.elseRegion().front()); + builder.setInsertionPointToStart(&ifOp.elseRegion().front()); builder.create(loc, falseValue); // known false result } - builder.restoreInsertionPoint(insertPt); - builder.create(loc, builder.getBlock()->back().getResult(0)); - ok = iterWhileOp.getResult(0); - builder.restoreInsertionPoint(parentInsertPt); + builder.setInsertionPointToEnd(iterWhileOp.getBody()); + auto iterateResult = builder.getBlock()->back().getResult(0); + auto inductionResult0 = iterWhileOp.getInductionVar(); + auto inductionResult1 = + builder.create(loc, inductionResult0, iterWhileOp.step()); + auto inductionResult = builder.create( + loc, iterateResult, inductionResult1, inductionResult0); + llvm::SmallVector results = {inductionResult, iterateResult}; + builder.create(loc, results); + ok = iterWhileOp.getResult(1); + builder.setInsertionPointAfter(iterWhileOp); + // The loop control variable may be used after the loop. + lcv = builder.createConvert(loc, converter.genType(loopSym), + iterWhileOp.getResult(0)); + builder.create(loc, lcv, loopVar); } //===----------------------------------------------------------------------===// // Default argument generation. //===----------------------------------------------------------------------===// -static mlir::Value getDefaultFilename(Fortran::lower::FirOpBuilder &builder, - mlir::Location loc, mlir::Type toType) { - mlir::Value null = - builder.create(loc, builder.getI64IntegerAttr(0)); - return builder.createConvert(loc, toType, null); +static mlir::Value locToFilename(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Type toType) { + auto &builder = converter.getFirOpBuilder(); + return builder.createConvert( + loc, toType, Fortran::lower::locationToFilename(builder, loc)); } -static mlir::Value getDefaultLineNo(Fortran::lower::FirOpBuilder &builder, - mlir::Location loc, mlir::Type toType) { - return builder.create(loc, - builder.getIntegerAttr(toType, 0)); +static mlir::Value locToLineNo(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Type toType) { + return Fortran::lower::locationToLineNo(converter.getFirOpBuilder(), loc, + toType); } static mlir::Value getDefaultScratch(Fortran::lower::FirOpBuilder &builder, @@ -452,6 +508,39 @@ static mlir::Value getDefaultScratchLen(Fortran::lower::FirOpBuilder &builder, builder.getIntegerAttr(toType, 0)); } +/// Generate a reference to a buffer and the length of buffer given +/// a character expression. Array expression will be cast to scalar +/// character as long as they are contiguous. +static std::tuple +genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::semantics::SomeExpr &expr, mlir::Type strTy, + mlir::Type lenTy, Fortran::lower::StatementContext &stmtCtx) { + auto &builder = converter.getFirOpBuilder(); + auto exprAddr = converter.genExprAddr(expr, stmtCtx); + Fortran::lower::CharacterExprHelper helper(builder, loc); + using ValuePair = std::pair; + auto [buff, len] = exprAddr.match( + [&](const fir::CharBoxValue &x) -> ValuePair { + return {x.getBuffer(), x.getLen()}; + }, + [&](const fir::CharArrayBoxValue &x) -> ValuePair { + auto scalar = helper.toScalarCharacter(x); + return {scalar.getBuffer(), scalar.getLen()}; + }, + [&](const fir::BoxValue &) -> ValuePair { + // May need to copy before after IO to handle contiguous + // aspect. Not sure descriptor can get here though. + TODO(loc, "character descriptor to contiguous buffer"); + }, + [&](const auto &) -> ValuePair { + llvm::report_fatal_error( + "lowering internal error: IO buffer is not a character"); + }); + buff = builder.createConvert(loc, strTy, buff); + len = builder.createConvert(loc, lenTy, len); + return {buff, len}; +} + /// Lower a string literal. Many arguments to the runtime are conveyed as /// Fortran CHARACTER literals. template @@ -461,18 +550,17 @@ lowerStringLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc, mlir::Type ty2 = {}) { auto &builder = converter.getFirOpBuilder(); auto *expr = Fortran::semantics::GetExpr(syntax); - auto str = converter.genExprValue(expr, loc); - Fortran::lower::CharacterExprHelper helper{builder, loc}; - auto dataLen = helper.materializeCharacter(str); - auto buff = builder.createConvert(loc, strTy, dataLen.first); - auto len = builder.createConvert(loc, lenTy, dataLen.second); + if (!expr) + mlir::emitError(loc, "internal: null semantic expr in IO lowering"); + Fortran::lower::StatementContext stmtCtx; + auto [buff, len] = genBuffer(converter, loc, *expr, strTy, lenTy, stmtCtx); + mlir::Value kind; if (ty2) { - auto kindVal = helper.getCharacterKind(str.getType()); - auto kind = builder.create( + auto kindVal = expr->GetType().value().kind(); + kind = builder.create( loc, builder.getIntegerAttr(ty2, kindVal)); - return {buff, len, kind}; } - return {buff, len, mlir::Value{}}; + return {buff, len, kind}; } /// Pass the body of the FORMAT statement in as if it were a CHARACTER literal @@ -485,13 +573,10 @@ lowerSourceTextAsStringLit(Fortran::lower::AbstractConverter &converter, text = text.drop_front(text.find('(')); text = text.take_front(text.rfind(')') + 1); auto &builder = converter.getFirOpBuilder(); - auto lit = builder.createStringLit( - loc, /*FIXME*/ fir::CharacterType::get(builder.getContext(), 1, 1), text); - auto data = - Fortran::lower::CharacterExprHelper{builder, loc}.materializeCharacter( - lit); - auto buff = builder.createConvert(loc, strTy, data.first); - auto len = builder.createConvert(loc, lenTy, data.second); + auto addrGlobalStringLit = + fir::getBase(Fortran::lower::createStringLiteral(builder, loc, text)); + auto buff = builder.createConvert(loc, strTy, addrGlobalStringLit); + auto len = builder.createIntegerConstant(loc, lenTy, text.size()); return {buff, len, mlir::Value{}}; } @@ -504,14 +589,16 @@ lowerSourceTextAsStringLit(Fortran::lower::AbstractConverter &converter, template mlir::Value genIntIOOption(Fortran::lower::AbstractConverter &converter, mlir::Location loc, mlir::Value cookie, + Fortran::lower::StatementContext &stmtCtx, const B &spec) { auto &builder = converter.getFirOpBuilder(); mlir::FuncOp ioFunc = getIORuntimeFunc(loc, builder); mlir::FunctionType ioFuncTy = ioFunc.getType(); - auto expr = converter.genExprValue(Fortran::semantics::GetExpr(spec.v), loc); + auto expr = fir::getBase(converter.genExprValue( + Fortran::semantics::GetExpr(spec.v), stmtCtx, loc)); auto val = builder.createConvert(loc, ioFuncTy.getInput(1), expr); llvm::SmallVector ioArgs = {cookie, val}; - return builder.create(loc, ioFunc, ioArgs).getResult(0); + return builder.create(loc, ioFunc, ioArgs).getResult(0); } /// Generic to build a string argument to the runtime. This passes a CHARACTER @@ -527,12 +614,14 @@ mlir::Value genCharIOOption(Fortran::lower::AbstractConverter &converter, ioFuncTy.getInput(2)); llvm::SmallVector ioArgs = {cookie, std::get<0>(tup), std::get<1>(tup)}; - return builder.create(loc, ioFunc, ioArgs).getResult(0); + return builder.create(loc, ioFunc, ioArgs).getResult(0); } template mlir::Value genIOOption(Fortran::lower::AbstractConverter &converter, - mlir::Location loc, mlir::Value cookie, const A &spec) { + mlir::Location loc, mlir::Value cookie, + Fortran::lower::StatementContext &stmtCtx, + const A &spec) { // default case: do nothing return {}; } @@ -540,22 +629,24 @@ mlir::Value genIOOption(Fortran::lower::AbstractConverter &converter, template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, const Fortran::parser::FileNameExpr &spec) { + mlir::Value cookie, Fortran::lower::StatementContext &stmtCtx, + const Fortran::parser::FileNameExpr &spec) { auto &builder = converter.getFirOpBuilder(); // has an extra KIND argument auto ioFunc = getIORuntimeFunc(loc, builder); mlir::FunctionType ioFuncTy = ioFunc.getType(); auto tup = lowerStringLit(converter, loc, spec, ioFuncTy.getInput(1), - ioFuncTy.getInput(2), ioFuncTy.getInput(3)); + ioFuncTy.getInput(2)); llvm::SmallVector ioArgs{cookie, std::get<0>(tup), - std::get<1>(tup), std::get<2>(tup)}; - return builder.create(loc, ioFunc, ioArgs).getResult(0); + std::get<1>(tup)}; + return builder.create(loc, ioFunc, ioArgs).getResult(0); } template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, const Fortran::parser::ConnectSpec::CharExpr &spec) { + mlir::Value cookie, Fortran::lower::StatementContext &stmtCtx, + const Fortran::parser::ConnectSpec::CharExpr &spec) { auto &builder = converter.getFirOpBuilder(); mlir::FuncOp ioFunc; switch (std::get(spec.t)) { @@ -599,9 +690,9 @@ mlir::Value genIOOption( ioFunc = getIORuntimeFunc(loc, builder); break; case Fortran::parser::ConnectSpec::CharExpr::Kind::Convert: - llvm_unreachable("CONVERT not part of the runtime::io interface"); + TODO(loc, "CONVERT not part of the runtime::io interface"); case Fortran::parser::ConnectSpec::CharExpr::Kind::Dispose: - llvm_unreachable("DISPOSE not part of the runtime::io interface"); + TODO(loc, "DISPOSE not part of the runtime::io interface"); } mlir::FunctionType ioFuncTy = ioFunc.getType(); auto tup = lowerStringLit( @@ -609,20 +700,23 @@ mlir::Value genIOOption( ioFuncTy.getInput(1), ioFuncTy.getInput(2)); llvm::SmallVector ioArgs = {cookie, std::get<0>(tup), std::get<1>(tup)}; - return builder.create(loc, ioFunc, ioArgs).getResult(0); + return builder.create(loc, ioFunc, ioArgs).getResult(0); } template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, const Fortran::parser::ConnectSpec::Recl &spec) { - return genIntIOOption(converter, loc, cookie, spec); + mlir::Value cookie, Fortran::lower::StatementContext &stmtCtx, + const Fortran::parser::ConnectSpec::Recl &spec) { + return genIntIOOption(converter, loc, cookie, stmtCtx, + spec); } template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, const Fortran::parser::StatusExpr &spec) { + mlir::Value cookie, Fortran::lower::StatementContext &stmtCtx, + const Fortran::parser::StatusExpr &spec) { return genCharIOOption(converter, loc, cookie, spec.v); } @@ -630,15 +724,16 @@ template <> mlir::Value genIOOption(Fortran::lower::AbstractConverter &converter, mlir::Location loc, mlir::Value cookie, + Fortran::lower::StatementContext &stmtCtx, const Fortran::parser::Name &spec) { - // namelist - llvm_unreachable("not implemented"); + TODO(loc, "namelist"); } template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, const Fortran::parser::IoControlSpec::CharExpr &spec) { + mlir::Value cookie, Fortran::lower::StatementContext &stmtCtx, + const Fortran::parser::IoControlSpec::CharExpr &spec) { auto &builder = converter.getFirOpBuilder(); mlir::FuncOp ioFunc; switch (std::get(spec.t)) { @@ -670,13 +765,13 @@ mlir::Value genIOOption( ioFuncTy.getInput(1), ioFuncTy.getInput(2)); llvm::SmallVector ioArgs = {cookie, std::get<0>(tup), std::get<1>(tup)}; - return builder.create(loc, ioFunc, ioArgs).getResult(0); + return builder.create(loc, ioFunc, ioArgs).getResult(0); } template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, + mlir::Value cookie, Fortran::lower::StatementContext &stmtCtx, const Fortran::parser::IoControlSpec::Asynchronous &spec) { return genCharIOOption(converter, loc, cookie, spec.v); @@ -685,21 +780,24 @@ mlir::Value genIOOption( template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, const Fortran::parser::IdVariable &spec) { - llvm_unreachable("asynchronous ID not implemented"); + mlir::Value cookie, Fortran::lower::StatementContext &stmtCtx, + const Fortran::parser::IdVariable &spec) { + TODO(loc, "asynchronous ID not implemented"); } template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, const Fortran::parser::IoControlSpec::Pos &spec) { - return genIntIOOption(converter, loc, cookie, spec); + mlir::Value cookie, Fortran::lower::StatementContext &stmtCtx, + const Fortran::parser::IoControlSpec::Pos &spec) { + return genIntIOOption(converter, loc, cookie, stmtCtx, spec); } template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, const Fortran::parser::IoControlSpec::Rec &spec) { - return genIntIOOption(converter, loc, cookie, spec); + mlir::Value cookie, Fortran::lower::StatementContext &stmtCtx, + const Fortran::parser::IoControlSpec::Rec &spec) { + return genIntIOOption(converter, loc, cookie, stmtCtx, spec); } //===----------------------------------------------------------------------===// @@ -725,7 +823,7 @@ static const Fortran::semantics::SomeExpr *getExpr(const A &stmt) { for (const auto &spec : stmt.v) if (auto *f = std::get_if(&spec.u)) return Fortran::semantics::GetExpr(f->v); - llvm_unreachable("must have a file unit"); + llvm::report_fatal_error("must have a file unit"); } /// For each specifier, build the appropriate call, threading the cookie, and @@ -735,32 +833,53 @@ template static mlir::OpBuilder::InsertPoint threadSpecs(Fortran::lower::AbstractConverter &converter, mlir::Location loc, mlir::Value cookie, const A &specList, bool checkResult, - mlir::Value &ok) { + mlir::Value &ok, Fortran::lower::StatementContext &stmtCtx) { auto &builder = converter.getFirOpBuilder(); mlir::OpBuilder::InsertPoint insertPt; for (const auto &spec : specList) { makeNextConditionalOn(builder, loc, insertPt, checkResult, ok); ok = std::visit(Fortran::common::visitors{[&](const auto &x) { - return genIOOption(converter, loc, cookie, x); + return genIOOption(converter, loc, cookie, stmtCtx, x); }}, spec.u); } return insertPt; } +/// Most I/O statements have some form of optional exception condition handling +/// for when there is a failure. There are 5 basic forms: ERR, EOR, END, IOSTAT, +/// and IOMSG. The first three cause control-flow to transfer to another +/// statement. The final two return information from the runtime, via a +/// variable, about the nature of I/O failure. Not all statements have all 5 +/// forms, but this handler will match the ones that do occur in the spec-list +/// of a particular statement. template static void genConditionHandlerCall(Fortran::lower::AbstractConverter &converter, mlir::Location loc, mlir::Value cookie, - const A &specList, ConditionSpecifierInfo &csi) { + const A &specList, ConditionSpecInfo &csi) { for (const auto &spec : specList) { std::visit( Fortran::common::visitors{ - [&](const Fortran::parser::StatVariable &msgVar) { - csi.ioStatExpr = Fortran::semantics::GetExpr(msgVar); + [&](const Fortran::parser::StatVariable &var) { + csi.ioStatExpr = Fortran::semantics::GetExpr(var); + }, + [&](const Fortran::parser::InquireSpec::IntVar &var) { + if (std::get(var.t) == + Fortran::parser::InquireSpec::IntVar::Kind::Iostat) + csi.ioStatExpr = Fortran::semantics::GetExpr( + std::get(var.t)); + }, + [&](const Fortran::parser::MsgVariable &var) { + csi.ioMsgExpr = Fortran::semantics::GetExpr(var); }, - [&](const Fortran::parser::MsgVariable &msgVar) { - csi.ioMsgExpr = Fortran::semantics::GetExpr(msgVar); + [&](const Fortran::parser::InquireSpec::CharVar &var) { + if (std::get( + var.t) == + Fortran::parser::InquireSpec::CharVar::Kind::Iomsg) + csi.ioMsgExpr = Fortran::semantics::GetExpr( + std::get( + var.t)); }, [&](const Fortran::parser::EndLabel &) { csi.hasEnd = true; }, [&](const Fortran::parser::EorLabel &) { csi.hasEor = true; }, @@ -768,7 +887,7 @@ genConditionHandlerCall(Fortran::lower::AbstractConverter &converter, [](const auto &) {}}, spec.u); } - if (!csi.hasAnyConditionSpecifier()) + if (!csi.hasAnyConditionSpec()) return; auto &builder = converter.getFirOpBuilder(); mlir::FuncOp enableHandlers = @@ -778,14 +897,14 @@ genConditionHandlerCall(Fortran::lower::AbstractConverter &converter, return builder.create( loc, builder.getIntegerAttr(boolType, specifierIsPresent)); }; - llvm::SmallVector ioArgs = { + llvm::SmallVector ioArgs = { cookie, boolValue(csi.ioStatExpr != nullptr), boolValue(csi.hasErr), boolValue(csi.hasEnd), boolValue(csi.hasEor), boolValue(csi.ioMsgExpr != nullptr)}; - builder.create(loc, enableHandlers, ioArgs); + builder.create(loc, enableHandlers, ioArgs); } //===----------------------------------------------------------------------===// @@ -859,27 +978,43 @@ constexpr bool isDataTransferInternal( return false; } -static bool hasNonDefaultCharKind(const Fortran::parser::Variable &var) { - // TODO - return false; +/// If the variable `var` is an array or of a KIND other than the default +/// (normally 1), then a descriptor is required by the runtime IO API. This +/// condition holds even in F77 sources. +static llvm::Optional getVariableBufferRequiredDescriptor( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::Variable &var, + Fortran::lower::StatementContext &stmtCtx) { + auto varBox = converter.genExprAddr(var.typedExpr->v.value(), stmtCtx); + auto defCharKind = converter.getKindMap().defaultCharacterKind(); + auto varAddr = fir::getBase(varBox); + if (Fortran::lower::CharacterExprHelper::getCharacterOrSequenceKind( + varAddr.getType()) != defCharKind) + return varBox; + if (Fortran::lower::CharacterExprHelper::isArray(varAddr.getType())) + return varBox; + return llvm::None; } template -static bool isDataTransferInternalNotDefaultKind(const A &stmt) { - // same as isDataTransferInternal, but the KIND of the expression is not the - // default KIND. +static llvm::Optional +getIfDataTransferInternalRequiresDescriptor( + Fortran::lower::AbstractConverter &converter, const A &stmt, + Fortran::lower::StatementContext &stmtCtx) { if (stmt.iounit.has_value()) if (auto *var = std::get_if(&stmt.iounit->u)) - return hasNonDefaultCharKind(*var); + return getVariableBufferRequiredDescriptor(converter, *var, stmtCtx); if (auto *unit = getIOControl(stmt)) if (auto *var = std::get_if(&unit->u)) - return hasNonDefaultCharKind(*var); - return false; + return getVariableBufferRequiredDescriptor(converter, *var, stmtCtx); + return llvm::None; } template <> -constexpr bool isDataTransferInternalNotDefaultKind( - const Fortran::parser::PrintStmt &) { - return false; +inline llvm::Optional +getIfDataTransferInternalRequiresDescriptor( + Fortran::lower::AbstractConverter &, const Fortran::parser::PrintStmt &, + Fortran::lower::StatementContext &) { + return llvm::None; } template @@ -887,7 +1022,7 @@ static bool isDataTransferAsynchronous(const A &stmt) { if (auto *asynch = getIOControl(stmt)) { // FIXME: should contain a string of YES or NO - llvm_unreachable("asynchronous transfers not implemented in runtime"); + TODO_NOLOC("asynchronous transfers not implemented in runtime"); } return false; } @@ -909,6 +1044,97 @@ constexpr bool isDataTransferNamelist( return false; } +/// Lowers a format statment that uses a assigned varible label reference as +/// a select operation to allow for run-time selection of the format statement. +static std::tuple +lowerReferenceAsStringSelect( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::evaluate::Expr &expr, + mlir::Type strTy, mlir::Type lenTy, + Fortran::lower::StatementContext &stmtCtx) { + // Possible optimization TODO: Instead of inlining a selectOp every time there + // is a variable reference to a format statement, a function with the selectOp + // could be generated to reduce code size. It is not clear if such an + // optimization would be deployed very often or improve the object code + // beyond, say, what GVN/GCM might produce. + + // Create the requisite blocks to inline a selectOp + auto &builder = converter.getFirOpBuilder(); + auto *startBlock = builder.getBlock(); + auto *endBlock = startBlock->splitBlock(builder.getInsertionPoint()); + auto *block = startBlock->splitBlock(builder.getInsertionPoint()); + builder.setInsertionPointToEnd(block); + + llvm::SmallVector indexList; + llvm::SmallVector blockList; + + auto symbol = GetLastSymbol(&expr); + Fortran::lower::pft::LabelSet labels; + [[maybe_unused]] auto foundLabelSet = + converter.lookupLabelSet(*symbol, labels); + assert(foundLabelSet && "Label not found in map"); + + for (auto label : labels) { + indexList.push_back(label); + auto *eval = converter.lookupLabel(label); + assert(eval && "Label is missing from the table"); + + auto text = toStringRef(eval->position); + mlir::Value stringRef; + mlir::Value stringLen; + if (eval->isA()) { + assert(text.find('(') != llvm::StringRef::npos && + "FORMAT is unexpectedly ill-formed"); + // This is a format statement, so extract the spec from the text. + auto stringLit = + lowerSourceTextAsStringLit(converter, loc, text, strTy, lenTy); + stringRef = std::get<0>(stringLit); + stringLen = std::get<1>(stringLit); + } else { + // This is not a format statement, so use null. + stringRef = builder.createConvert( + loc, strTy, + builder.createIntegerConstant(loc, builder.getIndexType(), 0)); + stringLen = builder.createIntegerConstant(loc, lenTy, 0); + } + + // Pass the format string reference and the string length out of the select + // statement + llvm::SmallVector args = {stringRef, stringLen}; + builder.create(loc, endBlock, args); + + // Add block to the list of cases and make a new one + blockList.push_back(block); + block = block->splitBlock(builder.getInsertionPoint()); + builder.setInsertionPointToEnd(block); + } + + // Create the unit case which should result in an error. + auto *unitBlock = block->splitBlock(builder.getInsertionPoint()); + builder.setInsertionPointToEnd(unitBlock); + + // Crash the program. + builder.create(loc); + + // Add unit case to the select statement + blockList.push_back(unitBlock); + + // Lower the selectOp + builder.setInsertionPointToEnd(startBlock); + auto label = fir::getBase(converter.genExprValue(&expr, stmtCtx, loc)); + builder.create(loc, label, indexList, blockList); + + builder.setInsertionPointToEnd(endBlock); + endBlock->addArgument(strTy); + endBlock->addArgument(lenTy); + + // Handle and return the string reference and length selected by the selectOp + auto buff = endBlock->getArgument(0); + auto len = endBlock->getArgument(1); + + return {buff, len, mlir::Value{}}; +} + /// Generate a reference to a format string. There are four cases - a format /// statement label, a character format expression, an integer that holds the /// label of a format statement, and the * case. The first three are done here. @@ -916,14 +1142,13 @@ constexpr bool isDataTransferNamelist( static std::tuple genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, const Fortran::parser::Format &format, mlir::Type strTy, - mlir::Type lenTy, Fortran::lower::pft::LabelEvalMap &labelMap, - Fortran::lower::pft::SymbolLabelMap &assignMap) { + mlir::Type lenTy, Fortran::lower::StatementContext &stmtCtx) { if (const auto *label = std::get_if(&format.u)) { // format statement label - auto iter = labelMap.find(*label); - assert(iter != labelMap.end() && "FORMAT not found in PROCEDURE"); + auto eval = converter.lookupLabel(*label); + assert(eval && "FORMAT not found in PROCEDURE"); return lowerSourceTextAsStringLit( - converter, loc, toStringRef(iter->second->position), strTy, lenTy); + converter, loc, toStringRef(eval->position), strTy, lenTy); } const auto *pExpr = std::get_if(&format.u); assert(pExpr && "missing format expression"); @@ -932,83 +1157,59 @@ genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, *e, Fortran::common::TypeCategory::Character)) // character expression return lowerStringLit(converter, loc, *pExpr, strTy, lenTy); + // integer variable containing an ASSIGN label assert(Fortran::semantics::ExprHasTypeCategory( *e, Fortran::common::TypeCategory::Integer)); - // TODO - implement this - llvm::report_fatal_error( - "using a variable to reference a FORMAT statement; not implemented yet"); + return lowerReferenceAsStringSelect(converter, loc, *e, strTy, lenTy, + stmtCtx); } template std::tuple getFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc, const A &stmt, mlir::Type strTy, mlir::Type lenTy, - Fortran::lower::pft::LabelEvalMap &labelMap, - Fortran::lower::pft::SymbolLabelMap &assignMap) { + Fortran ::lower::StatementContext &stmtCtx) { if (stmt.format && !formatIsActuallyNamelist(*stmt.format)) - return genFormat(converter, loc, *stmt.format, strTy, lenTy, labelMap, - assignMap); + return genFormat(converter, loc, *stmt.format, strTy, lenTy, stmtCtx); return genFormat(converter, loc, *getIOControl(stmt), - strTy, lenTy, labelMap, assignMap); + strTy, lenTy, stmtCtx); } template <> std::tuple getFormat( Fortran::lower::AbstractConverter &converter, mlir::Location loc, const Fortran::parser::PrintStmt &stmt, mlir::Type strTy, mlir::Type lenTy, - Fortran::lower::pft::LabelEvalMap &labelMap, - Fortran::lower::pft::SymbolLabelMap &assignMap) { + Fortran::lower::StatementContext &stmtCtx) { return genFormat(converter, loc, std::get(stmt.t), - strTy, lenTy, labelMap, assignMap); -} - -/// Generate a reference to a buffer and the length of buffer.There are 3 cases -/// An IoUnit can be variable, a ScalarIntExpr (i.e FileUnitNumber) or a *. The -/// first is handled here, the other 2 are somewhere else. -static std::tuple -genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, - const Fortran::parser::IoUnit &iounit, mlir::Type strTy, - mlir::Type lenTy) { - // Variable - auto *var = std::get_if(&iounit.u); - assert(var && "Has to be a variable"); - auto e = Fortran::semantics::GetExpr(*var); - auto &builder = converter.getFirOpBuilder(); - assert(Fortran::semantics::ExprHasTypeCategory( - *e, Fortran::common::TypeCategory::Character)); - // Helper to query [BUFFER, LEN]. - Fortran::lower::CharacterExprHelper helper(builder, loc); - auto dataLen = helper.materializeCharacter(converter.genExprValue(*e)); - auto buff = builder.createConvert(loc, strTy, dataLen.first); - auto len = builder.createConvert(loc, lenTy, dataLen.second); - return {buff, len}; + strTy, lenTy, stmtCtx); } +/// There are 3 cases An IoUnit can be variable, a ScalarIntExpr (i.e +/// FileUnitNumber) or a *. Only the first case (a variable) is handled here. template std::tuple getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc, - const A &stmt, mlir::Type strTy, mlir::Type lenTy) { - if (stmt.iounit) - return genBuffer(converter, loc, *stmt.iounit, strTy, lenTy); - return genBuffer(converter, loc, *getIOControl(stmt), - strTy, lenTy); -} - -template -mlir::Value getDescriptor(Fortran::lower::AbstractConverter &converter, - mlir::Location loc, const A &stmt, - mlir::Type toType) { - TODO(); + const A &stmt, mlir::Type strTy, mlir::Type lenTy, + Fortran::lower::StatementContext &stmtCtx) { + const Fortran::parser::IoUnit *iounit = + stmt.iounit ? &*stmt.iounit : getIOControl(stmt); + if (iounit) + if (auto *var = std::get_if(&iounit->u)) + if (auto *expr = Fortran::semantics::GetExpr(*var)) + return genBuffer(converter, loc, *expr, strTy, lenTy, stmtCtx); + llvm::report_fatal_error("failed to get IoUnit expr in lowering"); } static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter, mlir::Location loc, const Fortran::parser::IoUnit &iounit, - mlir::Type ty) { + mlir::Type ty, + Fortran::lower::StatementContext &stmtCtx) { auto &builder = converter.getFirOpBuilder(); if (auto *e = std::get_if(&iounit.u)) { - auto ex = converter.genExprValue(Fortran::semantics::GetExpr(*e), loc); + auto ex = fir::getBase( + converter.genExprValue(Fortran::semantics::GetExpr(*e), stmtCtx, loc)); return builder.createConvert(loc, ty, ex); } return builder.create( @@ -1017,11 +1218,15 @@ static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter, template mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter, - mlir::Location loc, const A &stmt, mlir::Type ty) { + mlir::Location loc, const A &stmt, mlir::Type ty, + Fortran::lower::StatementContext &stmtCtx) { if (stmt.iounit) - return genIOUnit(converter, loc, *stmt.iounit, ty); - return genIOUnit(converter, loc, *getIOControl(stmt), - ty); + return genIOUnit(converter, loc, *stmt.iounit, ty, stmtCtx); + if (auto *iounit = getIOControl(stmt)) + return genIOUnit(converter, loc, *iounit, ty, stmtCtx); + auto &builder = converter.getFirOpBuilder(); + return builder.create( + loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit)); } //===----------------------------------------------------------------------===// @@ -1032,24 +1237,27 @@ template static mlir::Value genBasicIOStmt(Fortran::lower::AbstractConverter &converter, const S &stmt) { auto &builder = converter.getFirOpBuilder(); + Fortran::lower::StatementContext stmtCtx; auto loc = converter.getCurrentLocation(); auto beginFunc = getIORuntimeFunc(loc, builder); mlir::FunctionType beginFuncTy = beginFunc.getType(); - auto unit = converter.genExprValue( - getExpr(stmt), loc); + auto unit = fir::getBase(converter.genExprValue( + getExpr(stmt), stmtCtx, loc)); auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); - auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(1)); - auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(2)); - llvm::SmallVector args{un, file, line}; - auto cookie = builder.create(loc, beginFunc, args).getResult(0); - ConditionSpecifierInfo csi{}; + auto file = locToFilename(converter, loc, beginFuncTy.getInput(1)); + auto line = locToLineNo(converter, loc, beginFuncTy.getInput(2)); + auto call = builder.create(loc, beginFunc, + mlir::ValueRange{un, file, line}); + auto cookie = call.getResult(0); + ConditionSpecInfo csi; genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); - mlir::Value ok{}; + mlir::Value ok; auto insertPt = threadSpecs(converter, loc, cookie, stmt.v, - csi.hasErrorConditionSpecifier(), ok); + csi.hasErrorConditionSpec(), ok, stmtCtx); if (insertPt.isSet()) builder.restoreInsertionPoint(insertPt); - return genEndIO(converter, converter.getCurrentLocation(), cookie, csi); + return genEndIO(converter, converter.getCurrentLocation(), cookie, csi, + stmtCtx); } mlir::Value Fortran::lower::genBackspaceStatement( @@ -1080,39 +1288,36 @@ mlir::Value Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter, const Fortran::parser::OpenStmt &stmt) { auto &builder = converter.getFirOpBuilder(); + Fortran::lower::StatementContext stmtCtx; mlir::FuncOp beginFunc; llvm::SmallVector beginArgs; auto loc = converter.getCurrentLocation(); if (hasMem(stmt)) { beginFunc = getIORuntimeFunc(loc, builder); mlir::FunctionType beginFuncTy = beginFunc.getType(); - auto unit = converter.genExprValue( - getExpr(stmt), loc); + auto unit = fir::getBase(converter.genExprValue( + getExpr(stmt), stmtCtx, loc)); beginArgs.push_back( builder.createConvert(loc, beginFuncTy.getInput(0), unit)); - beginArgs.push_back( - getDefaultFilename(builder, loc, beginFuncTy.getInput(1))); - beginArgs.push_back( - getDefaultLineNo(builder, loc, beginFuncTy.getInput(2))); + beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(1))); + beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(2))); } else { assert(hasMem(stmt)); beginFunc = getIORuntimeFunc(loc, builder); mlir::FunctionType beginFuncTy = beginFunc.getType(); - beginArgs.push_back( - getDefaultFilename(builder, loc, beginFuncTy.getInput(0))); - beginArgs.push_back( - getDefaultLineNo(builder, loc, beginFuncTy.getInput(1))); + beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(0))); + beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(1))); } auto cookie = - builder.create(loc, beginFunc, beginArgs).getResult(0); - ConditionSpecifierInfo csi{}; + builder.create(loc, beginFunc, beginArgs).getResult(0); + ConditionSpecInfo csi; genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); - mlir::Value ok{}; + mlir::Value ok; auto insertPt = threadSpecs(converter, loc, cookie, stmt.v, - csi.hasErrorConditionSpecifier(), ok); + csi.hasErrorConditionSpec(), ok, stmtCtx); if (insertPt.isSet()) builder.restoreInsertionPoint(insertPt); - return genEndIO(converter, loc, cookie, csi); + return genEndIO(converter, loc, cookie, csi, stmtCtx); } mlir::Value @@ -1125,25 +1330,27 @@ mlir::Value Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter, const Fortran::parser::WaitStmt &stmt) { auto &builder = converter.getFirOpBuilder(); + Fortran::lower::StatementContext stmtCtx; auto loc = converter.getCurrentLocation(); bool hasId = hasMem(stmt); mlir::FuncOp beginFunc = hasId ? getIORuntimeFunc(loc, builder) : getIORuntimeFunc(loc, builder); mlir::FunctionType beginFuncTy = beginFunc.getType(); - auto unit = converter.genExprValue( - getExpr(stmt), loc); + auto unit = fir::getBase(converter.genExprValue( + getExpr(stmt), stmtCtx, loc)); auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); llvm::SmallVector args{un}; if (hasId) { - auto id = - converter.genExprValue(getExpr(stmt), loc); + auto id = fir::getBase(converter.genExprValue( + getExpr(stmt), stmtCtx, loc)); args.push_back(builder.createConvert(loc, beginFuncTy.getInput(1), id)); } - auto cookie = builder.create(loc, beginFunc, args).getResult(0); - ConditionSpecifierInfo csi{}; + auto cookie = builder.create(loc, beginFunc, args).getResult(0); + ConditionSpecInfo csi; genConditionHandlerCall(converter, loc, cookie, stmt.v, csi); - return genEndIO(converter, converter.getCurrentLocation(), cookie, csi); + return genEndIO(converter, converter.getCurrentLocation(), cookie, csi, + stmtCtx); } //===----------------------------------------------------------------------===// @@ -1161,10 +1368,10 @@ Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter, // Determine the correct BeginXyz{In|Out}put api to invoke. template -mlir::FuncOp getBeginDataTransfer(mlir::Location loc, FirOpBuilder &builder, - bool isFormatted, bool isList, bool isIntern, - bool isOtherIntern, bool isAsynch, - bool isNml) { +mlir::FuncOp +getBeginDataTransfer(mlir::Location loc, Fortran::lower::FirOpBuilder &builder, + bool isFormatted, bool isList, bool isIntern, + bool isOtherIntern, bool isAsynch, bool isNml) { if constexpr (isInput) { if (isAsynch) return getIORuntimeFunc(loc, builder); @@ -1218,24 +1425,24 @@ mlir::FuncOp getBeginDataTransfer(mlir::Location loc, FirOpBuilder &builder, /// Generate the arguments of a BeginXyz call. template -void genBeginCallArguments(llvm::SmallVector &ioArgs, +void genBeginCallArguments(llvm::SmallVectorImpl &ioArgs, Fortran::lower::AbstractConverter &converter, mlir::Location loc, const A &stmt, mlir::FunctionType ioFuncTy, bool isFormatted, bool isList, bool isIntern, bool isOtherIntern, bool isAsynch, bool isNml, - Fortran::lower::pft::LabelEvalMap &labelMap, - Fortran::lower::pft::SymbolLabelMap &assignMap) { + const llvm::Optional &descRef, + Fortran::lower::StatementContext &stmtCtx) { auto &builder = converter.getFirOpBuilder(); if constexpr (hasIOCtrl) { // READ/WRITE cases have a wide variety of argument permutations if (isAsynch || !isFormatted) { // unit (always first), ... - ioArgs.push_back( - getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()))); + ioArgs.push_back(getIOUnit(converter, loc, stmt, + ioFuncTy.getInput(ioArgs.size()), stmtCtx)); if (isAsynch) { // unknown-thingy, [buff, LEN] - llvm_unreachable("not implemented"); + TODO(loc, "asynchrous"); } return; } @@ -1243,33 +1450,36 @@ void genBeginCallArguments(llvm::SmallVector &ioArgs, if (!isIntern) { if (isNml) { // namelist group, ... - llvm_unreachable("not implemented"); + TODO(loc, "namelist"); } else if (!isList) { // | [format, LEN], ... - auto pair = getFormat( - converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), - ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); + auto pair = + getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), + ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx); ioArgs.push_back(std::get<0>(pair)); ioArgs.push_back(std::get<1>(pair)); } // unit (always last) - ioArgs.push_back( - getIOUnit(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()))); + ioArgs.push_back(getIOUnit(converter, loc, stmt, + ioFuncTy.getInput(ioArgs.size()), stmtCtx)); return; } assert(isIntern && "internal data transfer"); if (isNml || isOtherIntern) { // descriptor, ... - ioArgs.push_back(getDescriptor(converter, loc, stmt, - ioFuncTy.getInput(ioArgs.size()))); + assert(!isNml && "namelist is not implemented"); + assert(descRef.hasValue() && "descriptor value required"); + auto desc = builder.createBox(loc, *descRef); + ioArgs.push_back( + builder.createConvert(loc, ioFuncTy.getInput(ioArgs.size()), desc)); if (isNml) { // namelist group, ... - llvm_unreachable("not implemented"); + TODO(loc, "namelist"); } else if (isOtherIntern && !isList) { // | [format, LEN], ... - auto pair = getFormat( - converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), - ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); + auto pair = + getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), + ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx); ioArgs.push_back(std::get<0>(pair)); ioArgs.push_back(std::get<1>(pair)); } @@ -1277,14 +1487,14 @@ void genBeginCallArguments(llvm::SmallVector &ioArgs, // | [buff, LEN], ... auto pair = getBuffer(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), - ioFuncTy.getInput(ioArgs.size() + 1)); + ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx); ioArgs.push_back(std::get<0>(pair)); ioArgs.push_back(std::get<1>(pair)); if (!isList) { // [format, LEN], ... - auto pair = getFormat( - converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), - ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); + auto pair = + getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), + ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx); ioArgs.push_back(std::get<0>(pair)); ioArgs.push_back(std::get<1>(pair)); } @@ -1299,7 +1509,7 @@ void genBeginCallArguments(llvm::SmallVector &ioArgs, // [format, LEN], ... auto pair = getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()), - ioFuncTy.getInput(ioArgs.size() + 1), labelMap, assignMap); + ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx); ioArgs.push_back(std::get<0>(pair)); ioArgs.push_back(std::get<1>(pair)); } @@ -1312,16 +1522,19 @@ void genBeginCallArguments(llvm::SmallVector &ioArgs, template static mlir::Value -genDataTransferStmt(Fortran::lower::AbstractConverter &converter, const A &stmt, - Fortran::lower::pft::LabelEvalMap &labelMap, - Fortran::lower::pft::SymbolLabelMap &assignMap) { +genDataTransferStmt(Fortran::lower::AbstractConverter &converter, + const A &stmt) { auto &builder = converter.getFirOpBuilder(); + Fortran::lower::StatementContext stmtCtx; auto loc = converter.getCurrentLocation(); const bool isFormatted = isDataTransferFormatted(stmt); const bool isList = isFormatted ? isDataTransferList(stmt) : false; const bool isIntern = isDataTransferInternal(stmt); - const bool isOtherIntern = - isIntern ? isDataTransferInternalNotDefaultKind(stmt) : false; + llvm::Optional descRef = + isIntern ? getIfDataTransferInternalRequiresDescriptor(converter, stmt, + stmtCtx) + : llvm::None; + const bool isOtherIntern = descRef.hasValue(); const bool isAsynch = isDataTransferAsynchronous(stmt); const bool isNml = isDataTransferNamelist(stmt); @@ -1335,70 +1548,64 @@ genDataTransferStmt(Fortran::lower::AbstractConverter &converter, const A &stmt, llvm::SmallVector ioArgs; genBeginCallArguments(ioArgs, converter, loc, stmt, ioFuncTy, isFormatted, isList, isIntern, isOtherIntern, - isAsynch, isNml, labelMap, assignMap); + isAsynch, isNml, descRef, stmtCtx); ioArgs.push_back( - getDefaultFilename(builder, loc, ioFuncTy.getInput(ioArgs.size()))); + locToFilename(converter, loc, ioFuncTy.getInput(ioArgs.size()))); ioArgs.push_back( - getDefaultLineNo(builder, loc, ioFuncTy.getInput(ioArgs.size()))); + locToLineNo(converter, loc, ioFuncTy.getInput(ioArgs.size()))); // Arguments are done; call the BeginXyz function. mlir::Value cookie = - builder.create(loc, ioFunc, ioArgs).getResult(0); + builder.create(loc, ioFunc, ioArgs).getResult(0); // Generate an EnableHandlers call and remaining specifier calls. - ConditionSpecifierInfo csi; + ConditionSpecInfo csi; mlir::OpBuilder::InsertPoint insertPt; mlir::Value ok; if constexpr (hasIOCtrl) { genConditionHandlerCall(converter, loc, cookie, stmt.controls, csi); insertPt = threadSpecs(converter, loc, cookie, stmt.controls, - csi.hasErrorConditionSpecifier(), ok); + csi.hasErrorConditionSpec(), ok, stmtCtx); } // Generate data transfer list calls. if constexpr (isInput) // ReadStmt - genInputItemList(converter, cookie, stmt.items, insertPt, - csi.hasTransferConditionSpecifier(), ok, false); + genInputItemList(converter, cookie, stmt.items, insertPt, isFormatted, + csi.hasTransferConditionSpec(), ok, /*inIterWhile=*/false, + stmtCtx); else if constexpr (std::is_same_v) genOutputItemList(converter, cookie, std::get<1>(stmt.t), insertPt, - csi.hasTransferConditionSpecifier(), ok, false); + isFormatted, csi.hasTransferConditionSpec(), ok, + /*inIterWhile=*/false, stmtCtx); else // WriteStmt - genOutputItemList(converter, cookie, stmt.items, insertPt, - csi.hasTransferConditionSpecifier(), ok, false); + genOutputItemList(converter, cookie, stmt.items, insertPt, isFormatted, + csi.hasTransferConditionSpec(), ok, + /*inIterWhile=*/false, stmtCtx); // Generate end statement call/s. if (insertPt.isSet()) builder.restoreInsertionPoint(insertPt); - return genEndIO(converter, loc, cookie, csi); + return genEndIO(converter, loc, cookie, csi, stmtCtx); } void Fortran::lower::genPrintStatement( Fortran::lower::AbstractConverter &converter, - const Fortran::parser::PrintStmt &stmt, - Fortran::lower::pft::LabelEvalMap &labelMap, - Fortran::lower::pft::SymbolLabelMap &assignMap) { + const Fortran::parser::PrintStmt &stmt) { // PRINT does not take an io-control-spec. It only has a format specifier, so // it is a simplified case of WRITE. - genDataTransferStmt(converter, stmt, - labelMap, assignMap); + genDataTransferStmt(converter, stmt); } -mlir::Value Fortran::lower::genWriteStatement( - Fortran::lower::AbstractConverter &converter, - const Fortran::parser::WriteStmt &stmt, - Fortran::lower::pft::LabelEvalMap &labelMap, - Fortran::lower::pft::SymbolLabelMap &assignMap) { - return genDataTransferStmt(converter, stmt, labelMap, - assignMap); +mlir::Value +Fortran::lower::genWriteStatement(Fortran::lower::AbstractConverter &converter, + const Fortran::parser::WriteStmt &stmt) { + return genDataTransferStmt(converter, stmt); } -mlir::Value Fortran::lower::genReadStatement( - Fortran::lower::AbstractConverter &converter, - const Fortran::parser::ReadStmt &stmt, - Fortran::lower::pft::LabelEvalMap &labelMap, - Fortran::lower::pft::SymbolLabelMap &assignMap) { - return genDataTransferStmt(converter, stmt, labelMap, - assignMap); +mlir::Value +Fortran::lower::genReadStatement(Fortran::lower::AbstractConverter &converter, + const Fortran::parser::ReadStmt &stmt) { + return genDataTransferStmt(converter, stmt); } /// Get the file expression from the inquire spec list. Also return if the @@ -1406,25 +1613,181 @@ mlir::Value Fortran::lower::genReadStatement( static std::pair getInquireFileExpr(const std::list *stmt) { if (!stmt) - return {nullptr, false}; + return {nullptr, /*filename?=*/false}; for (const auto &spec : *stmt) { if (auto *f = std::get_if(&spec.u)) - return {Fortran::semantics::GetExpr(*f), false}; + return {Fortran::semantics::GetExpr(*f), /*filename?=*/false}; if (auto *f = std::get_if(&spec.u)) - return {Fortran::semantics::GetExpr(*f), true}; + return {Fortran::semantics::GetExpr(*f), /*filename?=*/true}; } // semantics should have already caught this condition - llvm_unreachable("inquire spec must have a file"); + llvm::report_fatal_error("inquire spec must have a file"); +} + +/// Generate calls to the four distinct INQUIRE subhandlers. An INQUIRE may +/// return values of type CHARACTER, INTEGER, or LOGICAL. There is one +/// additional special case for INQUIRE with both PENDING and ID specifiers. +template +static mlir::Value genInquireSpec(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Value cookie, + mlir::Value idExpr, const A &var, + Fortran::lower::StatementContext &stmtCtx) { + // default case: do nothing + return {}; +} +/// Specialization for CHARACTER. +template <> +mlir::Value genInquireSpec( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, mlir::Value idExpr, + const Fortran::parser::InquireSpec::CharVar &var, + Fortran::lower::StatementContext &stmtCtx) { + // IOMSG is handled with exception conditions + if (std::get(var.t) == + Fortran::parser::InquireSpec::CharVar::Kind::Iomsg) + return {}; + auto &builder = converter.getFirOpBuilder(); + mlir::FuncOp specFunc = + getIORuntimeFunc(loc, builder); + auto specFuncTy = specFunc.getType(); + const auto *varExpr = Fortran::semantics::GetExpr( + std::get(var.t)); + auto str = converter.genExprAddr(varExpr, stmtCtx, loc); + llvm::SmallVector args = { + builder.createConvert(loc, specFuncTy.getInput(0), cookie), + builder.createIntegerConstant( + loc, specFuncTy.getInput(1), + Fortran::runtime::io::HashInquiryKeyword( + Fortran::parser::InquireSpec::CharVar::EnumToString( + std::get(var.t)) + .c_str())), + builder.createConvert(loc, specFuncTy.getInput(2), fir::getBase(str)), + builder.createConvert(loc, specFuncTy.getInput(3), fir::getLen(str))}; + return builder.create(loc, specFunc, args).getResult(0); +} +/// Specialization for INTEGER. +template <> +mlir::Value genInquireSpec( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, mlir::Value idExpr, + const Fortran::parser::InquireSpec::IntVar &var, + Fortran::lower::StatementContext &stmtCtx) { + // IOSTAT is handled with exception conditions + if (std::get(var.t) == + Fortran::parser::InquireSpec::IntVar::Kind::Iostat) + return {}; + auto &builder = converter.getFirOpBuilder(); + mlir::FuncOp specFunc = + getIORuntimeFunc(loc, builder); + auto specFuncTy = specFunc.getType(); + const auto *varExpr = Fortran::semantics::GetExpr( + std::get(var.t)); + auto addr = fir::getBase(converter.genExprAddr(varExpr, stmtCtx, loc)); + auto eleTy = fir::dyn_cast_ptrEleTy(addr.getType()); + if (!eleTy) + mlir::emitError(loc, "internal: expected a memory reference type ") + << addr.getType(); + auto bitWidth = eleTy.cast().getWidth(); + auto idxTy = builder.getIndexType(); + auto kind = builder.createIntegerConstant(loc, idxTy, bitWidth / 8); + llvm::SmallVector args = { + builder.createConvert(loc, specFuncTy.getInput(0), cookie), + builder.createIntegerConstant( + loc, specFuncTy.getInput(1), + Fortran::runtime::io::HashInquiryKeyword( + Fortran::parser::InquireSpec::IntVar::EnumToString( + std::get(var.t)) + .c_str())), + builder.createConvert(loc, specFuncTy.getInput(2), addr), + builder.createConvert(loc, specFuncTy.getInput(3), kind)}; + return builder.create(loc, specFunc, args).getResult(0); +} +/// Specialization for LOGICAL and (PENDING + ID). +template <> +mlir::Value genInquireSpec( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, mlir::Value idExpr, + const Fortran::parser::InquireSpec::LogVar &var, + Fortran::lower::StatementContext &stmtCtx) { + auto &builder = converter.getFirOpBuilder(); + auto logVarKind = std::get(var.t); + bool pendId = + idExpr && + logVarKind == Fortran::parser::InquireSpec::LogVar::Kind::Pending; + mlir::FuncOp specFunc = + pendId ? getIORuntimeFunc(loc, builder) + : getIORuntimeFunc(loc, builder); + auto specFuncTy = specFunc.getType(); + auto addr = fir::getBase(converter.genExprAddr( + Fortran::semantics::GetExpr( + std::get>>(var.t)), + stmtCtx, loc)); + llvm::SmallVector args = { + builder.createConvert(loc, specFuncTy.getInput(0), cookie)}; + if (pendId) + args.push_back(builder.createConvert(loc, specFuncTy.getInput(1), idExpr)); + else + args.push_back(builder.createIntegerConstant( + loc, specFuncTy.getInput(1), + Fortran::runtime::io::HashInquiryKeyword( + Fortran::parser::InquireSpec::LogVar::EnumToString(logVarKind) + .c_str()))); + args.push_back(builder.createConvert(loc, specFuncTy.getInput(2), addr)); + return builder.create(loc, specFunc, args).getResult(0); +} + +/// If there is an IdExpr in the list of inquire-specs, then lower it and return +/// the resulting Value. Otherwise, return null. +static mlir::Value +lowerIdExpr(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const std::list &ispecs, + Fortran::lower::StatementContext &stmtCtx) { + for (const auto &spec : ispecs) + if (mlir::Value v = std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::IdExpr &idExpr) { + return fir::getBase(converter.genExprValue( + Fortran::semantics::GetExpr(idExpr), stmtCtx, loc)); + }, + [](const auto &) { return mlir::Value{}; }}, + spec.u)) + return v; + return {}; +} + +/// For each inquire-spec, build the appropriate call, threading the cookie, and +/// returning the insertion point as to the initial context. If there are no +/// inquire-specs, the insertion point is undefined. +static mlir::OpBuilder::InsertPoint +threadInquire(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, + const std::list &ispecs, + bool checkResult, mlir::Value &ok, + Fortran::lower::StatementContext &stmtCtx) { + auto &builder = converter.getFirOpBuilder(); + mlir::OpBuilder::InsertPoint insertPt; + mlir::Value idExpr = lowerIdExpr(converter, loc, ispecs, stmtCtx); + for (const auto &spec : ispecs) { + makeNextConditionalOn(builder, loc, insertPt, checkResult, ok); + ok = std::visit(Fortran::common::visitors{[&](const auto &x) { + return genInquireSpec(converter, loc, cookie, idExpr, x, + stmtCtx); + }}, + spec.u); + } + return insertPt; } mlir::Value Fortran::lower::genInquireStatement( Fortran::lower::AbstractConverter &converter, const Fortran::parser::InquireStmt &stmt) { auto &builder = converter.getFirOpBuilder(); + Fortran::lower::StatementContext stmtCtx; auto loc = converter.getCurrentLocation(); mlir::FuncOp beginFunc; - mlir::Value cookie; - ConditionSpecifierInfo csi{}; + ConditionSpecInfo csi; + llvm::SmallVector beginArgs; const auto *list = std::get_if>(&stmt.u); auto exprPair = getInquireFileExpr(list); @@ -1440,56 +1803,50 @@ mlir::Value Fortran::lower::genInquireStatement( // File unit call. beginFunc = getIORuntimeFunc(loc, builder); mlir::FunctionType beginFuncTy = beginFunc.getType(); - auto unit = converter.genExprValue(exprPair.first, loc); - auto un = builder.createConvert(loc, beginFuncTy.getInput(0), unit); - auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(1)); - auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(2)); - llvm::SmallVector beginArgs{un, file, line}; - cookie = - builder.create(loc, beginFunc, beginArgs).getResult(0); - // Handle remaining arguments in specifier list. - genConditionHandlerCall(converter, loc, cookie, *list, csi); + beginArgs = {builder.createConvert(loc, beginFuncTy.getInput(0), + fir::getBase(converter.genExprValue( + exprPair.first, stmtCtx, loc))), + locToFilename(converter, loc, beginFuncTy.getInput(1)), + locToLineNo(converter, loc, beginFuncTy.getInput(2))}; } else if (inquireFileName()) { // Filename call. beginFunc = getIORuntimeFunc(loc, builder); mlir::FunctionType beginFuncTy = beginFunc.getType(); - auto file = converter.genExprValue(exprPair.first, loc); - // Helper to query [BUFFER, LEN]. - Fortran::lower::CharacterExprHelper helper(builder, loc); - auto dataLen = helper.materializeCharacter(file); - auto buff = - builder.createConvert(loc, beginFuncTy.getInput(0), dataLen.first); - auto len = - builder.createConvert(loc, beginFuncTy.getInput(1), dataLen.second); - auto kindInt = helper.getCharacterKind(file.getType()); - mlir::Value kindValue = - builder.createIntegerConstant(loc, beginFuncTy.getInput(2), kindInt); - auto sourceFile = getDefaultFilename(builder, loc, beginFuncTy.getInput(3)); - auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(4)); - llvm::SmallVector beginArgs = { - buff, len, kindValue, sourceFile, line, - }; - cookie = - builder.create(loc, beginFunc, beginArgs).getResult(0); - // Handle remaining arguments in specifier list. - genConditionHandlerCall(converter, loc, cookie, *list, csi); + auto file = converter.genExprAddr(exprPair.first, stmtCtx, loc); + beginArgs = { + builder.createConvert(loc, beginFuncTy.getInput(0), fir::getBase(file)), + builder.createConvert(loc, beginFuncTy.getInput(1), fir::getLen(file)), + locToFilename(converter, loc, beginFuncTy.getInput(2)), + locToLineNo(converter, loc, beginFuncTy.getInput(3))}; } else { - // Io length call. + // INQUIRE IOLENGTH call. const auto *ioLength = std::get_if(&stmt.u); assert(ioLength && "must have an io length"); beginFunc = getIORuntimeFunc(loc, builder); mlir::FunctionType beginFuncTy = beginFunc.getType(); - auto file = getDefaultFilename(builder, loc, beginFuncTy.getInput(0)); - auto line = getDefaultLineNo(builder, loc, beginFuncTy.getInput(1)); - llvm::SmallVector beginArgs{file, line}; - cookie = - builder.create(loc, beginFunc, beginArgs).getResult(0); - // Handle remaining arguments in output list. + beginArgs = {locToFilename(converter, loc, beginFuncTy.getInput(0)), + locToLineNo(converter, loc, beginFuncTy.getInput(1))}; + // The IOLENGTH call is irregular enough to generate immediately here. + auto cookie = + builder.create(loc, beginFunc, beginArgs).getResult(0); genConditionHandlerCall( converter, loc, cookie, std::get>(ioLength->t), csi); + return genEndIO(converter, loc, cookie, csi, stmtCtx); } + + // Common handling for file {unit|name} cases. + assert(list && "inquire-spec list must be present"); + auto cookie = + builder.create(loc, beginFunc, beginArgs).getResult(0); + genConditionHandlerCall(converter, loc, cookie, *list, csi); + // Handle remaining arguments in specifier list. + mlir::Value ok; + auto insertPt = threadInquire(converter, loc, cookie, *list, + csi.hasErrorConditionSpec(), ok, stmtCtx); + if (insertPt.isSet()) + builder.restoreInsertionPoint(insertPt); // Generate end statement call. - return genEndIO(converter, loc, cookie, csi); + return genEndIO(converter, loc, cookie, csi, stmtCtx); } diff --git a/flang/test/Lower/global-format-strings.f90 b/flang/test/Lower/global-format-strings.f90 new file mode 100644 index 0000000000000..4eff504231a9b --- /dev/null +++ b/flang/test/Lower/global-format-strings.f90 @@ -0,0 +1,14 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +! Test checks whether the text of the format statement is hashconed into a +! global similar to a CHARACTER literal and then referenced. + +program other + write(10, 1008) + ! CHECK: fir.address_of(@{{.*}}) : +1008 format('ok') +end +! CHECK-LABEL: fir.global @_QQcl.28276F6B2729 constant +! CHECK: %[[lit:.*]] = fir.string_lit "('ok')"(6) : !fir.char<1> +! CHECK: fir.has_value %[[lit]] : !fir.array<6x!fir.char<1>> +! CHECK: } From 54d22c4ac10eedd72aa80854bb065d07afb64e6f Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Sat, 11 Jul 2020 10:37:07 -0700 Subject: [PATCH 0159/1017] sync with llvm-project cmake changes and remove options that silence warnings --- flang/lib/Optimizer/CMakeLists.txt | 1 + flang/lib/Semantics/CMakeLists.txt | 1 - flang/runtime/CMakeLists.txt | 1 - flang/tools/bbc/CMakeLists.txt | 2 +- flang/tools/f18/CMakeLists.txt | 2 -- flang/tools/tco/CMakeLists.txt | 2 +- 6 files changed, 3 insertions(+), 6 deletions(-) diff --git a/flang/lib/Optimizer/CMakeLists.txt b/flang/lib/Optimizer/CMakeLists.txt index 408dceb7d8dff..246117c0b35ad 100644 --- a/flang/lib/Optimizer/CMakeLists.txt +++ b/flang/lib/Optimizer/CMakeLists.txt @@ -1,3 +1,4 @@ + get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) add_flang_library(FIROptimizer diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt index 4583abc6411dd..4bab4b16149db 100644 --- a/flang/lib/Semantics/CMakeLists.txt +++ b/flang/lib/Semantics/CMakeLists.txt @@ -1,4 +1,3 @@ -set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-parameter") add_flang_library(FortranSemantics assignment.cpp diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index e1c0db51c5c67..630b2b6a6ebca 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -1,4 +1,3 @@ -set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -DFORTRAN_IN_RUNTIME") include(CheckCXXSymbolExists) include(CheckCXXSourceCompiles) diff --git a/flang/tools/bbc/CMakeLists.txt b/flang/tools/bbc/CMakeLists.txt index 439ba00fb863c..d3e3b69527041 100644 --- a/flang/tools/bbc/CMakeLists.txt +++ b/flang/tools/bbc/CMakeLists.txt @@ -1,4 +1,4 @@ -set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-parameter") + get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) set(LIBS diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt index 0233739170f4f..59af0aff88935 100644 --- a/flang/tools/f18/CMakeLists.txt +++ b/flang/tools/f18/CMakeLists.txt @@ -4,8 +4,6 @@ set(LLVM_LINK_COMPONENTS Support ) -set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-parameter") - add_flang_tool(f18 dump.cpp f18.cpp diff --git a/flang/tools/tco/CMakeLists.txt b/flang/tools/tco/CMakeLists.txt index d206cc0d0c3e8..9f3d0528e6bd7 100644 --- a/flang/tools/tco/CMakeLists.txt +++ b/flang/tools/tco/CMakeLists.txt @@ -1,4 +1,4 @@ -set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-parameter") + get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) set(LIBS From 0e134a4b887e7e03dae1d0a8c199c1e2e75aeaca Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Sat, 11 Jul 2020 13:14:18 -0700 Subject: [PATCH 0160/1017] snuff out 3 warnings --- flang/lib/Lower/Bridge.cpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index ecbe4a96863f6..0ded5cf1b2000 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -757,7 +757,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { doStmtEval.parentConstruct->constructExit->block; } } else { - const auto *concurrentInfo = + [[maybe_unused]] const auto *concurrentInfo = std::get_if( &loopControl->u); assert(concurrentInfo && "DO loop variant is invalid"); @@ -1694,7 +1694,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { unsigned offset = 0; // Assume that the members of the COMMON block will appear in an order // that is sorted by offset. - std::int64_t lastByteOff = -1; + [[maybe_unused]] std::int64_t lastByteOff = -1; for (const auto &obj : details->objects()) { assert(lastByteOff < static_cast(obj->offset())); lastByteOff = static_cast(obj->offset()); @@ -1791,7 +1791,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // never having a missing column size. mlir::Value addr = lookupSymbol(sym); mlir::Value len{}; - bool mustBeDummy = false; + [[maybe_unused]] bool mustBeDummy = false; if (sia.isChar) { // if element type is a CHARACTER, determine the LEN value From bd9cf0202d3e4e2cb0cd77dcb76ec7456cb79f1c Mon Sep 17 00:00:00 2001 From: Steve Scalpone Date: Sun, 12 Jul 2020 11:40:38 -0700 Subject: [PATCH 0161/1017] Follow convention to capitalize Fortran_main.c --- flang/runtime/CMakeLists.txt | 2 +- flang/runtime/{fortran_main.c => Fortran_main.c} | 0 2 files changed, 1 insertion(+), 1 deletion(-) rename flang/runtime/{fortran_main.c => Fortran_main.c} (100%) diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index 630b2b6a6ebca..d8755ab4408da 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -24,6 +24,7 @@ configure_file(config.h.cmake config.h) include_directories(AFTER ${CMAKE_CURRENT_BINARY_DIR}) add_flang_library(FortranRuntime + Fortran_main.c ISO_Fortran_binding.cpp allocatable.cpp buffer.cpp @@ -64,7 +65,6 @@ add_flang_library(FortranRuntime type-code.cpp unit.cpp unit-map.cpp - fortran_main.c LINK_LIBS FortranDecimal diff --git a/flang/runtime/fortran_main.c b/flang/runtime/Fortran_main.c similarity index 100% rename from flang/runtime/fortran_main.c rename to flang/runtime/Fortran_main.c From 6db1c0c51fbc944d230c8b6a02f5e0ed5bdbee34 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Tue, 14 Jul 2020 20:08:23 +0530 Subject: [PATCH 0162/1017] [flang][OpenMP] downstream merge after 3d0b76022df This merges remaining parts of: https://reviews.llvm.org/D83659 --- flang/include/flang/Lower/OpenMP.h | 8 -------- 1 file changed, 8 deletions(-) diff --git a/flang/include/flang/Lower/OpenMP.h b/flang/include/flang/Lower/OpenMP.h index 615193ab6ed55..13dd43b60fded 100644 --- a/flang/include/flang/Lower/OpenMP.h +++ b/flang/include/flang/Lower/OpenMP.h @@ -16,8 +16,6 @@ namespace Fortran { namespace parser { struct OpenMPConstruct; -struct OpenMPStandaloneConstruct; -struct OpenMPSimpleStandaloneConstruct; struct OmpEndLoopDirective; } // namespace parser @@ -32,12 +30,6 @@ struct Evaluation; void genOpenMPConstruct(AbstractConverter &, pft::Evaluation &, const parser::OpenMPConstruct &); -void genOMP(AbstractConverter &, pft::Evaluation &, - const parser::OpenMPStandaloneConstruct &); - -void genOMP(AbstractConverter &, pft::Evaluation &, - const parser::OpenMPSimpleStandaloneConstruct &); - void genOpenMPEndLoop(AbstractConverter &, pft::Evaluation &, const parser::OmpEndLoopDirective &); From b5c5f435937d6d1e18da7b568650a0d4e2302cd5 Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 6 Jul 2020 17:52:53 -0700 Subject: [PATCH 0163/1017] Refine the IR as it relates to shapes and slices of arrays. This introduces some new types and operations that distinguish the runtime properties of array shape and array slicing operations. Additionally, we refine the array_coor and embox operations to use these new values. fix bug in pretty printer. add test. review comment - fix assert text add an assert to catch cases when shape is missing, etc. --- .../include/flang/Optimizer/Dialect/FIROps.td | 3 +- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 174 +++++++++++------- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 128 ++++++++++--- flang/lib/Optimizer/Dialect/FIRDialect.cpp | 15 +- flang/lib/Optimizer/Dialect/FIROps.cpp | 69 ------- .../Optimizer/Transforms/AffinePromotion.cpp | 26 ++- flang/test/Fir/affine-loop-fusion.fir | 15 +- flang/test/Fir/affine-loop-unswitch.fir | 9 +- flang/test/Fir/box.fir | 4 +- flang/test/Fir/embox-write.fir | 4 +- 10 files changed, 259 insertions(+), 188 deletions(-) diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td index 6e8e765144f23..a38630b2a04f0 100644 --- a/flang/include/flang/Optimizer/Dialect/FIROps.td +++ b/flang/include/flang/Optimizer/Dialect/FIROps.td @@ -2994,8 +2994,7 @@ def fir_ConvertOp : fir_OneResultOp<"convert", [NoSideEffect]> { (isIntegerCompatible(inType) && isPointerCompatible(outType)) || (isPointerCompatible(inType) && isIntegerCompatible(outType)) || (inType.isa() && outType.isa()) || - (fir::isa_complex(inType) && fir::isa_complex(outType)) || - (inType.isa() && outType.isa())) + (fir::isa_complex(inType) && fir::isa_complex(outType))) return mlir::success(); return emitOpError("invalid type conversion"); }]; diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index c6b0e970e4e38..0ff3600e72c5b 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -92,9 +92,6 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { }); addConversion( [&](fir::RecordType derived) { return convertRecordType(derived); }); - addConversion([&](fir::DimsType dims) { - return mlir::LLVM::LLVMType::getArrayTy(dimsType(), dims.getRank()); - }); addConversion([&](fir::FieldType field) { return mlir::LLVM::LLVMType::getInt32Ty(llvmDialect); }); @@ -1341,7 +1338,7 @@ struct EmboxOpConversion : public EmboxCommonConversion { matchAndRewrite(fir::EmboxOp embox, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { // There should be no dims on this embox op - assert(!embox.getDims()); + assert(!embox.getShape()); auto loc = embox.getLoc(); auto *dialect = getDialect(); @@ -1360,32 +1357,26 @@ struct EmboxOpConversion : public EmboxCommonConversion { auto fld = applyCast(fldTy, value); rewriter.create(loc, fld, fldPtr); }; + auto bitCast = [&](mlir::LLVM::LLVMType ty, + mlir::Value val) -> mlir::Value { + return rewriter.create(loc, ty, val); + }; + auto intCast = [&](mlir::LLVM::LLVMType ty, + mlir::Value val) -> mlir::Value { + return integerCast(loc, rewriter, ty, val); + }; // Write each of the fields with the appropriate values - storeField(0, operands[0], [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return rewriter.create(loc, ty, val).getResult(); - }); + storeField(0, operands[0], bitCast); auto [eleSize, cfiTy] = getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy()); - storeField(1, eleSize, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); + storeField(1, eleSize, intCast); auto version = genConstantOffset(loc, rewriter, CFI_VERSION); - storeField(2, version, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); - storeField(3, /*rank*/ c0, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); - storeField(4, cfiTy, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); + storeField(2, version, intCast); + storeField(3, /*rank*/ c0, intCast); + storeField(4, cfiTy, intCast); auto attr = genConstantOffset(loc, rewriter, CFI_attribute_other); - storeField(5, attr, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); - storeField(6, /*addend*/ c0, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); + storeField(5, attr, intCast); + storeField(6, /*addend*/ c0, intCast); rewriter.replaceOp(embox, alloca.getResult()); return success(); @@ -1417,47 +1408,87 @@ struct XEmboxOpConversion : public EmboxCommonConversion { auto fld = applyCast(fldTy, value); rewriter.create(loc, fld, fldPtr); }; + auto bitCast = [&](mlir::LLVM::LLVMType ty, + mlir::Value val) -> mlir::Value { + return rewriter.create(loc, ty, val); + }; + auto intCast = [&](mlir::LLVM::LLVMType ty, + mlir::Value val) -> mlir::Value { + return integerCast(loc, rewriter, ty, val); + }; // Write each of the fields with the appropriate values - storeField(0, operands[0], [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return rewriter.create(loc, ty, val).getResult(); - }); + storeField(0, operands[0], bitCast); auto [eleSize, cfiTy] = getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy()); - storeField(1, eleSize, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); + storeField(1, eleSize, intCast); auto version = genConstantOffset(loc, rewriter, CFI_VERSION); - storeField(2, version, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); + storeField(2, version, intCast); auto rankVal = genConstantOffset(loc, rewriter, rank); - storeField(3, rankVal, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); - storeField(4, cfiTy, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); + storeField(3, rankVal, intCast); + storeField(4, cfiTy, intCast); auto attr = genConstantOffset(loc, rewriter, CFI_attribute_other); - storeField(5, attr, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); - storeField(6, /*addend*/ c0, [&](mlir::LLVM::LLVMType ty, mlir::Value val) { - return integerCast(loc, rewriter, ty, val); - }); + storeField(5, attr, intCast); + storeField(6, /*addend*/ c0, intCast); - unsigned dimsOff = 1; + // Generate the triples in the dims field of the descriptor auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(dialect); auto i64PtrTy = i64Ty.getPointerTo(); + assert(xbox.shapeOperands().size()); + unsigned shapeOff = 1; + bool hasShift = xbox.shiftOperands().size(); + unsigned shiftOff = shapeOff + xbox.shapeOperands().size(); + bool hasSlice = xbox.sliceOperands().size(); + unsigned sliceOff = shiftOff + xbox.shiftOperands().size(); + mlir::Value zero = genConstantIndex(loc, i64Ty, rewriter, 0); + mlir::Value one = genConstantIndex(loc, i64Ty, rewriter, 1); + mlir::Value prevDim = integerCast(loc, rewriter, i64Ty, eleSize); for (unsigned d = 0; d < rank; ++d) { // store lower bound (normally 0) auto f70p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 7, d, 0); - rewriter.create(loc, operands[dimsOff++], f70p); + if (boxTy.isa() || boxTy.isa() || + hasSlice) { + mlir::Value lb = one; + if (hasShift) + lb = operands[shiftOff]; + if (hasSlice) + lb = rewriter.create(loc, i64Ty, lb, + operands[sliceOff]); + rewriter.create(loc, lb, f70p); + } else { + rewriter.create(loc, zero, f70p); + } + // store extent + mlir::Value extent = operands[shapeOff]; + mlir::Value outerExtent = extent; + if (hasSlice) { + extent = rewriter.create( + loc, i64Ty, operands[sliceOff + 1], operands[sliceOff]); + extent = rewriter.create(loc, i64Ty, extent, + operands[sliceOff + 2]); + extent = rewriter.create(loc, i64Ty, extent, + operands[sliceOff + 2]); + } auto f71p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 7, d, 1); - rewriter.create(loc, operands[dimsOff++], f71p); - // store step (scaled by extent to save a multiplication) + rewriter.create(loc, extent, f71p); + + // store step (scaled by shaped extent) + mlir::Value step = prevDim; + if (hasSlice) + step = rewriter.create(loc, i64Ty, step, + operands[sliceOff + 2]); auto f72p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 7, d, 2); - rewriter.create(loc, operands[dimsOff++], f72p); + rewriter.create(loc, step, f72p); + // compute the stride for the next natural dimension + prevDim = + rewriter.create(loc, i64Ty, prevDim, outerExtent); + + // increment iterators + shapeOff++; + if (hasShift) + shiftOff++; + if (hasSlice) + sliceOff += 3; } auto desc = rewriter.create( loc, lowerTy().convertType(boxTy), alloca); @@ -1611,24 +1642,43 @@ struct XArrayCoorOpConversion auto loc = coor.getLoc(); auto rank = coor.getRank(); assert(coor.indexOperands().size() == rank); - assert(coor.dimsOperands().size() == 3 * rank); - unsigned dimsOff = 1; - unsigned indexOff = 1 + coor.dimsOperands().size(); + assert(coor.shapeOperands().size() == 0 || + coor.shapeOperands().size() == rank); + assert(coor.shiftOperands().size() == 0 || + coor.shiftOperands().size() == rank); + assert(coor.sliceOperands().size() == 0 || + coor.sliceOperands().size() == 3 * rank); + auto indexOps = coor.indexOperands().begin(); + auto shapeOps = coor.shapeOperands().begin(); + auto shiftOps = coor.shiftOperands().begin(); + auto sliceOps = coor.sliceOperands().begin(); + auto idxTy = lowerTy().indexType(); // Cast the base address to a pointer to T auto base = rewriter.create(loc, ty, operands[0]); - auto idxTy = lowerTy().indexType(); - mlir::Value prevExt = genConstantIndex(loc, idxTy, rewriter, 1); + mlir::Value one = genConstantIndex(loc, idxTy, rewriter, 1); + auto prevExt = one; mlir::Value off = genConstantIndex(loc, idxTy, rewriter, 0); for (unsigned i = 0; i < rank; ++i) { - auto index = asType(loc, rewriter, idxTy, operands[indexOff++]); - auto lb = asType(loc, rewriter, idxTy, operands[dimsOff++]); - auto nextExt = asType(loc, rewriter, idxTy, operands[dimsOff++]); - auto step = asType(loc, rewriter, idxTy, operands[dimsOff++]); + auto index = asType(loc, rewriter, idxTy, *indexOps); + auto nextExt = asType(loc, rewriter, idxTy, *shapeOps); + mlir::Value lb = one; + if (coor.shiftOperands().size()) + lb = asType(loc, rewriter, idxTy, *shiftOps); + mlir::Value step{}; + if (coor.sliceOperands().size()) { + auto sliceLb = asType(loc, rewriter, idxTy, *sliceOps); + lb = rewriter.create(loc, idxTy, lb, sliceLb); + step = asType(loc, rewriter, idxTy, *(sliceOps + 2)); + } // For each dimension, i, add to the running pointer offset the value of // (index_i - lb_i) * step_i * extent_{i-1}. // Note: LLVM will do constant folding, etc. - auto diff = rewriter.create(loc, idxTy, index, lb); - auto sc0 = rewriter.create(loc, idxTy, diff, step); + mlir::Value diff = + rewriter.create(loc, idxTy, index, lb); + mlir::Value sc0 = + step ? rewriter.create(loc, idxTy, diff, step) + .getResult() + : diff; auto sc1 = rewriter.create(loc, idxTy, sc0, prevExt); off = rewriter.create(loc, idxTy, sc1, off); prevExt = diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index 2df13ad807bb5..d1190619188d0 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -19,6 +19,22 @@ using namespace fir; +static void populateShape(llvm::SmallVectorImpl &vec, + ShapeOp shape) { + vec.append(shape.extents().begin(), shape.extents().end()); +} + +// Operands of fir.shape_shift split into two vectors. +static void populateShapeAndShift(llvm::SmallVectorImpl &shapeVec, + llvm::SmallVectorImpl &shiftVec, + ShapeShiftOp shift) { + auto endIter = shift.pairs().end(); + for (auto i = shift.pairs().begin(); i != endIter;) { + shiftVec.push_back(*i++); + shapeVec.push_back(*i++); + } +} + namespace { /// Convert fir.embox to the extended form where necessary. @@ -30,26 +46,46 @@ class EmboxConversion : public mlir::OpRewritePattern { matchAndRewrite(EmboxOp embox, mlir::PatternRewriter &rewriter) const override { auto loc = embox.getLoc(); - auto dimsVal = embox.getDims(); + auto dimsVal = embox.getShape(); + // If the embox does not include a shape, then do not convert it if (!dimsVal) return mlir::failure(); - auto dimsOp = dyn_cast(dimsVal.getDefiningOp()); - assert(dimsOp && "dims is not a fir.gendims"); + auto shapeOp = dyn_cast(dimsVal.getDefiningOp()); + llvm::SmallVector shapeOpers; + llvm::SmallVector shiftOpers; + if (shapeOp) { + populateShape(shapeOpers, shapeOp); + } else { + auto shiftOp = dyn_cast(dimsVal.getDefiningOp()); + assert(shiftOp && "shape is neither fir.shape nor fir.shape_shift"); + populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); + } mlir::NamedAttrList attrs; - auto lenParamSize = embox.getLenParams().size(); auto idxTy = rewriter.getIndexType(); + auto rank = shapeOp.getType().cast().getRank(); + auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); + attrs.push_back(rewriter.getNamedAttr(XEmboxOp::rankAttrName(), rankAttr)); + auto lenParamSize = embox.getLenParams().size(); auto lenParamAttr = rewriter.getIntegerAttr(idxTy, lenParamSize); attrs.push_back( rewriter.getNamedAttr(XEmboxOp::lenParamAttrName(), lenParamAttr)); - auto dimsSize = dimsOp.getNumOperands(); - auto dimAttr = rewriter.getIntegerAttr(idxTy, dimsSize); - attrs.push_back(rewriter.getNamedAttr(XEmboxOp::dimsAttrName(), dimAttr)); - auto rank = dimsOp.getType().cast().getRank(); - auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); - attrs.push_back(rewriter.getNamedAttr(XEmboxOp::rankAttrName(), rankAttr)); + auto shapeAttr = rewriter.getIntegerAttr(idxTy, shapeOpers.size()); + attrs.push_back( + rewriter.getNamedAttr(XEmboxOp::shapeAttrName(), shapeAttr)); + auto shiftAttr = rewriter.getIntegerAttr(idxTy, shiftOpers.size()); + attrs.push_back( + rewriter.getNamedAttr(XEmboxOp::shiftAttrName(), shiftAttr)); + llvm::SmallVector sliceOpers; + if (auto s = embox.getSlice()) + if (auto sliceOp = + dyn_cast_or_null(s.getDefiningOp())) + sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); + auto sliceAttr = rewriter.getIntegerAttr(idxTy, sliceOpers.size()); + attrs.push_back( + rewriter.getNamedAttr(XEmboxOp::sliceAttrName(), sliceAttr)); auto xbox = rewriter.create(loc, embox.getType(), embox.memref(), - embox.getLenParams(), - dimsOp.getOperands(), attrs); + shapeOpers, shiftOpers, sliceOpers, + embox.getLenParams(), attrs); rewriter.replaceOp(embox, xbox.getOperation()->getResults()); return mlir::success(); } @@ -64,26 +100,47 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { matchAndRewrite(ArrayCoorOp arrCoor, mlir::PatternRewriter &rewriter) const override { auto loc = arrCoor.getLoc(); - auto dimsVal = arrCoor.dims(); - auto dimsOp = dyn_cast(dimsVal.getDefiningOp()); - assert(dimsOp && "dims is not a fir.gendims"); + auto shapeVal = arrCoor.getShape(); + auto shapeOp = dyn_cast(shapeVal.getDefiningOp()); + llvm::SmallVector shapeOpers; + llvm::SmallVector shiftOpers; + if (shapeOp) { + populateShape(shapeOpers, shapeOp); + } else { + auto shiftOp = dyn_cast(shapeVal.getDefiningOp()); + if (shiftOp) + populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); + } mlir::NamedAttrList attrs; - auto indexSize = arrCoor.coor().size(); auto idxTy = rewriter.getIndexType(); + auto rank = shapeOp.getType().cast().getRank(); + auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); + attrs.push_back( + rewriter.getNamedAttr(XArrayCoorOp::rankAttrName(), rankAttr)); + auto lenParamSize = arrCoor.getLenParams().size(); + auto lenParamAttr = rewriter.getIntegerAttr(idxTy, lenParamSize); + attrs.push_back( + rewriter.getNamedAttr(XArrayCoorOp::lenParamAttrName(), lenParamAttr)); + auto indexSize = arrCoor.getIndices().size(); auto idxAttr = rewriter.getIntegerAttr(idxTy, indexSize); attrs.push_back( rewriter.getNamedAttr(XArrayCoorOp::indexAttrName(), idxAttr)); - auto dimsSize = dimsOp.getNumOperands(); - auto dimAttr = rewriter.getIntegerAttr(idxTy, dimsSize); + auto shapeSize = shapeOp.getNumOperands(); + auto dimAttr = rewriter.getIntegerAttr(idxTy, shapeSize); attrs.push_back( - rewriter.getNamedAttr(XArrayCoorOp::dimsAttrName(), dimAttr)); - auto rank = dimsOp.getType().cast().getRank(); - auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); + rewriter.getNamedAttr(XArrayCoorOp::shapeAttrName(), dimAttr)); + llvm::SmallVector sliceOpers; + if (auto s = arrCoor.getSlice()) + if (auto sliceOp = + dyn_cast_or_null(s.getDefiningOp())) + sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); + auto sliceAttr = rewriter.getIntegerAttr(idxTy, sliceOpers.size()); attrs.push_back( - rewriter.getNamedAttr(XArrayCoorOp::rankAttrName(), rankAttr)); + rewriter.getNamedAttr(XArrayCoorOp::sliceAttrName(), sliceAttr)); auto xArrCoor = rewriter.create( - loc, arrCoor.getType(), arrCoor.ref(), dimsOp.getOperands(), - arrCoor.coor(), attrs); + loc, arrCoor.getType(), arrCoor.memref(), shapeOpers, + shiftOpers, sliceOpers, + arrCoor.getIndices(), arrCoor.getLenParams(), attrs); rewriter.replaceOp(arrCoor, xArrCoor.getOperation()->getResults()); return mlir::success(); } @@ -100,7 +157,7 @@ class CodeGenRewrite : public CodeGenRewriteBase { target.addLegalDialect(); target.addIllegalOp(); target.addDynamicallyLegalOp( - [](EmboxOp embox) { return !embox.getDims(); }); + [](EmboxOp embox) { return !embox.getShape(); }); // Do the conversions. if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, @@ -130,21 +187,32 @@ class CodeGenRewrite : public CodeGenRewriteBase { } void maybeEraseOp(mlir::Operation *op) { + if (!op) + return; + // Erase any embox that was replaced. - if (auto embox = dyn_cast_or_null(op)) - if (embox.getDims()) { + if (auto embox = dyn_cast(op)) + if (embox.getShape()) { assert(op->use_empty()); opsToErase.push_back(op); } // Erase all fir.array_coor. - if (auto arrCoor = dyn_cast_or_null(op)) { + if (isa(op)) { assert(op->use_empty()); opsToErase.push_back(op); } - // Erase all fir.gendims ops. - if (auto genDims = dyn_cast_or_null(op)) { + // Erase all fir.shape, fir.shape_shift, and fir.slice ops. + if (isa(op)) { + assert(op->use_empty()); + opsToErase.push_back(op); + } + if (isa(op)) { + assert(op->use_empty()); + opsToErase.push_back(op); + } + if (isa(op)) { assert(op->use_empty()); opsToErase.push_back(op); } diff --git a/flang/lib/Optimizer/Dialect/FIRDialect.cpp b/flang/lib/Optimizer/Dialect/FIRDialect.cpp index e1b636af517cd..c904e64a201f2 100644 --- a/flang/lib/Optimizer/Dialect/FIRDialect.cpp +++ b/flang/lib/Optimizer/Dialect/FIRDialect.cpp @@ -24,11 +24,17 @@ namespace { struct FIRInlinerInterface : public mlir::DialectInlinerInterface { using DialectInlinerInterface::DialectInlinerInterface; + bool isLegalToInline(mlir::Operation *call, mlir::Operation *callable, + bool wouldBeCloned) const final { + return fir::canLegallyInline(call, callable, wouldBeCloned); + } + /// This hook checks to see if the operation `op` is legal to inline into the /// given region `reg`. bool isLegalToInline(mlir::Operation *op, mlir::Region *reg, + bool wouldBeCloned, mlir::BlockAndValueMapping &map) const final { - return fir::canLegallyInline(op, reg, map); + return fir::canLegallyInline(op, reg, wouldBeCloned, map); } /// This hook is called when a terminator operation has been inlined. @@ -42,6 +48,13 @@ struct FIRInlinerInterface : public mlir::DialectInlinerInterface { for (const auto &it : llvm::enumerate(returnOp.getOperands())) valuesToRepl[it.index()].replaceAllUsesWith(it.value()); } + + mlir::Operation *materializeCallConversion(mlir::OpBuilder &builder, + mlir::Value input, + mlir::Type resultType, + mlir::Location loc) const { + return builder.create(loc, resultType, input); + } }; } // namespace diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp index 868984056f52e..2900e4357f509 100644 --- a/flang/lib/Optimizer/Dialect/FIROps.cpp +++ b/flang/lib/Optimizer/Dialect/FIROps.cpp @@ -556,17 +556,6 @@ static mlir::LogicalResult verify(fir::EmboxOp op) { return mlir::success(); } -/// Get the dims argument to the embox op. If there was no dims argument (i.e., -/// the box is on a scalar), then return an null value. -mlir::Value fir::EmboxOp::getDims() { - auto size = dims().size(); - if (size > 0) { - assert(size == 1 && "incorrect number of dims arguments"); - return *dims().begin(); - } - return {}; -} - //===----------------------------------------------------------------------===// // GenTypeDescOp //===----------------------------------------------------------------------===// @@ -1857,64 +1846,6 @@ void fir::IfOp::resultToSourceOps(llvm::SmallVectorImpl &results, results.push_back(term->getOperand(resultNum)); } -//===----------------------------------------------------------------------===// -// Internal ops -//===----------------------------------------------------------------------===// - -void fir::XArrayCoorOp::build(mlir::OpBuilder &builder, OperationState &result, - mlir::Type ty, mlir::Value memref, - mlir::ValueRange dims, mlir::ValueRange indices, - llvm::ArrayRef attr) { - result.addOperands(memref); - result.addOperands(dims); - result.addOperands(indices); - result.addTypes(ty); - result.addAttributes(attr); -} - -mlir::Operation::operand_range fir::XArrayCoorOp::dimsOperands() { - auto first = std::next(getOperation()->operand_begin()); - auto off = getAttrOfType(dimsAttrName()).getInt(); - return {first, first + off}; -} - -mlir::Operation::operand_range fir::XArrayCoorOp::indexOperands() { - auto off = getAttrOfType(dimsAttrName()).getInt(); - auto first = std::next(getOperation()->operand_begin() + off); - return {first, getOperation()->operand_end()}; -} - -unsigned fir::XArrayCoorOp::getRank() { - return getAttrOfType(rankAttrName()).getInt(); -} - -void fir::XEmboxOp::build(mlir::OpBuilder &builder, OperationState &result, - mlir::Type ty, mlir::Value memref, - mlir::ValueRange lenParams, mlir::ValueRange dims, - llvm::ArrayRef attr) { - result.addOperands(memref); - result.addOperands(lenParams); - result.addOperands(dims); - result.addTypes(ty); - result.addAttributes(attr); -} - -mlir::Operation::operand_range fir::XEmboxOp::lenParamOperands() { - auto first = std::next(getOperation()->operand_begin()); - auto off = getAttrOfType(lenParamAttrName()).getInt(); - return {first, first + off}; -} - -mlir::Operation::operand_range fir::XEmboxOp::dimsOperands() { - auto off = getAttrOfType(lenParamAttrName()).getInt(); - auto first = std::next(getOperation()->operand_begin() + off); - return {first, getOperation()->operand_end()}; -} - -unsigned fir::XEmboxOp::getRank() { - return getAttrOfType(rankAttrName()).getInt(); -} - //===----------------------------------------------------------------------===// mlir::ParseResult fir::isValidCaseAttr(mlir::Attribute attr) { diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index 8bbab851fd48a..4793015761fe2 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -236,7 +236,7 @@ bool analyzeCoordinate(mlir::Value coordinate) { bool AffineLoopAnalysis::analyzeArrayReference(mlir::Value arrayRef) { bool canPromote = true; if (auto acoOp = arrayRef.getDefiningOp()) { - for (auto coordinate : acoOp.coor()) + for (auto coordinate : acoOp.getIndices()) canPromote = canPromote && analyzeCoordinate(coordinate); } else { LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: cannot promote loop, " @@ -298,7 +298,7 @@ Optional constantIntegerLike(const mlir::Value value) { } mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) { - if (auto refType = op.ref().getType().dyn_cast_or_null()) { + if (auto refType = op.memref().getType().dyn_cast_or_null()) { if (auto seqType = refType.getEleTy().dyn_cast_or_null()) { return seqType.getEleTy(); } @@ -312,18 +312,30 @@ mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) { std::pair createAffineOps(mlir::Value arrayRef, mlir::PatternRewriter &rewriter) { auto acoOp = arrayRef.getDefiningOp(); - auto genDim = acoOp.dims().getDefiningOp(); + assert(acoOp.getShape() && isa(acoOp.getShape().getDefiningOp())); + auto genDim = acoOp.getShape().getDefiningOp(); auto affineMap = - createArrayIndexAffineMap(acoOp.coor().size(), acoOp.getContext()); + createArrayIndexAffineMap(acoOp.getIndices().size(), acoOp.getContext()); SmallVector indexArgs; - indexArgs.append(acoOp.coor().begin(), acoOp.coor().end()); - indexArgs.append(genDim.triples().begin(), genDim.triples().end()); + indexArgs.append(acoOp.getIndices().begin(), acoOp.getIndices().end()); + + // FIXME: quick hack for now (assumes 1 for the shift and stride) + auto iter = genDim.extents().begin(); + auto one = rewriter.create( + acoOp.getLoc(), rewriter.getIndexType(), rewriter.getIndexAttr(1)); + auto end = genDim.extents().size(); + for (decltype(end) i = 0; i < end; ++i) { + indexArgs.push_back(one); + indexArgs.push_back(*iter++); + indexArgs.push_back(one); + } + auto affineApply = rewriter.create(acoOp.getLoc(), affineMap, indexArgs); auto arrayElementType = coordinateArrayElement(acoOp); auto newType = mlir::MemRefType::get({-1}, arrayElementType); auto arrayConvert = - rewriter.create(acoOp.getLoc(), newType, acoOp.ref()); + rewriter.create(acoOp.getLoc(), newType, acoOp.memref()); return std::make_pair(affineApply, arrayConvert); } diff --git a/flang/test/Fir/affine-loop-fusion.fir b/flang/test/Fir/affine-loop-fusion.fir index 75b3537f047d2..637c6e95febf7 100644 --- a/flang/test/Fir/affine-loop-fusion.fir +++ b/flang/test/Fir/affine-loop-fusion.fir @@ -10,38 +10,37 @@ func @calc(%a1: !arr_d1, %a2: !arr_d1, %a3: !arr_d1) { %c1 = constant 1 : index %c0 = constant 0 : index %len = constant 100 : index - %dims = fir.gendims %c1, %len, %c1 - : (index, index, index) -> !fir.dims<1> + %dims = fir.shape %len : (index) -> !fir.shape<1> %siz = affine.apply #arr_len()[%c1,%len] %t1 = fir.alloca !fir.array, %siz fir.do_loop %i = %c1 to %len step %c1 { %a1_idx = fir.array_coor %a1(%dims) %i - : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + : (!arr_d1, !fir.shape<1>, index) -> !fir.ref %a1_v = fir.load %a1_idx : !fir.ref %a2_idx = fir.array_coor %a2(%dims) %i - : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + : (!arr_d1, !fir.shape<1>, index) -> !fir.ref %a2_v = fir.load %a2_idx : !fir.ref %v = addf %a1_v, %a2_v : f32 %t1_idx = fir.array_coor %t1(%dims) %i - : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + : (!arr_d1, !fir.shape<1>, index) -> !fir.ref fir.store %v to %t1_idx : !fir.ref } fir.do_loop %i = %c1 to %len step %c1 { %t1_idx = fir.array_coor %t1(%dims) %i - : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + : (!arr_d1, !fir.shape<1>, index) -> !fir.ref %t1_v = fir.load %t1_idx : !fir.ref %a2_idx = fir.array_coor %a2(%dims) %i - : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + : (!arr_d1, !fir.shape<1>, index) -> !fir.ref %a2_v = fir.load %a2_idx : !fir.ref %v = mulf %t1_v, %a2_v : f32 %a3_idx = fir.array_coor %a3(%dims) %i - : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + : (!arr_d1, !fir.shape<1>, index) -> !fir.ref fir.store %v to %a3_idx : !fir.ref } diff --git a/flang/test/Fir/affine-loop-unswitch.fir b/flang/test/Fir/affine-loop-unswitch.fir index aff51fc0301b8..ac7532cfc56ef 100644 --- a/flang/test/Fir/affine-loop-unswitch.fir +++ b/flang/test/Fir/affine-loop-unswitch.fir @@ -11,8 +11,7 @@ func @calc(%a: !arr_d1, %v: f32) { %c1 = constant 1 : index %c2 = constant 2 : index %len = constant 100 : index - %dims = fir.gendims %c1, %len, %c1 - : (index, index, index) -> !fir.dims<1> + %dims = fir.shape %len : (index) -> !fir.shape<1> fir.do_loop %i = %c1 to %len step %c1 { fir.do_loop %j = %c1 to %len step %c1 { @@ -21,14 +20,14 @@ func @calc(%a: !arr_d1, %v: f32) { %cond = cmpi "sgt", %im2, %c0 : index fir.if %cond { %a_idx = fir.array_coor %a(%dims) %i - : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + : (!arr_d1, !fir.shape<1>, index) -> !fir.ref fir.store %v to %a_idx : !fir.ref } %aj_idx = fir.array_coor %a(%dims) %j - : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + : (!arr_d1, !fir.shape<1>, index) -> !fir.ref fir.store %v to %aj_idx : !fir.ref %ak_idx = fir.array_coor %a(%dims) %k - : (!arr_d1, !fir.dims<1>, index) -> !fir.ref + : (!arr_d1, !fir.shape<1>, index) -> !fir.ref fir.store %v to %ak_idx : !fir.ref } } diff --git a/flang/test/Fir/box.fir b/flang/test/Fir/box.fir index 5d159f061b223..04ec2bbbe3689 100644 --- a/flang/test/Fir/box.fir +++ b/flang/test/Fir/box.fir @@ -36,14 +36,14 @@ func @fa(%a : !fir.ref>) { %c = fir.convert %a : (!fir.ref>) -> !fir.ref> %c1 = constant 1 : index %c100 = constant 100 : index - %d = fir.gendims %c1, %c100, %c1 : (index, index, index) -> !fir.dims<1> + %d = fir.shape %c100 : (index) -> !fir.shape<1> // CHECK: %[[GEP70:.*]] = getelementptr {{.*}}, i32 0, i32 7, i32 0, i32 0 // CHECK: store i64 {{.*}}, i64* %[[GEP70]] // CHECK: %[[GEP71:.*]] = getelementptr {{.*}}, i32 0, i32 7, i32 0, i32 1 // CHECK: store i64 {{.*}}, i64* %[[GEP71]] // CHECK: %[[GEP72:.*]] = getelementptr {{.*}}, i32 0, i32 7, i32 0, i32 2 // CHECK: store i64 {{.*}}, i64* %[[GEP72]] - %b = fir.embox %c, %d : (!fir.ref>, !fir.dims<1>) -> !fir.box> + %b = fir.embox %c(%d) : (!fir.ref>, !fir.shape<1>) -> !fir.box> // CHECK: call void @ga( fir.call @ga(%b) : (!fir.box>) -> () // CHECK: ret void diff --git a/flang/test/Fir/embox-write.fir b/flang/test/Fir/embox-write.fir index 66d85d4179ad4..8a51b83edf94e 100644 --- a/flang/test/Fir/embox-write.fir +++ b/flang/test/Fir/embox-write.fir @@ -5,8 +5,8 @@ func @set_all_n(%n : index, %x : i32) { %aTmp = fir.alloca i32, %n %aMem = fir.convert %aTmp : (!fir.ref) -> !fir.ref> %c1 = constant 1 : index - %aDim = fir.gendims %c1, %n, %c1 : (index, index, index) -> !fir.dims<1> - %a = fir.embox %aMem, %aDim : (!fir.ref>, !fir.dims<1>) -> !fir.box> + %aDim = fir.shape %n : (index) -> !fir.shape<1> + %a = fir.embox %aMem(%aDim) : (!fir.ref>, !fir.shape<1>) -> !fir.box> // CHECK-DAG: %[[IV:.*]] = phi i64 // CHECK-DAG: %[[LCV:.*]] = phi i64 // CHECK: icmp sgt i64 %[[LCV]], 0 From 19b28121caecc405c4fd7fd5f349090f470f7600 Mon Sep 17 00:00:00 2001 From: Sameeran joshi Date: Tue, 14 Jul 2020 17:10:11 +0530 Subject: [PATCH 0164/1017] [Porting] Port a sample test in not-test/ to test/Fir. This patch tries to gather the actual requirements of what is expected for upcoming patches. --- flang/{not-test/fir => test/Fir}/alloc.fir | 6 ++++++ 1 file changed, 6 insertions(+) rename flang/{not-test/fir => test/Fir}/alloc.fir (69%) diff --git a/flang/not-test/fir/alloc.fir b/flang/test/Fir/alloc.fir similarity index 69% rename from flang/not-test/fir/alloc.fir rename to flang/test/Fir/alloc.fir index e7c0d663c128b..3bb2da6769b62 100644 --- a/flang/not-test/fir/alloc.fir +++ b/flang/test/Fir/alloc.fir @@ -1,21 +1,27 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + func @f1() -> !fir.ref { +// CHECK: alloca i32, i64 1 %1 = fir.alloca i32 return %1 : !fir.ref } func @f2() -> !fir.ref { %0 = constant 100 : index +// CHECK: alloca i32, i64 100 %1 = fir.alloca i32, %0 return %1 : !fir.ref } func @f3() -> !fir.heap { +// CHECK: call i8* @malloc(i64 1) %1 = fir.allocmem i32 return %1 : !fir.heap } func @f4() -> !fir.heap { %0 = constant 100 : index +// CHECK: call i8* @malloc(i64 100) %1 = fir.allocmem i32, %0 return %1 : !fir.heap } From c4e84fb74401bae34e053f1b9a8e598c371eefbb Mon Sep 17 00:00:00 2001 From: Sameeran joshi Date: Tue, 14 Jul 2020 22:18:24 +0530 Subject: [PATCH 0165/1017] Add CHECK-LABEL from review comments. --- flang/test/Fir/alloc.fir | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/flang/test/Fir/alloc.fir b/flang/test/Fir/alloc.fir index 3bb2da6769b62..b69cf73a0fb44 100644 --- a/flang/test/Fir/alloc.fir +++ b/flang/test/Fir/alloc.fir @@ -1,11 +1,13 @@ // RUN: tco -emit-fir %s | tco | FileCheck %s +// CHECK-LABEL: define i32* @f1() func @f1() -> !fir.ref { // CHECK: alloca i32, i64 1 %1 = fir.alloca i32 return %1 : !fir.ref } +// CHECK-LABEL: define i32* @f2() func @f2() -> !fir.ref { %0 = constant 100 : index // CHECK: alloca i32, i64 100 @@ -13,12 +15,14 @@ func @f2() -> !fir.ref { return %1 : !fir.ref } +// CHECK-LABEL: define i32* @f3() func @f3() -> !fir.heap { // CHECK: call i8* @malloc(i64 1) %1 = fir.allocmem i32 return %1 : !fir.heap } +// CHECK-LABEL: define i32* @f4() func @f4() -> !fir.heap { %0 = constant 100 : index // CHECK: call i8* @malloc(i64 100) From e4fb68701dc1cd6ac677827cd0efc0b7c49e36ca Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 14 Jul 2020 19:19:17 -0700 Subject: [PATCH 0166/1017] fix standard option handling --- flang/tools/bbc/bbc.cpp | 3 +++ 1 file changed, 3 insertions(+) diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index e9218b93480e7..55510a4b84a4d 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -33,6 +33,7 @@ #include "flang/Semantics/semantics.h" #include "flang/Semantics/unparse-with-symbols.h" #include "mlir/Conversion/SCFToStandard/SCFToStandard.h" +#include "mlir/IR/AsmState.h" #include "mlir/IR/MLIRContext.h" #include "mlir/IR/Module.h" #include "mlir/Parser.h" @@ -280,6 +281,8 @@ int main(int argc, char **argv) { fir::registerOptPasses(); [[maybe_unused]] llvm::InitLLVM y(argc, argv); + mlir::registerAsmPrinterCLOptions(); + mlir::registerMLIRContextCLOptions(); mlir::registerPassManagerCLOptions(); mlir::PassPipelineCLParser passPipe("", "Compiler passes to run"); llvm::cl::ParseCommandLineOptions(argc, argv, "Burnside Bridge Compiler\n"); From c5dd63dfb055e13f211b17f6487871126c1bbc3d Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 14 Jul 2020 14:05:08 -0700 Subject: [PATCH 0167/1017] Extend !fir.char to improve disambiguation of CHARACTER type representation. Theextension is not presently used. However, the plan will be to experiment and see if it helps simplify lowering. --- flang/lib/Lower/Bridge.cpp | 4 ++++ flang/lib/Optimizer/CodeGen/CodeGen.cpp | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 0ded5cf1b2000..281ec2a9ccb67 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #include "flang/Lower/Bridge.h" #include "../../runtime/iostat.h" diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 0ff3600e72c5b..bbba6ba7d3a7c 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #include "flang/Optimizer/CodeGen/CodeGen.h" #include "DescriptorModel.h" From 6ee079bbfe0dcaa5572f32b86c88b1669705d61f Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Thu, 16 Jul 2020 17:54:52 +0530 Subject: [PATCH 0168/1017] [Porting] Port tests from not-tests/FIR to tests/FIR. Some tests were running well, others had to change FIR as it was changed in the meanwhile. So the tests were portred initially and then LIT checks were added. fir-dt.fir was used in some other test, hence removing it to avoid duplication. Two tests(embox, character) need some attention about the way the FIR is changed is that what is expected? Two more tests (aggregate, dynlayout) execute TODO(). I shall file issues for them seperately. --- flang/not-test/fir/fir-dt.fir | 5 ---- flang/test/Fir/arrayset.fir | 24 +++++++++++++++++++ flang/test/Fir/character.fir | 17 ++++++++++++++ flang/test/Fir/commute.fir | 34 +++++++++++++++++++++++++++ flang/test/Fir/compare.fir | 44 +++++++++++++++++++++++++++++++++++ flang/test/Fir/constant.fir | 26 +++++++++++++++++++++ flang/test/Fir/embox.fir | 10 ++++++++ 7 files changed, 155 insertions(+), 5 deletions(-) delete mode 100644 flang/not-test/fir/fir-dt.fir create mode 100644 flang/test/Fir/arrayset.fir create mode 100644 flang/test/Fir/character.fir create mode 100644 flang/test/Fir/commute.fir create mode 100644 flang/test/Fir/compare.fir create mode 100644 flang/test/Fir/constant.fir create mode 100644 flang/test/Fir/embox.fir diff --git a/flang/not-test/fir/fir-dt.fir b/flang/not-test/fir/fir-dt.fir deleted file mode 100644 index 7dbd6bd131879..0000000000000 --- a/flang/not-test/fir/fir-dt.fir +++ /dev/null @@ -1,5 +0,0 @@ -func @method_impl(!fir.box>) - -fir.dispatch_table @dispatch_tbl { - fir.dt_entry method, @method_impl -} diff --git a/flang/test/Fir/arrayset.fir b/flang/test/Fir/arrayset.fir new file mode 100644 index 0000000000000..b5556f90b1851 --- /dev/null +++ b/flang/test/Fir/arrayset.fir @@ -0,0 +1,24 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// CHECK-LABEL: define void @x([10 x float]* %0) +func @x(%arr : !fir.ref>) { + %1 = constant 0 : index + %2 = constant 9 : index + %stepvar = constant 1 : index + // CHECK: alloca [10 x float], i64 1 + %a = fir.alloca !fir.array<10xf32> + fir.do_loop %iv = %1 to %2 step %stepvar unordered { + %3 = fir.coordinate_of %arr, %iv : (!fir.ref>, index) -> !fir.ref + // CHECK: %[[reg10:.*]] = load float, float* + %4 = fir.load %3 : !fir.ref + // CHECK: %[[reg11:.*]] = getelementptr [10 x float], [10 x float]* + %5 = fir.coordinate_of %a, %iv : (!fir.ref>, index) -> !fir.ref + // CHECK: store float %[[reg10]], float* %[[reg11]] + fir.store %4 to %5 : !fir.ref + } + %6 = fir.embox %a : (!fir.ref>) -> !fir.box> + fir.call @y(%6) : (!fir.box>) -> () + return +} + +func @y(!fir.box>) -> () diff --git a/flang/test/Fir/character.fir b/flang/test/Fir/character.fir new file mode 100644 index 0000000000000..e286e60e2dc20 --- /dev/null +++ b/flang/test/Fir/character.fir @@ -0,0 +1,17 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s +// UNSUPPORTED: !fir + +// CHECK-LABEL: define +func @get_name() -> !fir.boxchar<1> { + %j1 = fir.address_of (@name_constant) : !fir.ref> + %j2 = constant 9 : i64 + %j3 = fir.emboxchar %j1, %j2 : (!fir.ref>, i64) -> !fir.boxchar<1> + return %j3 : !fir.boxchar<1> +} +fir.global @name constant : !fir.array<9x!fir.char<1>> { + %str = fir.string_lit "Your name"(9) : !fir.char<1> + //constant 1 + fir.has_value %str : !fir.array<9x!fir.char<1>> +} + + diff --git a/flang/test/Fir/commute.fir b/flang/test/Fir/commute.fir new file mode 100644 index 0000000000000..ab2fe75145f4c --- /dev/null +++ b/flang/test/Fir/commute.fir @@ -0,0 +1,34 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// CHECK-LABEL: define i32 @f1(i32 %0, i32 %1) +func @f1(%a : i32, %b : i32) -> i32 { + + // CHECK: %[[reg3:.*]] = add i32 %0, %1 + %1 = addi %a, %b : i32 + %2 = addi %b, %a : i32 + // CHECK: mul i32 %[[reg3]], %[[reg3]], !dbg !9 + %3 = muli %1, %2 : i32 + return %3 : i32 +} + +// CHECK-LABEL: define i32 @f2(i32* %0) +func @f2(%a : !fir.ref) -> i32 { + %1 = fir.load %a : !fir.ref + // CHECK: %[[r2:.*]] = load + %2 = fir.load %a : !fir.ref + // CHECK: %[[r3:.*]] = add i32 %[[r2]], %[[r2]] + %3 = addi %1, %2 : i32 + %4 = fir.load %a : !fir.ref + // CHECK: %[[r4:.*]] = add i32 %[[r3]], %[[r2]] + %5 = addi %3, %4 : i32 + %6 = fir.load %a : !fir.ref + // CHECK: %[[r5:.*]] = add i32 %[[r4]], %[[r2]] + %7 = addi %5, %6 : i32 + %8 = fir.load %a : !fir.ref + // CHECK: %[[r6:.*]] = add i32 %[[r5]], %[[r2]] + %9 = addi %7, %8 : i32 + %10 = fir.load %a : !fir.ref + // CHECK: %[[r7:.*]] = add i32 %[[r2]], %[[r6]] + %11 = addi %10, %9 : i32 + return %11 : i32 +} diff --git a/flang/test/Fir/compare.fir b/flang/test/Fir/compare.fir new file mode 100644 index 0000000000000..f569c97a49b5b --- /dev/null +++ b/flang/test/Fir/compare.fir @@ -0,0 +1,44 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// CHECK-LABEL: define i1 @cmp(x86_fp80 %0, x86_fp80 %1) +func @cmp(%a : !fir.real<10>, %b : !fir.real<10>) -> i1 { +// CHECK: fcmp oeq x86_fp80 %0, %1 + %1 = "fir.cmpf"(%a, %b) {predicate = 1} : (!fir.real<10>, !fir.real<10>) -> i1 + return %1 : i1 +} + +// CHECK-LABEL: define i1 @cmp2(fp128 %0, fp128 %1) +func @cmp2(%a : !fir.real<16>, %b : !fir.real<16>) -> i1 { + // CHECK: fcmp ult fp128 %0, %1 + %1 = fir.cmpf "ult", %a, %b : !fir.real<16> + return %1 : i1 +} + +// CHECK-LABEL: define i1 @cmp3({ float, float } %0, { float, float } %1) +func @cmp3(%a : !fir.complex<4>, %b : !fir.complex<4>) -> i1 { + // CHECK: fcmp ueq float + %1 = fir.cmpc "ueq", %a, %b : !fir.complex<4> + return %1 : i1 +} + +// CHECK-LABEL: define double @neg1(double %0) +func @neg1(%a : !fir.real<8>) -> !fir.real<8> { + // CHECK: fneg double %0 + %1 = "fir.negf"(%a) : (!fir.real<8>) -> !fir.real<8> + return %1 : !fir.real<8> +} + +// CHECK-LABEL: define double @neg2(double %0) +func @neg2(%a : !fir.real<8>) -> !fir.real<8> { + // CHECK: fneg double %0 + %1 = fir.negf %a : !fir.real<8> + return %1 : !fir.real<8> +} + +// CHECK-LABEL: define { double, double } @neg3({ double, double } %0) +func @neg3(%a : !fir.complex<8>) -> !fir.complex<8> { +// CHECK: %[[r3:.*]] = fneg double +// CHECK: insertvalue { double, double } %0, double %[[r3]] + %1 = fir.negc %a : !fir.complex<8> + return %1 : !fir.complex<8> +} diff --git a/flang/test/Fir/constant.fir b/flang/test/Fir/constant.fir new file mode 100644 index 0000000000000..aff4afae35877 --- /dev/null +++ b/flang/test/Fir/constant.fir @@ -0,0 +1,26 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// CHECK-LABEL: define [3 x i8] @x +func @x() -> !fir.array<3x!fir.char<1>> { + %1 = fir.string_lit "xyz"(3) : !fir.char<1> + // CHECK: ret [3 x i8] c"xyz" + return %1 : !fir.array<3x!fir.char<1>> +} + +// CHECK-LABEL: define x86_fp80 @y() +func @y() -> !fir.real<10> { + %c1 = constant 42.4 :f32 + %0 = fir.convert %c1 : (f32) -> !fir.real<10> + // CHECK: ret x86_fp80 0xK4004A9999A0000000000 + // TODO: What's that number? + return %0 : !fir.real<10> +} + +// CHECK-LABEL: define i16 @z() +func @z() -> !fir.logical<2> { + %1 = constant true + %0 = fir.convert %1 : (i1) -> !fir.logical<2> + // CHECK-LABEL: ret i16 -1 + // TODO: Why is it -1? + return %0 : !fir.logical<2> +} diff --git a/flang/test/Fir/embox.fir b/flang/test/Fir/embox.fir new file mode 100644 index 0000000000000..be9bd06b7315c --- /dev/null +++ b/flang/test/Fir/embox.fir @@ -0,0 +1,10 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// TODO: Is test correct? +// CHECK-LABEL: define void @f(double* %0) +func @f(%arg : !fir.ref>) { + %c1000 = constant 1000 : index + %aDim = fir.shape %c1000 : (index) -> !fir.shape<1> + %2 = fir.embox %arg(%aDim) : (!fir.ref>, !fir.shape<1>) -> !fir.box> + return +} From 9b7af230ca02e0dd7af12b70ce8a6736cadfa70d Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Thu, 16 Jul 2020 18:04:19 +0530 Subject: [PATCH 0169/1017] remove files in not-tests/ --- flang/not-test/fir/arrayset.fir | 16 ---------------- flang/not-test/fir/character.fir | 12 ------------ flang/not-test/fir/commute.fir | 21 --------------------- flang/not-test/fir/compare.fir | 29 ----------------------------- flang/not-test/fir/constant.fir | 19 ------------------- flang/not-test/fir/dynlayout.fir | 2 -- flang/not-test/fir/embox.fir | 6 ------ 7 files changed, 105 deletions(-) delete mode 100644 flang/not-test/fir/arrayset.fir delete mode 100644 flang/not-test/fir/character.fir delete mode 100644 flang/not-test/fir/commute.fir delete mode 100644 flang/not-test/fir/compare.fir delete mode 100644 flang/not-test/fir/constant.fir delete mode 100644 flang/not-test/fir/embox.fir diff --git a/flang/not-test/fir/arrayset.fir b/flang/not-test/fir/arrayset.fir deleted file mode 100644 index 2f45aabb0da73..0000000000000 --- a/flang/not-test/fir/arrayset.fir +++ /dev/null @@ -1,16 +0,0 @@ -func @x(%arr : !fir.ref>) { - %1 = constant 0 : index - %2 = constant 9 : index - %a = fir.alloca !fir.array<10xf32> - fir.loop %iv = %1 to %2 unordered { - %3 = fir.coordinate_of %arr, %iv : (!fir.ref>, index) -> !fir.ref - %4 = fir.load %3 : !fir.ref - %5 = fir.coordinate_of %a, %iv : (!fir.ref>, index) -> !fir.ref - fir.store %4 to %5 : !fir.ref - } { arrayset } - %6 = fir.embox %a : (!fir.ref>) -> !fir.box> - fir.call @y(%6) : (!fir.box>) -> () - return -} - -func @y(!fir.box>) -> () diff --git a/flang/not-test/fir/character.fir b/flang/not-test/fir/character.fir deleted file mode 100644 index c4a11a607d7a0..0000000000000 --- a/flang/not-test/fir/character.fir +++ /dev/null @@ -1,12 +0,0 @@ - -fir.global @name constant : !fir.char<1> { - constant "Your name" - //constant 1 -} - -func @get_name() -> !fir.boxchar<1> { - %j1 = fir.address_of (@name_constant) : !fir.ref> - %j2 = constant 9 : i64 - %j3 = fir.emboxchar %j1, %j2 : (!fir.ref>, i64) -> !fir.boxchar<1> - return %j3 : !fir.boxchar<1> -} diff --git a/flang/not-test/fir/commute.fir b/flang/not-test/fir/commute.fir deleted file mode 100644 index 6e55bb0e36bee..0000000000000 --- a/flang/not-test/fir/commute.fir +++ /dev/null @@ -1,21 +0,0 @@ -func @f1(%a : i32, %b : i32) -> i32 { - %1 = addi %a, %b : i32 - %2 = addi %b, %a : i32 - %3 = muli %1, %2 : i32 - return %3 : i32 -} - -func @f2(%a : !fir.ref) -> i32 { - %1 = fir.load %a : !fir.ref - %2 = fir.load %a : !fir.ref - %3 = addi %1, %2 : i32 - %4 = fir.load %a : !fir.ref - %5 = addi %3, %4 : i32 - %6 = fir.load %a : !fir.ref - %7 = addi %5, %6 : i32 - %8 = fir.load %a : !fir.ref - %9 = addi %7, %8 : i32 - %10 = fir.load %a : !fir.ref - %11 = addi %10, %9 : i32 - return %11 : i32 -} diff --git a/flang/not-test/fir/compare.fir b/flang/not-test/fir/compare.fir deleted file mode 100644 index 8aa9f6864dc18..0000000000000 --- a/flang/not-test/fir/compare.fir +++ /dev/null @@ -1,29 +0,0 @@ -func @cmp(%a : !fir.real<10>, %b : !fir.real<10>) -> i1 { - %1 = "fir.cmpf"(%a, %b) {predicate = 1} : (!fir.real<10>, !fir.real<10>) -> i1 - return %1 : i1 -} - -func @cmp2(%a : !fir.real<16>, %b : !fir.real<16>) -> i1 { - %1 = fir.cmpf "ult", %a, %b : !fir.real<16> - return %1 : i1 -} - -func @cmp3(%a : !fir.complex<4>, %b : !fir.complex<4>) -> i1 { - %1 = fir.cmpc "ueq", %a, %b : !fir.complex<4> - return %1 : i1 -} - -func @neg1(%a : !fir.real<8>) -> !fir.real<8> { - %1 = "fir.negf"(%a) : (!fir.real<8>) -> !fir.real<8> - return %1 : !fir.real<8> -} - -func @neg2(%a : !fir.real<8>) -> !fir.real<8> { - %1 = fir.negf %a : !fir.real<8> - return %1 : !fir.real<8> -} - -func @neg3(%a : !fir.complex<8>) -> !fir.complex<8> { - %1 = fir.negc %a : !fir.complex<8> - return %1 : !fir.complex<8> -} diff --git a/flang/not-test/fir/constant.fir b/flang/not-test/fir/constant.fir deleted file mode 100644 index 67ca40f36611a..0000000000000 --- a/flang/not-test/fir/constant.fir +++ /dev/null @@ -1,19 +0,0 @@ -func @x() -> !fir.array<3x!fir.char<1>> { - %1 = fir.constant "xyz" : !fir.array<3x!fir.char<1>> - return %1 : !fir.array<3x!fir.char<1>> -} - -func @y() -> !fir.real<10> { - %1 = fir.constant "42.4" : !fir.real<10> - return %1 : !fir.real<10> -} - -func @z() -> !fir.logical<1> { - %1 = fir.constant "true" : !fir.logical<1> - return %1 : !fir.logical<1> -} - -func @z2() -> !fir.ref> { - %1 = fir.constant "abc" : !fir.ref> - return %1 : !fir.ref> -} diff --git a/flang/not-test/fir/dynlayout.fir b/flang/not-test/fir/dynlayout.fir index 5646db53975e8..6349684cf8306 100644 --- a/flang/not-test/fir/dynlayout.fir +++ b/flang/not-test/fir/dynlayout.fir @@ -1,5 +1,3 @@ -// dynamic case - // dynamically sized type func @_QQSIZEOF_a(%p1 : i64, %p2 : i64) -> i64 { %c1 = constant 1 : i64 // sizeof CHARACTER(1) diff --git a/flang/not-test/fir/embox.fir b/flang/not-test/fir/embox.fir deleted file mode 100644 index 801e7241b4245..0000000000000 --- a/flang/not-test/fir/embox.fir +++ /dev/null @@ -1,6 +0,0 @@ -#x0 = (d0, d1) -> (d1, d0) - -func @f(%arg : !fir.ref>) { - %1 = fir.embox %arg [#x0] : (!fir.ref>) -> !fir.box, > - return -} From 33c90ec21075ed2a52ffa05b6475f70ba962e411 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 16 Jul 2020 14:55:39 -0700 Subject: [PATCH 0170/1017] fix test to not fail --- flang/test/Fir/boxchar.fir | 23 +++++++++++++++++++++++ flang/test/Fir/character.fir | 17 ----------------- 2 files changed, 23 insertions(+), 17 deletions(-) create mode 100644 flang/test/Fir/boxchar.fir delete mode 100644 flang/test/Fir/character.fir diff --git a/flang/test/Fir/boxchar.fir b/flang/test/Fir/boxchar.fir new file mode 100644 index 0000000000000..c5ac9ceb1ef60 --- /dev/null +++ b/flang/test/Fir/boxchar.fir @@ -0,0 +1,23 @@ +// RUN: tco %s | FileCheck %s + +// Test of building and passing boxchar. +// TODO: split argument into two distinct parameters. + +func @callee(%x : !fir.boxchar<1>) + +// CHECK-LABEL: define void @get_name +func @get_name() { + %1 = fir.address_of (@name) : !fir.ref>> + %2 = constant 9 : i64 + %3 = fir.convert %1 : (!fir.ref>>) -> !fir.ref> + %4 = fir.emboxchar %3, %2 : (!fir.ref>, i64) -> !fir.boxchar<1> + // CHECK: call void @callee({ i8*, i64 } { i8* getelementptr inbounds ([9 x i8], [9 x i8]* @name, i32 0, i32 0), i64 9 }) + fir.call @callee(%4) : (!fir.boxchar<1>) -> () + return +} + +fir.global @name constant : !fir.array<9x!fir.char<1>> { + %str = fir.string_lit "Your name"(9) : !fir.char<1> + //constant 1 + fir.has_value %str : !fir.array<9x!fir.char<1>> +} diff --git a/flang/test/Fir/character.fir b/flang/test/Fir/character.fir deleted file mode 100644 index e286e60e2dc20..0000000000000 --- a/flang/test/Fir/character.fir +++ /dev/null @@ -1,17 +0,0 @@ -// RUN: tco -emit-fir %s | tco | FileCheck %s -// UNSUPPORTED: !fir - -// CHECK-LABEL: define -func @get_name() -> !fir.boxchar<1> { - %j1 = fir.address_of (@name_constant) : !fir.ref> - %j2 = constant 9 : i64 - %j3 = fir.emboxchar %j1, %j2 : (!fir.ref>, i64) -> !fir.boxchar<1> - return %j3 : !fir.boxchar<1> -} -fir.global @name constant : !fir.array<9x!fir.char<1>> { - %str = fir.string_lit "Your name"(9) : !fir.char<1> - //constant 1 - fir.has_value %str : !fir.array<9x!fir.char<1>> -} - - From 2fa105e781e1f0fdd88091e01eba80afc79e8113 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 16 Jul 2020 18:12:13 -0700 Subject: [PATCH 0171/1017] fix bustage and fallout from rebase --- flang/lib/Evaluate/CMakeLists.txt | 1 + flang/lib/Lower/CMakeLists.txt | 2 ++ flang/lib/Semantics/CMakeLists.txt | 1 + 3 files changed, 4 insertions(+) diff --git a/flang/lib/Evaluate/CMakeLists.txt b/flang/lib/Evaluate/CMakeLists.txt index a2fdc10896b43..bebd6ce8ca758 100644 --- a/flang/lib/Evaluate/CMakeLists.txt +++ b/flang/lib/Evaluate/CMakeLists.txt @@ -50,5 +50,6 @@ add_flang_library(FortranEvaluate DEPENDS acc_gen omp_gen + acc_gen ) diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt index 0a893a04e15a8..d2df8cf4e2e80 100644 --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -24,6 +24,8 @@ add_flang_library(FortranLower DEPENDS FIROptimizer ${dialect_libs} + omp_gen + acc_gen LINK_LIBS FIROptimizer diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt index 4bab4b16149db..cdd5b08b0baa9 100644 --- a/flang/lib/Semantics/CMakeLists.txt +++ b/flang/lib/Semantics/CMakeLists.txt @@ -47,6 +47,7 @@ add_flang_library(FortranSemantics DEPENDS acc_gen omp_gen + acc_gen LINK_LIBS FortranCommon From 089b7af2a5f87371218b376aeb4426f73dddfac0 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 14 Jul 2020 19:16:41 -0700 Subject: [PATCH 0172/1017] Work on array of character globals. --- flang/include/flang/Lower/CharacterExpr.h | 1 + flang/include/flang/Lower/ConvertExpr.h | 3 + flang/include/flang/Lower/FIRBuilder.h | 3 + flang/lib/Lower/Bridge.cpp | 31 +++-- flang/lib/Lower/CharacterExpr.cpp | 32 +++-- flang/lib/Lower/ConvertExpr.cpp | 162 ++++++++++++++-------- flang/lib/Lower/FIRBuilder.cpp | 5 + flang/lib/Optimizer/CodeGen/CodeGen.cpp | 9 ++ flang/test/Fir/char01.fir | 3 +- flang/test/Fir/coordinateof.fir | 4 +- flang/test/Lower/array.f90 | 7 +- flang/test/Lower/character-assignment.f90 | 37 +++-- flang/test/Lower/concat.f90 | 16 ++- 13 files changed, 207 insertions(+), 106 deletions(-) diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index 6f75448a5dbbf..8840ec39b6f94 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -123,6 +123,7 @@ class CharacterExprHelper { fir::CharBoxValue materializeValue(const fir::CharBoxValue &str); fir::CharBoxValue toDataLengthPair(mlir::Value character); mlir::Type getReferenceType(const fir::CharBoxValue &c) const; + mlir::Type getSeqTy(const fir::CharBoxValue &c) const; mlir::Value createEmbox(const fir::CharBoxValue &str); mlir::Value createLoadCharAt(const fir::CharBoxValue &str, mlir::Value index); void createStoreCharAt(const fir::CharBoxValue &str, mlir::Value index, diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h index fb4c1eed8e0f7..23d1ed0fd2a7a 100644 --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -61,10 +61,13 @@ class ExpressionContext { : loopVars{lcvs.begin(), lcvs.end()} {} bool inArrayContext() const { return loopVars.size() > 0; } + bool inInitializer() const { return isInitializer; } const std::vector &getLoopVars() const { return loopVars; } + void setInInitializer() { isInitializer = true; } private: std::vector loopVars{}; + bool isInitializer{false}; }; /// Create an expression. diff --git a/flang/include/flang/Lower/FIRBuilder.h b/flang/include/flang/Lower/FIRBuilder.h index fe56fe68e4628..ecfa88a5ea06a 100644 --- a/flang/include/flang/Lower/FIRBuilder.h +++ b/flang/include/flang/Lower/FIRBuilder.h @@ -69,6 +69,9 @@ class FirOpBuilder : public mlir::OpBuilder { /// Safely create a reference type to the type `eleTy`. mlir::Type getRefType(mlir::Type eleTy); + /// Create a 1-dimensional sequence of `eleTy` of unknown size. + mlir::Type getVarLenSeqTy(mlir::Type eleTy); + /// Create a null constant of type RefType and value 0. Need to pass in the /// Location information. mlir::Value createNullConstant(mlir::Location loc); diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 281ec2a9ccb67..22d6ac1393650 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -108,7 +108,8 @@ static bool isExplicitShape(const Fortran::semantics::Symbol &sym) { // Retrieve a copy of a character literal string from a SomeExpr. template -llvm::Optional> getCharacterLiteralCopy( +static llvm::Optional> +getCharacterLiteralCopy( const Fortran::evaluate::Expr< Fortran::evaluate::Type> &x) { @@ -122,12 +123,14 @@ llvm::Optional> getCharacterLiteralCopy( (std::size_t)con->LEN()}; return llvm::None; } -llvm::Optional> getCharacterLiteralCopy( +static llvm::Optional> +getCharacterLiteralCopy( const Fortran::evaluate::Expr &x) { return std::visit([](const auto &e) { return getCharacterLiteralCopy(e); }, x.u); } -llvm::Optional> getCharacterLiteralCopy( +static llvm::Optional> +getCharacterLiteralCopy( const Fortran::evaluate::Expr &x) { if (const auto *e = Fortran::evaluate::UnwrapExpr< Fortran::evaluate::Expr>(x)) @@ -135,7 +138,7 @@ llvm::Optional> getCharacterLiteralCopy( return llvm::None; } template -llvm::Optional> +static llvm::Optional> getCharacterLiteralCopy(const std::optional &x) { if (x) return getCharacterLiteralCopy(*x); @@ -1328,6 +1331,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } + fir::ExtendedValue + genInitializerExprValue(const Fortran::lower::SomeExpr &expr) { + Fortran::lower::ExpressionContext context; + context.setInInitializer(); + return createSomeExtendedExpression(toLocation(), *this, expr, localSymbols, + context); + } + fir::ExtendedValue genExprEleValue(const Fortran::lower::SomeExpr &expr, llvm::ArrayRef lcvs) { return createSomeExtendedExpression(toLocation(), *this, expr, localSymbols, @@ -1587,7 +1598,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { bool isConst = sym.attrs().test(Fortran::semantics::Attr::PARAMETER); auto loc = genLocation(sym.name()); auto idxTy = builder->getIndexType(); - // FIXME: name returned does not consider subprogram's scope, is not unique if (builder->getNamedGlobal(globalName)) return; if (const auto *details = @@ -1614,8 +1624,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { global = builder->createGlobal( loc, symTy, globalName, isConst, [&](Fortran::lower::FirOpBuilder &builder) { - auto initVal = genExprValue(details->init().value()); - auto castTo = builder.createConvert(loc, symTy, initVal); + auto initVal = genInitializerExprValue(details->init().value()); + auto castTo = + builder.createConvert(loc, symTy, fir::getBase(initVal)); builder.create(loc, castTo); }); } @@ -1979,8 +1990,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { addSymbol(common, commonAddr); } auto byteOffset = varSym.offset(); - auto i8Ptr = fir::ReferenceType::get(builder->getIntegerType(8)); - auto base = builder->createConvert(loc, i8Ptr, commonAddr); + auto i8Ty = builder->getIntegerType(8); + auto i8Ptr = fir::ReferenceType::get(i8Ty); + auto seqTy = fir::ReferenceType::get(builder->getVarLenSeqTy(i8Ty)); + auto base = builder->createConvert(loc, seqTy, commonAddr); llvm::SmallVector offs{builder->createIntegerConstant( loc, builder->getIndexType(), byteOffset)}; auto varAddr = builder->create(loc, i8Ptr, base, offs); diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index ab720475183cf..4465f041376e7 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -79,7 +79,7 @@ Fortran::lower::CharacterExprHelper::toExtendedValue(mlir::Value character, auto lenType = getLengthType(); auto type = character.getType(); auto base = character; - mlir::Value resultLen = len; + auto resultLen = len; llvm::SmallVector extents; if (auto refType = type.dyn_cast()) @@ -129,12 +129,20 @@ Fortran::lower::CharacterExprHelper::toExtendedValue(mlir::Value character, return fir::CharBoxValue{base, resultLen}; } -/// Get fir.ref> type. +/// Get canonical `!fir.ref>` type. mlir::Type Fortran::lower::CharacterExprHelper::getReferenceType( const fir::CharBoxValue &box) const { return builder.getRefType(getCharacterType(box)); } +mlir::Type Fortran::lower::CharacterExprHelper::getSeqTy( + const fir::CharBoxValue &box) const { + auto ty = box.getBuffer().getType(); + if (ty.isa()) + return ty; + return builder.getRefType(builder.getVarLenSeqTy(getCharacterType(box))); +} + mlir::Value Fortran::lower::CharacterExprHelper::createEmbox(const fir::CharBoxValue &box) { // BoxChar require a reference. @@ -144,16 +152,11 @@ Fortran::lower::CharacterExprHelper::createEmbox(const fir::CharBoxValue &box) { auto kind = getCharacterType(str).getFKind(); auto boxCharType = fir::BoxCharType::get(builder.getContext(), kind); auto refType = getReferenceType(str); - // So far, fir.emboxChar fails lowering to llvm when it is given - // fir.ref>> types, so convert to - // fir.ref> if needed. - auto buff = str.getBuffer(); - buff = builder.createConvert(loc, refType, buff); + auto buff = builder.createConvert(loc, refType, str.getBuffer()); // Convert in case the provided length is not of the integer type that must // be used in boxchar. auto lenType = getLengthType(); - auto len = str.getLen(); - len = builder.createConvert(loc, lenType, len); + auto len = builder.createConvert(loc, lenType, str.getLen()); return builder.create(loc, boxCharType, buff, len); } @@ -163,16 +166,18 @@ mlir::Value Fortran::lower::CharacterExprHelper::createLoadCharAt( // the single character. if (str.getBuffer().getType().isa()) return str.getBuffer(); + auto buff = builder.createConvert(loc, getSeqTy(str), str.getBuffer()); auto addr = builder.create(loc, getReferenceType(str), - str.getBuffer(), index); + buff, index); return builder.create(loc, addr); } void Fortran::lower::CharacterExprHelper::createStoreCharAt( const fir::CharBoxValue &str, mlir::Value index, mlir::Value c) { assert(!needToMaterialize(str) && "not in memory"); + auto buff = builder.createConvert(loc, getSeqTy(str), str.getBuffer()); auto addr = builder.create(loc, getReferenceType(str), - str.getBuffer(), index); + buff, index); builder.create(loc, c, addr); } @@ -300,7 +305,7 @@ fir::CharBoxValue Fortran::lower::CharacterExprHelper::createSubstring( if (needToMaterialize(box)) str = materializeValue(box); - auto nbounds{bounds.size()}; + auto nbounds = bounds.size(); if (nbounds < 1 || nbounds > 2) { mlir::emitError(loc, "Incorrect number of bounds in substring"); return {mlir::Value{}, mlir::Value{}}; @@ -316,8 +321,9 @@ fir::CharBoxValue Fortran::lower::CharacterExprHelper::createSubstring( auto idxType = builder.getIndexType(); if (offset.getType() != idxType) offset = builder.createConvert(loc, idxType, offset); + auto buff = builder.createConvert(loc, getSeqTy(str), str.getBuffer()); auto substringRef = builder.create( - loc, getReferenceType(str), str.getBuffer(), offset); + loc, getReferenceType(str), buff, offset); // Compute the length. mlir::Value substringLen{}; diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index fb2d58bb9ec8b..4879c7d70890c 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -42,10 +42,9 @@ class ExprLowering { explicit ExprLowering(mlir::Location loc, Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &map, - const Fortran::lower::ExpressionContext &context - ) + const Fortran::lower::ExpressionContext &context) : location{loc}, converter{converter}, - builder{converter.getFirOpBuilder()}, symMap{map}, context{context} {} + builder{converter.getFirOpBuilder()}, symMap{map}, exprCtx{context} {} /// Lower the expression `expr` into MLIR standard dialect mlir::Value genAddr(const Fortran::lower::SomeExpr &expr) { @@ -73,7 +72,7 @@ class ExprLowering { Fortran::lower::AbstractConverter &converter; Fortran::lower::FirOpBuilder &builder; Fortran::lower::SymMap &symMap; - const Fortran::lower::ExpressionContext &context; + const Fortran::lower::ExpressionContext &exprCtx; mlir::Location getLoc() { return location; } @@ -316,8 +315,10 @@ class ExprLowering { if (inArrayContext()) { // FIXME: make this more robust auto base = fir::getBase(var); - auto ty = builder.getRefType(peelType(base.getType(), context.getLoopVars().size() + 1)); - auto coor = builder.create(getLoc(), ty, base, context.getLoopVars()); + auto ty = builder.getRefType( + peelType(base.getType(), exprCtx.getLoopVars().size() + 1)); + auto coor = builder.create(getLoc(), ty, base, + exprCtx.getLoopVars()); return genLoad(coor); } return var; @@ -685,8 +686,30 @@ class ExprLowering { int64_t len) { auto type = fir::SequenceType::get( {len}, fir::CharacterType::get(builder.getContext(), KIND)); - // FIXME: for wider char types, use an array of i16 or i32 - // for now, just fake it that it's a i8 to get it past the C++ compiler + auto consLit = [&]() -> fir::StringLitOp { + auto context = builder.getContext(); + auto strAttr = + mlir::StringAttr::get((const char *)value.c_str(), context); + auto valTag = mlir::Identifier::get(fir::StringLitOp::value(), context); + mlir::NamedAttribute dataAttr(valTag, strAttr); + auto sizeTag = mlir::Identifier::get(fir::StringLitOp::size(), context); + mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len)); + llvm::SmallVector attrs{dataAttr, sizeAttr}; + return builder.create( + getLoc(), llvm::ArrayRef{type}, llvm::None, attrs); + }; + + // When in an initializer context, construct the literal op itself and do + // not construct another constant object in rodata. + if (exprCtx.inInitializer()) + return consLit().getResult(); + + // Otherwise, the string is in a plain old expression so "outline" the value + // by hashconsing it to a constant literal object. + + // FIXME: For wider char types, lowering ought to use an array of i16 or + // i32. But for now, lowering just fakes that the string value is a range of + // i8 to get it past the C++ compiler. std::string globalName = converter.uniqueCGIdent("cl", (const char *)value.c_str()); auto global = builder.getNamedGlobal(globalName); @@ -694,21 +717,7 @@ class ExprLowering { global = builder.createGlobalConstant( getLoc(), type, globalName, [&](Fortran::lower::FirOpBuilder &builder) { - auto context = builder.getContext(); - // FIXME: more fakery - auto strAttr = - mlir::StringAttr::get((const char *)value.c_str(), context); - auto valTag = - mlir::Identifier::get(fir::StringLitOp::value(), context); - mlir::NamedAttribute dataAttr(valTag, strAttr); - auto sizeTag = - mlir::Identifier::get(fir::StringLitOp::size(), context); - mlir::NamedAttribute sizeAttr(sizeTag, - builder.getI64IntegerAttr(len)); - llvm::SmallVector attrs{dataAttr, - sizeAttr}; - auto str = builder.create( - getLoc(), llvm::ArrayRef{type}, llvm::None, attrs); + auto str = consLit(); builder.create(getLoc(), str); }); auto addr = builder.create(getLoc(), global.resultType(), @@ -736,28 +745,62 @@ class ExprLowering { fir::ExtendedValue genArrayLit( const Fortran::evaluate::Constant> &con) { - // Convert Ev::ConstantSubs to SequenceType::Shape - fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end()); - auto arrayTy = fir::SequenceType::get(shape, converter.genType(TC, KIND)); - auto eleTy = arrayTy.getEleTy(); - auto idxTy = builder.getIndexType(); - mlir::Value array = builder.create(getLoc(), arrayTy); - Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); - do { - auto constant = - fir::getBase(genScalarLit(con.At(subscripts), con)); - llvm::SmallVector idx; - for (const auto &pair : llvm::zip(subscripts, con.lbounds())) { - const auto &dim = std::get<0>(pair); - const auto &lb = std::get<1>(pair); - idx.push_back(builder.createIntegerConstant(getLoc(), idxTy, dim - lb)); - } - auto insVal = builder.createConvert(getLoc(), eleTy, constant); - array = builder.create(getLoc(), arrayTy, array, - insVal, idx); - } while (con.IncrementSubscripts(subscripts)); - // FIXME: return an ArrayBoxValue - return array; + if constexpr (TC == Fortran::common::TypeCategory::Character) { + fir::SequenceType::Shape shape; + shape.push_back(con.LEN()); + shape.append(con.shape().begin(), con.shape().end()); + auto chTy = + converter.genType(Fortran::common::TypeCategory::Character, KIND); + auto arrayTy = fir::SequenceType::get(shape, chTy); + auto idxTy = builder.getIndexType(); + mlir::Value array = builder.create(getLoc(), arrayTy); + Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); + do { + auto constant = fir::getBase( + genScalarLit( + con.At(subscripts), con)); + for (std::int64_t i = 0, L = con.LEN(); i < L; ++i) { + llvm::SmallVector idx; + idx.push_back(builder.createIntegerConstant(getLoc(), idxTy, i)); + auto charVal = builder.create(getLoc(), chTy, + constant, idx); + for (const auto &pair : llvm::zip(subscripts, con.lbounds())) { + const auto &dim = std::get<0>(pair); + const auto &lb = std::get<1>(pair); + idx.push_back( + builder.createIntegerConstant(getLoc(), idxTy, dim - lb)); + } + array = builder.create(getLoc(), arrayTy, array, + charVal, idx); + } + } while (con.IncrementSubscripts(subscripts)); + // FIXME: return an ArrayBoxValue + return array; + } else { + // Convert Ev::ConstantSubs to SequenceType::Shape + fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end()); + auto eleTy = converter.genType(TC, KIND); + auto arrayTy = fir::SequenceType::get(shape, eleTy); + auto idxTy = builder.getIndexType(); + mlir::Value array = builder.create(getLoc(), arrayTy); + Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); + do { + auto constant = + fir::getBase(genScalarLit(con.At(subscripts), con)); + llvm::SmallVector idx; + for (const auto &pair : llvm::zip(subscripts, con.lbounds())) { + const auto &dim = std::get<0>(pair); + const auto &lb = std::get<1>(pair); + idx.push_back( + builder.createIntegerConstant(getLoc(), idxTy, dim - lb)); + } + auto insVal = builder.createConvert(getLoc(), eleTy, constant); + array = builder.create(getLoc(), arrayTy, array, + insVal, idx); + } while (con.IncrementSubscripts(subscripts)); + // FIXME: return an ArrayBoxValue + return array; + } } template @@ -957,7 +1000,7 @@ class ExprLowering { return false; } - bool inArrayContext() { return context.inArrayContext(); } + bool inArrayContext() { return exprCtx.inArrayContext(); } fir::ExtendedValue gen(const Fortran::lower::SymbolBox &si, const Fortran::evaluate::ArrayRef &aref) { @@ -965,8 +1008,9 @@ class ExprLowering { auto addr = si.getAddr(); auto arrTy = fir::dyn_cast_ptrEleTy(addr.getType()); auto eleTy = arrTy.cast().getEleTy(); + auto seqTy = builder.getRefType(builder.getVarLenSeqTy(eleTy)); auto refTy = builder.getRefType(eleTy); - auto base = builder.createConvert(loc, refTy, addr); + auto base = builder.createConvert(loc, seqTy, addr); auto idxTy = builder.getIndexType(); auto one = builder.createIntegerConstant(getLoc(), idxTy, 1); auto zero = builder.createIntegerConstant(getLoc(), idxTy, 0); @@ -985,8 +1029,9 @@ class ExprLowering { auto tlb = builder.createConvert(loc, idxTy, std::get<0>(*trip)); auto dlb = builder.createConvert(loc, idxTy, getLB(arr, dim)); auto diff = builder.create(loc, tlb, dlb); - assert(idx < context.getLoopVars().size()); - auto sum = builder.create(loc, diff, context.getLoopVars()[idx++]); + assert(idx < exprCtx.getLoopVars().size()); + auto sum = builder.create(loc, diff, + exprCtx.getLoopVars()[idx++]); auto del = builder.createConvert(loc, idxTy, std::get<2>(*trip)); auto scaled = builder.create(loc, del, delta); auto prod = builder.create(loc, scaled, sum); @@ -1016,7 +1061,7 @@ class ExprLowering { auto genArraySlice = [&](const auto &arr) -> mlir::Value { // FIXME: create a loop nest and copy the array slice into a temp // We need some context here, since we could also box as an argument - return builder.create(loc, refTy); + llvm::report_fatal_error("TODO: array slice not supported"); }; return std::visit( Fortran::common::visitors{ @@ -1069,7 +1114,8 @@ class ExprLowering { // triple notation for slicing operation auto ty = builder.getIndexType(); auto step = builder.createConvert(loc, ty, std::get<2>(*range)); - auto scale = builder.create(loc, ty, context.getLoopVars()[i], step); + auto scale = builder.create( + loc, ty, exprCtx.getLoopVars()[i], step); auto off = builder.createConvert(loc, ty, std::get<0>(*range)); args.push_back(builder.create(loc, ty, off, scale)); } @@ -1418,8 +1464,8 @@ mlir::Value Fortran::lower::createSomeExpression( mlir::Location loc, Fortran::lower::AbstractConverter &converter, const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap) { - Fortran::lower::ExpressionContext bogon; - return ExprLowering{loc, converter, symMap, bogon}.genValue(expr); + Fortran::lower::ExpressionContext unused; + return ExprLowering{loc, converter, symMap, unused}.genValue(expr); } fir::ExtendedValue Fortran::lower::createSomeExtendedExpression( @@ -1434,8 +1480,8 @@ mlir::Value Fortran::lower::createSomeAddress( mlir::Location loc, Fortran::lower::AbstractConverter &converter, const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap) { - Fortran::lower::ExpressionContext bogon; - return ExprLowering{loc, converter, symMap, bogon}.genAddr(expr); + Fortran::lower::ExpressionContext unused; + return ExprLowering{loc, converter, symMap, unused}.genAddr(expr); } fir::ExtendedValue Fortran::lower::createSomeExtendedAddress( @@ -1449,9 +1495,9 @@ fir::ExtendedValue Fortran::lower::createSomeExtendedAddress( fir::ExtendedValue Fortran::lower::createStringLiteral( mlir::Location loc, Fortran::lower::AbstractConverter &converter, llvm::StringRef str, uint64_t len) { - Fortran::lower::SymMap bogon1; - Fortran::lower::ExpressionContext bogon2; - return ExprLowering{loc, converter, bogon1, bogon2}.genStringLit(str, len); + Fortran::lower::SymMap unused1; + Fortran::lower::ExpressionContext unused2; + return ExprLowering{loc, converter, unused1, unused2}.genStringLit(str, len); } //===----------------------------------------------------------------------===// diff --git a/flang/lib/Lower/FIRBuilder.cpp b/flang/lib/Lower/FIRBuilder.cpp index 0a8473b73268b..0a73461eae7d6 100644 --- a/flang/lib/Lower/FIRBuilder.cpp +++ b/flang/lib/Lower/FIRBuilder.cpp @@ -38,6 +38,11 @@ mlir::Type Fortran::lower::FirOpBuilder::getRefType(mlir::Type eleTy) { return fir::ReferenceType::get(eleTy); } +mlir::Type Fortran::lower::FirOpBuilder::getVarLenSeqTy(mlir::Type eleTy) { + fir::SequenceType::Shape shape = {fir::SequenceType::getUnknownExtent()}; + return fir::SequenceType::get(shape, eleTy); +} + mlir::Value Fortran::lower::FirOpBuilder::createNullConstant(mlir::Location loc) { auto indexType = getIndexType(); diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index bbba6ba7d3a7c..cde3caf24acf4 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -1727,6 +1727,15 @@ struct CoordinateOpConversion bool columnIsDeferred = false; bool hasSubdimension = hasSubDimensions(cpnTy); + // if argument 0 is complex, get the real or imaginary part + if (fir::isa_complex(cpnTy)) { + SmallVector offs = {c0}; + offs.append(std::next(operands.begin()), operands.end()); + mlir::Value gep = genGEP(loc, unwrap(ty), rewriter, base, offs); + rewriter.replaceOp(coor, gep); + return success(); + } + // if argument 0 is boxed, get the base pointer from the box if (auto boxTy = firTy.dyn_cast()) { diff --git a/flang/test/Fir/char01.fir b/flang/test/Fir/char01.fir index 4bf3771ff0c09..c43cfd4b905a1 100644 --- a/flang/test/Fir/char01.fir +++ b/flang/test/Fir/char01.fir @@ -2,8 +2,9 @@ // CHECK-LABEL: @test func @test(%arg0 : !fir.ref>, %arg1 : !fir.ref>, %arg2 : i32) { + %0 = fir.convert %arg1 : (!fir.ref>) -> !fir.ref>> // CHECK: getelementptr i8, i8* - %1 = fir.coordinate_of %arg1, %arg2 : (!fir.ref>, i32) -> !fir.ref> + %1 = fir.coordinate_of %0, %arg2 : (!fir.ref>>, i32) -> !fir.ref> // CHECK: load i8, i8* %2 = fir.load %1 : !fir.ref> // CHECK: store i8 diff --git a/flang/test/Fir/coordinateof.fir b/flang/test/Fir/coordinateof.fir index 4eddae739eea9..597b1da71f63f 100644 --- a/flang/test/Fir/coordinateof.fir +++ b/flang/test/Fir/coordinateof.fir @@ -16,9 +16,9 @@ func @foo1(%i : i32, %j : i32, %k : i32) -> !fir.ref { func @foo2(%i : i32, %j : i32, %k : i32) -> !fir.ref { %1 = fir.alloca !fir.array<10 x 20 x 30 x f32> // CHECK: %[[ptr:.*]] = bitcast [30 x [20 x [10 x - %2 = fir.convert %1 : (!fir.ref>) -> !fir.ref + %2 = fir.convert %1 : (!fir.ref>) -> !fir.ref> // CHECK: getelementptr float, float* %[[ptr]] - %3 = fir.coordinate_of %2, %i : (!fir.ref, i32) -> !fir.ref + %3 = fir.coordinate_of %2, %i : (!fir.ref>, i32) -> !fir.ref return %3 : !fir.ref } diff --git a/flang/test/Lower/array.f90 b/flang/test/Lower/array.f90 index d9c56d8adfdb6..7822096f026f4 100644 --- a/flang/test/Lower/array.f90 +++ b/flang/test/Lower/array.f90 @@ -40,14 +40,13 @@ subroutine s(i,j,k,ii,jj,kk,a1,a2,a3,a4,a5,a6,a7) ! CHECK-LABEL: EndIoStatement print *, a4(ii,jj) ! CHECK-LABEL: BeginExternalListOutput - ! CHECK: %[[a5:.*]] = fir.convert %arg10 : {{.*}} -> !fir.ref ! CHECK: fir.load %arg5 : ! CHECK: %[[x5:.*]] = subi %{{.*}}, %{{.*}} : - ! CHECK: fir.coordinate_of %[[a5]], %[[x5]] : + ! CHECK: fir.coordinate_of %arg10, %[[x5]] : ! CHECK-LABEL: EndIoStatement print *, a5(kk) ! CHECK-LABEL: BeginExternalListOutput - ! CHECK: %[[a6:.*]] = fir.convert %arg11 : {{.*}} -> !fir.ref + ! CHECK: %[[a6:.*]] = fir.convert %arg11 : {{.*}} -> !fir.ref> ! CHECK: fir.load %arg3 : ! CHECK-DAG: %[[x6:.*]] = subi %{{.*}}, %{{.*}} : ! CHECK-DAG: fir.load %arg4 : @@ -58,7 +57,7 @@ subroutine s(i,j,k,ii,jj,kk,a1,a2,a3,a4,a5,a6,a7) ! CHECK-LABEL: EndIoStatement print *, a6(ii, jj) ! CHECK-LABEL: BeginExternalListOutput - ! CHECK: %[[a7:.*]] = fir.convert %arg12 : {{.*}} -> !fir.ref + ! CHECK: %[[a7:.*]] = fir.convert %arg12 : {{.*}} -> !fir.ref> ! CHECK: fir.load %arg5 : ! CHECK-DAG: %[[x7:.*]] = subi %{{.*}}, %{{.*}} : ! CHECK-DAG: fir.load %arg4 : diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index a68b7aadd0e7b..2d0ba2720a2fd 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -21,17 +21,21 @@ subroutine assign1(lhs, rhs) ! Copy of rhs into temp ! CHECK: fir.do_loop %[[i:.*]] = - ! CHECK-DAG: %[[rhs_addr:.*]] = fir.coordinate_of %[[rhs]]#0, %[[i]] + ! CHECK: %[[rhs_addr2:.*]] = fir.convert %[[rhs]]#0 + ! CHECK-DAG: %[[rhs_addr:.*]] = fir.coordinate_of %[[rhs_addr2]], %[[i]] ! CHECK-DAG: %[[rhs_elt:.*]] = fir.load %[[rhs_addr]] - ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[i]] + ! CHECK-DAG: %[[tmp2:.*]] = fir.convert %[[tmp]] + ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp2]], %[[i]] ! CHECK: fir.store %[[rhs_elt]] to %[[tmp_addr]] ! CHECK-NEXT: } ! Copy of temp into lhs ! CHECK: fir.do_loop %[[ii:.*]] = - ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[ii]] + ! CHECK: %[[tmp2:.*]] = fir.convert %[[tmp]] + ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp2]], %[[ii]] ! CHECK-DAG: %[[tmp_elt:.*]] = fir.load %[[tmp_addr]] - ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[ii]] + ! CHECK-DAG: %[[lhs_addr2:.*]] = fir.convert %[[lhs]]#0 + ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs_addr2]], %[[ii]] ! CHECK: fir.store %[[tmp_elt]] to %[[lhs_addr]] ! CHECK-NEXT: } @@ -39,7 +43,8 @@ subroutine assign1(lhs, rhs) ! CHECK: %[[c32:.*]] = constant 32 : i8 ! CHECK: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> ! CHECK: fir.do_loop %[[ij:.*]] = - ! CHECK: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[ij]] + ! CHECK: %[[lhs_addr2:.*]] = fir.convert %[[lhs]]#0 + ! CHECK: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs_addr2]], %[[ij]] ! CHECK: fir.store %[[blank]] to %[[lhs_addr]] ! CHECK-NEXT: } end subroutine @@ -58,8 +63,8 @@ subroutine assign_substring1(str, rhs, lb, ub) ! CHECK-DAG: %[[lbi:.*]] = fir.convert %[[lb]] : (i64) -> index ! CHECK-DAG: %[[c1:.*]] = constant 1 ! CHECK-DAG: %[[offset:.*]] = subi %[[lbi]], %[[c1]] - ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[str]]#0, %[[offset]] - + ! CHECK-DAG: %[[lhs_addr2:.*]] = fir.convert %[[str]]#0 + ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs_addr2]], %[[offset]] ! Compute substring length ! CHECK-DAG: %[[ubi:.*]] = fir.convert %[[ub]] : (i64) -> index @@ -76,7 +81,8 @@ subroutine assign_substring1(str, rhs, lb, ub) ! ... ! CHECK: %[[lhs:.*]]:2 = fir.unboxchar %[[lhs_box]] ! ... - ! CHECK: fir.coordinate_of %[[lhs]]#0, + ! CHECK: %[[lhs2:.*]] = fir.convert %[[lhs]]#0 + ! CHECK-NEXT: fir.coordinate_of %[[lhs2]], %arg4 ! ... end subroutine @@ -89,10 +95,13 @@ subroutine assign_constant(lhs) ! CHECK-DAG: %[[tmp:.*]] = fir.address_of(@{{.*}}) : lhs = "Hello World" ! CHECK: fir.do_loop %[[i:.*]] = %{{.*}} to %{{.*}} { - ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[i]] + ! CHECK: %[[tmp2:.*]] = fir.convert %[[tmp]] + ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp2]], %[[i]] ! CHECK-DAG: %[[tmp_elt:.*]] = fir.load %[[tmp_addr]] - ! UNBOX: = fir.coordinate_of %[[lhs]]#0, % - ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs:.*]]#0, %[[i]] + ! UNBOX: %[[lhs2:.*]] = fir.convert %[[lhs]]#0 + ! UNBOX: = fir.coordinate_of %[[lhs2]], % + ! CHECK-DAG: %[[lhs_addr2:.*]] = fir.convert %[[lhs:.*]]#0 + ! CHECK: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs_addr2:.*]], %[[i]] ! CHECK: fir.store %[[tmp_elt]] to %[[lhs_addr]] ! CHECK: } @@ -100,8 +109,10 @@ subroutine assign_constant(lhs) ! CHECK-DAG: %[[c32:.*]] = constant 32 : i8 ! CHECK-DAG: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> ! CHECK: fir.do_loop %[[j:.*]] = %{{.*}} to %{{.*}} { - ! UNBOX: = fir.coordinate_of %[[lhs]]#0, % - ! CHECK: %[[jhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[j]] + ! UNBOX: %[[lhs2:.*]] = fir.convert %[[lhs]]#0 + ! UNBOX: = fir.coordinate_of %[[lhs2]], % + ! CHECK: %[[jhs_addr2:.*]] = fir.convert %[[lhs]]#0 + ! CHECK: %[[jhs_addr:.*]] = fir.coordinate_of %[[jhs_addr2]], %[[j]] ! CHECK: fir.store %[[blank]] to %[[jhs_addr]] ! CHECK: } end subroutine diff --git a/flang/test/Lower/concat.f90 b/flang/test/Lower/concat.f90 index fe844307fef80..e29a0e096c6a7 100644 --- a/flang/test/Lower/concat.f90 +++ b/flang/test/Lower/concat.f90 @@ -19,9 +19,11 @@ subroutine concat_1(a, b) ! CHECK-DAG: %[[c1:.*]] = constant 1 ! CHECK-DAG: %[[count:.*]] = subi %[[a]]#1, %[[c1]] ! CHECK: fir.do_loop %[[index:.*]] = %[[c0]] to %[[count]] step %[[c1]] { - ! CHECK: %[[a_addr:.*]] = fir.coordinate_of %[[a]]#0, %[[index]] - ! CHECK: %[[a_elt:.*]] = fir.load %[[a_addr]] - ! CHECK: %[[temp_addr:.*]] = fir.coordinate_of %[[temp]], %[[index]] + ! CHECK: %[[a_addr2:.*]] = fir.convert %[[a]]#0 + ! CHECK: %[[a_addr:.*]] = fir.coordinate_of %[[a_addr2]], %[[index]] + ! CHECK-DAG: %[[a_elt:.*]] = fir.load %[[a_addr]] + ! CHECK-DAG: %[[temp2:.*]] = fir.convert %[[temp]] + ! CHECK: %[[temp_addr:.*]] = fir.coordinate_of %[[temp2]], %[[index]] ! CHECK: fir.store %[[a_elt]] to %[[temp_addr]] ! CHECK: } @@ -29,9 +31,11 @@ subroutine concat_1(a, b) ! CHECK: %[[count2:.*]] = subi %[[len]], %[[c1_0]] ! CHECK: fir.do_loop %[[index2:.*]] = %[[a]]#1 to %[[count2]] step %[[c1_0]] { ! CHECK: %[[b_index:.*]] = subi %[[index]], %[[a]]#1 - ! CHECK: %[[b_addr:.*]] = fir.coordinate_of %[[b]]#0, %[[b_index]] - ! CHECK: %[[b_elt:.*]] = fir.load %[[b_addr]] - ! CHECK: %[[temp_addr2:.*]] = fir.coordinate_of %[[temp]], %[[index2]] + ! CHECK: %[[b_addr2:.*]] = fir.convert %[[b]]#0 + ! CHECK: %[[b_addr:.*]] = fir.coordinate_of %[[b_addr2]], %[[b_index]] + ! CHECK-DAG: %[[b_elt:.*]] = fir.load %[[b_addr]] + ! CHECK-DAG: %[[temp2:.*]] = fir.convert %[[temp]] + ! CHECK: %[[temp_addr2:.*]] = fir.coordinate_of %[[temp2]], %[[index2]] ! CHECK: fir.store %[[b_elt]] to %[[temp_addr2]] ! CHECK: } From 8dd39d409c5dfb4dd077fd8bb2813aa06f84f328 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 16 Jul 2020 20:14:28 -0700 Subject: [PATCH 0173/1017] remove duplicate entry --- flang/lib/Lower/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt index d2df8cf4e2e80..fcf45d831e369 100644 --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -10,7 +10,6 @@ add_flang_library(FortranLower ComplexExpr.cpp ConvertExpr.cpp ConvertType.cpp - ConvertExpr.cpp DoLoopHelper.cpp FIRBuilder.cpp IntrinsicCall.cpp From e69f12f776af150225d7c8423c5b931eaafc138e Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Fri, 17 Jul 2020 00:08:56 +0530 Subject: [PATCH 0174/1017] [flang][OpenMP] Added support for lowering OpenMP taskwait construct This patch adds lowering support for OpenMP-4.5 taskwait construct to OpenMP Dialect operations. [flang][OpenMP] Added support for lowering OpenMP taskwait construct @kiranchandramohan review comments. --- flang/test/Lower/omp-taskwait.f90 | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 flang/test/Lower/omp-taskwait.f90 diff --git a/flang/test/Lower/omp-taskwait.f90 b/flang/test/Lower/omp-taskwait.f90 new file mode 100644 index 0000000000000..9edb382f62180 --- /dev/null +++ b/flang/test/Lower/omp-taskwait.f90 @@ -0,0 +1,24 @@ +! This test checks lowering of OpenMP taskwait Directive. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: tco | FileCheck %s --check-prefix=LLVMIR + +program taskwait + + integer :: a,b,c + +!$OMP TASKWAIT +!FIRDialect: omp.taskwait +!LLVMIRDialect: omp.taskwait +!LLVMIR: %{{.*}} = call i32 @__kmpc_omp_taskwait(%struct.ident_t* @{{.*}}, i32 %{{.*}}) + c = a + b +!$OMP TASKWAIT +!FIRDialect: omp.taskwait +!LLVMIRDialect: omp.taskwait +!LLVMIR: %{{.*}} = call i32 @__kmpc_omp_taskwait(%struct.ident_t* @{{.*}}, i32 %{{.*}}) + +end program From a777eb9d4eae251291f632c985512aa377faaff5 Mon Sep 17 00:00:00 2001 From: sameeran joshi Date: Fri, 17 Jul 2020 22:48:23 +0530 Subject: [PATCH 0175/1017] [Finish porting] addrof.1.fir and complex.fir. Remove redundant tests. --- flang/not-test/fir/complex.fir | 22 ----------------- flang/not-test/fir/complex.mlir | 6 ----- flang/{not-test/fir => test/Fir}/addrof.1.fir | 5 ++++ flang/test/Fir/complex.fir | 24 +++++++++++++++---- 4 files changed, 25 insertions(+), 32 deletions(-) delete mode 100644 flang/not-test/fir/complex.fir delete mode 100644 flang/not-test/fir/complex.mlir rename flang/{not-test/fir => test/Fir}/addrof.1.fir (53%) diff --git a/flang/not-test/fir/complex.fir b/flang/not-test/fir/complex.fir deleted file mode 100644 index 958baa430ff46..0000000000000 --- a/flang/not-test/fir/complex.fir +++ /dev/null @@ -1,22 +0,0 @@ -func @foo(%a : !fir.complex<4>, %b : !fir.complex<4>, %c : !fir.complex<4>, %d : !fir.complex<4>, %e : !fir.complex<4>) -> !fir.complex<4> { - %1 = fir.addc %a, %b : !fir.complex<4> - %2 = fir.mulc %1, %c : !fir.complex<4> - %3 = fir.subc %2, %d : !fir.complex<4> - %4 = fir.divc %3, %e : !fir.complex<4> - return %4 : !fir.complex<4> -} - -func @f2(%a : !fir.complex<4>) -> f32 { - %0 = constant 0 : i32 - %1 = fir.extract_value %a, %0 : (!fir.complex<4>, i32) -> f32 - return %1 : f32 -} - -func @f3(%a : !fir.complex<4>) -> !fir.complex<4> { - %0 = constant 1 : i32 - %1 = fir.extract_value %a, %0 : (!fir.complex<4>, i32) -> f32 - %2 = constant 0.0 : f32 - %3 = fir.subf %2, %1 : f32 - %4 = fir.insert_value %a, %3, %0 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> - return %4 : !fir.complex<4> -} diff --git a/flang/not-test/fir/complex.mlir b/flang/not-test/fir/complex.mlir deleted file mode 100644 index 5a36992c95674..0000000000000 --- a/flang/not-test/fir/complex.mlir +++ /dev/null @@ -1,6 +0,0 @@ -func @add(%a : complex, %b : complex) -> complex - -func @foo(%a : complex, %b : complex) -> complex { - %1 = call @add(%a, %b) : (complex, complex) -> complex - return %1 : complex -} diff --git a/flang/not-test/fir/addrof.1.fir b/flang/test/Fir/addrof.1.fir similarity index 53% rename from flang/not-test/fir/addrof.1.fir rename to flang/test/Fir/addrof.1.fir index 75cc12a55eb11..e2b12840d0355 100644 --- a/flang/not-test/fir/addrof.1.fir +++ b/flang/test/Fir/addrof.1.fir @@ -1,7 +1,12 @@ +// RUN: tco -emit-fir %s | tco | FileCheck %s + +// CHECK: @var_x = external global i32 fir.global @var_x : !fir.int<4> {} +// CHECK-LABEL: define i32* @getAddressOfX func @getAddressOfX() -> !fir.ref> { %1 = fir.address_of(@var_x) : !fir.ref> + // CHECK: ret i32* @var_x return %1 : !fir.ref> } diff --git a/flang/test/Fir/complex.fir b/flang/test/Fir/complex.fir index 4578fd8372a4e..6d7cfdfcb068d 100644 --- a/flang/test/Fir/complex.fir +++ b/flang/test/Fir/complex.fir @@ -1,28 +1,44 @@ // RUN: cc -c %S/print_complex.c -// RUN: tco %s | llc | as -o %t -// RUN: cc %t print_complex.o -// RUN: ./a.out | FileCheck %s +// RUN: tco %s | FileCheck %s --check-prefix=LLVMIR +// RUN: tco %s | llc | as -o %t +// RUN: cc %t print_complex.o +// RUN: ./a.out | FileCheck %s --check-prefix=EXECHECK -// CHECK: <0.935893, 2.252526> +// EXECHECK: <0.935893, 2.252526> +// LLVMIR-LABEL: define { float, float } @foo func @foo(%a : !fir.complex<4>, %b : !fir.complex<4>, %c : !fir.complex<4>, %d : !fir.complex<4>, %e : !fir.complex<4>) -> !fir.complex<4> { + // LLVMIR-COUNT-2: extractvalue + // LLVMIR: fadd float + // LLVMIR-COUNT-2: extractvalue + // LLVMIR: fadd float + // LLVMIR-COUNT-2: insertvalue %1 = fir.addc %a, %b : !fir.complex<4> + // LLVMIR: fmul float %2 = fir.mulc %1, %c : !fir.complex<4> + // LLVMIR: fsub float %3 = fir.subc %2, %d : !fir.complex<4> + // LLVMIR: fdiv float %4 = fir.divc %3, %e : !fir.complex<4> return %4 : !fir.complex<4> } +// LLVMIR-LABEL: define float @real_part({ float, float } %0) func @real_part(%a : !fir.complex<4>) -> f32 { %0 = constant 0 : i32 + // LLVMIR: extractvalue %1 = fir.extract_value %a, %0 : (!fir.complex<4>, i32) -> f32 return %1 : f32 } +// LLVMIR-LABEL: define { float, float } @conj func @conj(%a : !fir.complex<4>) -> !fir.complex<4> { %0 = constant 1 : i32 + // LLVMIR: extractvalue %1 = fir.extract_value %a, %0 : (!fir.complex<4>, i32) -> f32 + // LLVMIR: fneg float %2 = fir.negf %1 : f32 + // LLVMIR: insertvalue %3 = fir.insert_value %a, %2, %0 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> return %3 : !fir.complex<4> } From df8e7675b98b23236f17358a5f0dca1d981c1c43 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Mon, 20 Jul 2020 12:18:16 +0530 Subject: [PATCH 0176/1017] Fix for #273 Addressed schweitzpgi review comments --- flang/lib/Lower/Bridge.cpp | 30 ++++++++-------- .../Optimizer/Transforms/AffinePromotion.cpp | 32 ++++++++--------- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 36 +++++++++---------- 3 files changed, 47 insertions(+), 51 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 22d6ac1393650..35acf669a14a7 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -542,15 +542,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { // template - std::pair - genWhereCondition(const A *stmt, bool withElse = true) { + std::pair + genIfCondition(const A *stmt, bool withElse = true) { auto cond = genExprValue(*Fortran::semantics::GetExpr( std::get(stmt->t))); auto bcc = builder->createConvert(toLocation(), builder->getI1Type(), cond); - auto where = builder->create(toLocation(), bcc, withElse); + auto ifOp = builder->create(toLocation(), bcc, withElse); auto insPt = builder->saveInsertionPoint(); - builder->setInsertionPointToStart(&where.whereRegion().front()); - return {insPt, where}; + builder->setInsertionPointToStart(&ifOp.whereRegion().front()); + return {insPt, ifOp}; } mlir::Value genFIRLoopIndex(const Fortran::parser::ScalarExpr &x, @@ -604,8 +604,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { return; } - // Generate fir.where. - auto pair = genWhereCondition(&stmt, /*withElse=*/false); + // Generate fir.if. + auto pair = genIfCondition(&stmt, /*withElse=*/false); genFIR(*eval.lexicalSuccessor, /*unstructuredContext=*/false); eval.lexicalSuccessor->skip = true; builder->restoreInsertionPoint(pair.first); @@ -889,20 +889,20 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::IfConstruct &) { auto &eval = getEval(); if (eval.lowerAsStructured()) { - // Structured fir.where nest. - fir::WhereOp underWhere; + // Structured fir.if nest. + fir::IfOp nestedIf; mlir::OpBuilder::InsertPoint insPt; for (auto &e : eval.getNestedEvaluations()) { if (auto *s = e.getIf()) { - // fir.where op - std::tie(insPt, underWhere) = genWhereCondition(s); + // fir.if op + std::tie(insPt, nestedIf) = genIfCondition(s); } else if (auto *s = e.getIf()) { - // otherwise block, then nested fir.where - builder->setInsertionPointToStart(&underWhere.otherRegion().front()); - std::tie(std::ignore, underWhere) = genWhereCondition(s); + // otherwise block, then nested fir.if + builder->setInsertionPointToStart(&nestedIf.otherRegion().front()); + std::tie(std::ignore, nestedIf) = genIfCondition(s); } else if (e.isA()) { // otherwise block - builder->setInsertionPointToStart(&underWhere.otherRegion().front()); + builder->setInsertionPointToStart(&nestedIf.otherRegion().front()); } else if (e.isA()) { builder->restoreInsertionPoint(insPt); } else { diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index 4793015761fe2..ddf76218a3753 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -169,7 +169,7 @@ class AffineIfCondition { /// Analysis for affine promotion of fir.if class AffineIfAnalysis { public: - AffineIfAnalysis(fir::WhereOp op, AffineFunctionAnalysis &afa) + AffineIfAnalysis(fir::IfOp op, AffineFunctionAnalysis &afa) : legality(analyzeIf(op, afa)) {} bool canPromoteToAffine() { return legality; } friend AffineFunctionAnalysis; @@ -177,10 +177,10 @@ class AffineIfAnalysis { private: bool legality; AffineIfAnalysis(bool forcedLegality) : legality(forcedLegality) {} - bool analyzeIf(fir::WhereOp, AffineFunctionAnalysis &); + bool analyzeIf(fir::IfOp, AffineFunctionAnalysis &); }; -/// Stores analysis objects for all loops and where operations inside a function +/// Stores analysis objects for all loops and if operations inside a function /// these analysis are used twice, first for marking operations for rewrite and /// second when doing rewrite. class AffineFunctionAnalysis { @@ -200,7 +200,7 @@ class AffineFunctionAnalysis { } return it->getSecond(); } - AffineIfAnalysis getChildIfAnalysis(fir::WhereOp op) const { + AffineIfAnalysis getChildIfAnalysis(fir::IfOp op) const { auto it = ifAnalysisMap.find_as(op); if (it == ifAnalysisMap.end()) { LLVM_DEBUG(llvm::dbgs() << "AffineFunctionAnalysis: not computed for:\n"; @@ -255,13 +255,12 @@ bool AffineLoopAnalysis::analyzeBody(fir::LoopOp loopOperation, if (!analysis.canPromoteToAffine()) return false; } - for (auto whereOp : loopOperation.getOps()) - functionAnalysis.ifAnalysisMap.try_emplace(whereOp, whereOp, - functionAnalysis); + for (auto ifOp : loopOperation.getOps()) + functionAnalysis.ifAnalysisMap.try_emplace(ifOp, ifOp, functionAnalysis); return true; } -bool AffineIfAnalysis::analyzeIf(fir::WhereOp op, AffineFunctionAnalysis &afa) { +bool AffineIfAnalysis::analyzeIf(fir::IfOp op, AffineFunctionAnalysis &afa) { if (op.getNumResults() == 0) return true; LLVM_DEBUG( @@ -454,17 +453,17 @@ class AffineLoopConversion : public mlir::OpRewritePattern { AffineFunctionAnalysis &functionAnalysis; }; -class AffineIfConversion : public mlir::OpRewritePattern { +class AffineIfConversion : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; AffineIfConversion(mlir::MLIRContext *context, AffineFunctionAnalysis &afa) : OpRewritePattern(context), functionAnalysis(afa) {} mlir::LogicalResult - matchAndRewrite(fir::WhereOp op, + matchAndRewrite(fir::IfOp op, mlir::PatternRewriter &rewriter) const override { - LLVM_DEBUG(llvm::dbgs() << "AffineIfConversion: rewriting where:\n"; + LLVM_DEBUG(llvm::dbgs() << "AffineIfConversion: rewriting if:\n"; op.dump();); - auto &whereOps = op.whereRegion().front().getOperations(); + auto &ifOps = op.whereRegion().front().getOperations(); auto affineCondition = AffineIfCondition(op.condition()); if (!affineCondition.integerSet) { LLVM_DEBUG( @@ -477,8 +476,7 @@ class AffineIfConversion : public mlir::OpRewritePattern { affineCondition.affineArgs, !op.otherRegion().empty()); rewriter.startRootUpdate(affineIf); affineIf.getThenBlock()->getOperations().splice( - --affineIf.getThenBlock()->end(), whereOps, whereOps.begin(), - --whereOps.end()); + --affineIf.getThenBlock()->end(), ifOps, ifOps.begin(), --ifOps.end()); if (!op.otherRegion().empty()) { auto &otherOps = op.otherRegion().front().getOperations(); affineIf.getElseBlock()->getOperations().splice( @@ -488,7 +486,7 @@ class AffineIfConversion : public mlir::OpRewritePattern { rewriter.finalizeRootUpdate(affineIf); rewriteMemoryOps(affineIf.getBody(), rewriter); - LLVM_DEBUG(llvm::dbgs() << "AffineIfConversion: where converted to:\n"; + LLVM_DEBUG(llvm::dbgs() << "AffineIfConversion: if converted to:\n"; affineIf.dump();); rewriter.replaceOp(op, affineIf.getOperation()->getResults()); return success(); @@ -498,7 +496,7 @@ class AffineIfConversion : public mlir::OpRewritePattern { AffineFunctionAnalysis &functionAnalysis; }; -/// Promote fir.loop and fir.where to affine.for and affine.if, in the cases +/// Promote fir.loop and fir.if to affine.for and affine.if, in the cases /// where such a promotion is possible. class AffineDialectPromotion : public AffineDialectPromotionBase { @@ -516,7 +514,7 @@ class AffineDialectPromotion mlir::ConversionTarget target = *context; target.addLegalDialect(); - target.addDynamicallyLegalOp([&functionAnalysis](fir::WhereOp op) { + target.addDynamicallyLegalOp([&functionAnalysis](fir::IfOp op) { return !(functionAnalysis.getChildIfAnalysis(op).canPromoteToAffine()); }); target.addDynamicallyLegalOp([&functionAnalysis](fir::LoopOp op) { diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index c89d2672755d1..be3ed83d6d9b3 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -131,14 +131,13 @@ class CfgLoopConv : public mlir::OpRewritePattern { }; /// Convert `fir.if` to control-flow -class CfgIfConv : public mlir::OpRewritePattern { +class CfgIfConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; mlir::LogicalResult - matchAndRewrite(WhereOp where, - mlir::PatternRewriter &rewriter) const override { - auto loc = where.getLoc(); + matchAndRewrite(IfOp ifOp, mlir::PatternRewriter &rewriter) const override { + auto loc = ifOp.getLoc(); // Split the block containing the 'fir.if' into two parts. The part before // will contain the condition, the part after will be the continuation @@ -147,31 +146,30 @@ class CfgIfConv : public mlir::OpRewritePattern { auto opPosition = rewriter.getInsertionPoint(); auto *remainingOpsBlock = rewriter.splitBlock(condBlock, opPosition); mlir::Block *continueBlock; - if (where.getNumResults() == 0) { + if (ifOp.getNumResults() == 0) { continueBlock = remainingOpsBlock; } else { continueBlock = - rewriter.createBlock(remainingOpsBlock, where.getResultTypes()); + rewriter.createBlock(remainingOpsBlock, ifOp.getResultTypes()); rewriter.create(loc, remainingOpsBlock); } // Move blocks from the "then" region to the region containing 'fir.if', // place it before the continuation block, and branch to it. - auto &whereRegion = where.whereRegion(); - auto *whereBlock = &whereRegion.front(); - auto *whereTerminator = whereRegion.back().getTerminator(); - auto whereTerminatorOperands = whereTerminator->getOperands(); - rewriter.setInsertionPointToEnd(&whereRegion.back()); - rewriter.create(loc, continueBlock, - whereTerminatorOperands); - rewriter.eraseOp(whereTerminator); - rewriter.inlineRegionBefore(whereRegion, continueBlock); + auto &ifOpRegion = ifOp.whereRegion(); + auto *ifOpBlock = &ifOpRegion.front(); + auto *ifOpTerminator = ifOpRegion.back().getTerminator(); + auto ifOpTerminatorOperands = ifOpTerminator->getOperands(); + rewriter.setInsertionPointToEnd(&ifOpRegion.back()); + rewriter.create(loc, continueBlock, ifOpTerminatorOperands); + rewriter.eraseOp(ifOpTerminator); + rewriter.inlineRegionBefore(ifOpRegion, continueBlock); // Move blocks from the "else" region (if present) to the region containing // 'fir.if', place it before the continuation block and branch to it. It // will be placed after the "then" regions. auto *otherwiseBlock = continueBlock; - auto &otherwiseRegion = where.otherRegion(); + auto &otherwiseRegion = ifOp.otherRegion(); if (!otherwiseRegion.empty()) { otherwiseBlock = &otherwiseRegion.front(); auto *otherwiseTerm = otherwiseRegion.back().getTerminator(); @@ -185,9 +183,9 @@ class CfgIfConv : public mlir::OpRewritePattern { rewriter.setInsertionPointToEnd(condBlock); rewriter.create( - loc, where.condition(), whereBlock, llvm::ArrayRef(), + loc, ifOp.condition(), ifOpBlock, llvm::ArrayRef(), otherwiseBlock, llvm::ArrayRef()); - rewriter.replaceOp(where, continueBlock->getArguments()); + rewriter.replaceOp(ifOp, continueBlock->getArguments()); return success(); } }; @@ -282,7 +280,7 @@ class CfgConversion : public CFGConversionBase { mlir::StandardOpsDialect>(); // apply the patterns - target.addIllegalOp(); + target.addIllegalOp(); target.markUnknownOpDynamicallyLegal([](Operation *) { return true; }); if (mlir::failed( mlir::applyPartialConversion(getFunction(), target, patterns))) { From 04038ac4542f62782d973cd8b0bdbabfe99bb613 Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Tue, 21 Jul 2020 12:16:33 -0700 Subject: [PATCH 0177/1017] Implement subprograms with alternate entry points. (#282) * Implement subprograms with alternate entry points. The primary subprogram and each secondary entry point has an independent clone. * review comment update --- flang/include/flang/Lower/PFTBuilder.h | 34 +++- flang/lib/Lower/Bridge.cpp | 208 ++++++++++++++++--------- flang/lib/Lower/ConvertExpr.cpp | 26 +++- flang/lib/Lower/PFTBuilder.cpp | 103 +++++++++--- flang/lib/Semantics/resolve-names.cpp | 1 + flang/test/Lower/entry.f90 | 70 +++++++++ 6 files changed, 337 insertions(+), 105 deletions(-) create mode 100644 flang/test/Lower/entry.f90 diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 60866e630dc5f..66927cba10ab5 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -437,12 +437,23 @@ struct FunctionLikeUnit : public ProgramUnit { return stmtSourceLoc(endStmt); } - /// Returns reference to the subprogram symbol of this FunctionLikeUnit. - /// Dies if the FunctionLikeUnit is not a subprogram. + void setActiveEntry(int entryIndex) { + assert(entryIndex >= 0 && entryIndex < (int)entryPointList.size() && + "invalid entry point index"); + activeEntry = entryIndex; + } + + /// Return a reference to the subprogram symbol of this FunctionLikeUnit. const semantics::Symbol &getSubprogramSymbol() const { + auto *symbol = entryPointList[activeEntry].first; assert(symbol && "not inside a procedure"); return *symbol; } + /// Return a pointer to the current entry point Evaluation. + /// This is null for a primary entry point. + Evaluation *getEntryEval() const { + return entryPointList[activeEntry].second; + } /// Helper to get location from FunctionLikeUnit begin/end statements. static parser::CharBlock stmtSourceLoc(const FunctionStatement &stmt) { @@ -456,11 +467,20 @@ struct FunctionLikeUnit : public ProgramUnit { LabelEvalMap labelEvaluationMap; SymbolLabelMap assignSymbolLabelMap; std::list nestedFunctions; - /// Symbol associated to this FunctionLikeUnit. - /// Null if the FunctionLikeUnit is an anonymous program. - /// The symbol has MainProgramDetails for named programs, otherwise it has - /// SubprogramDetails. - const semantics::Symbol *symbol{nullptr}; + /// pairs for each entry point. The pair at index 0 + /// is the primary entry point; remaining pairs are alternate entry points. + /// The primary entry point symbol is Null for an anonymous program. + /// A named program symbol has MainProgramDetails. Other symbols have + /// SubprogramDetails. Evaluations are filled in for alternate entries. + llvm::SmallVector, 1> + entryPointList{std::pair{nullptr, nullptr}}; + /// Current index into entryPointList. Index 0 is the primary entry point. + int activeEntry = 0; + /// Dummy arguments that are not universal across entry points. + llvm::SmallVector nonUniversalDummyArguments; + /// Primary result for function subprograms with alternate entries. This + /// is one of the largest result values, not necessarily the first one. + const semantics::Symbol *primaryResult{nullptr}; /// Terminal basic block (if any) mlir::Block *finalBlock{}; std::vector> varList; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 35acf669a14a7..28e0ba5ee62df 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -494,15 +494,22 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// /// Generate the cleanup block before the procedure exits void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) { - const auto &details = - functionSymbol.get(); - auto resultRef = lookupSymbol(details.result()); - // TODO: This should probably look at the callee interface result instead - // to know what must be returned. - mlir::Value retval = resultRef; - if (!resultRef.getType().isa()) - retval = builder->create(toLocation(), resultRef); - builder->create(toLocation(), retval); + const auto &resultSym = + functionSymbol.get().result(); + mlir::Value resultRef = lookupSymbol(resultSym); + auto loc = toLocation(); + if (resultRef.getType().isa()) { + builder->create(loc, resultRef); + return; + } + // A function with multiple entry points returning different types tags + // all result variables with one of the largest types to allow them to + // share the the same storage. Convert this to the actual type. + mlir::Type resultRefType = builder->getRefType(genType(resultSym)); + if (resultRef.getType() != resultRefType) + resultRef = builder->createConvert(loc, resultRefType, resultRef); + mlir::Value resultVal = builder->create(loc, resultRef); + builder->create(loc, resultVal); } /// Argument \p funit is a subroutine that has alternate return specifiers. @@ -1245,9 +1252,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { //===--------------------------------------------------------------------===// - void genFIR(const Fortran::parser::ContinueStmt &) { - // do nothing - } + void genFIR(const Fortran::parser::ContinueStmt &) {} // nop void genFIR(const Fortran::parser::EventPostStmt &stmt) { genEventPostStatement(*this, stmt); @@ -1397,8 +1402,18 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Value addr = isPointer ? genExprValue(assign.lhs) : genExprAddr(assign.lhs); auto val = genExprValue(assign.rhs); - auto toTy = fir::dyn_cast_ptrEleTy(addr.getType()); + // A function with multiple entry points returning different + // types tags all result variables with one of the largest + // types to allow them to share the same storage. Assignment + // to a result variable of one of the other types requires + // conversion to the actual type. + auto toTy = genType(assign.lhs); auto cast = builder->convertWithSemantics(loc, toTy, val); + if (fir::dyn_cast_ptrEleTy(addr.getType()) != toTy) { + assert(sym->IsFuncResult() && "type mismatch"); + addr = builder->createConvert( + toLocation(), builder->getRefType(toTy), addr); + } builder->create(loc, cast, addr); return; } @@ -1491,11 +1506,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // data transfer statement. } - void genFIR(const Fortran::parser::EntryStmt &) { - // FIXME: Need to lower this for F77. - mlir::emitError(toLocation(), "ENTRY statement is not handled."); - exit(1); - } + void genFIR(const Fortran::parser::EntryStmt &) {} // nop void genFIR(const Fortran::parser::PauseStmt &stmt) { genPauseStatement(*this, stmt); @@ -1594,12 +1605,20 @@ class FirConverter : public Fortran::lower::AbstractConverter { void instantiateGlobal(const Fortran::lower::pft::Variable &var) { const auto &sym = var.getSymbol(); auto globalName = mangleName(sym); - fir::GlobalOp global; bool isConst = sym.attrs().test(Fortran::semantics::Attr::PARAMETER); auto loc = genLocation(sym.name()); auto idxTy = builder->getIndexType(); - if (builder->getNamedGlobal(globalName)) + // FIXME: name returned does not consider subprogram's scope, is not unique + fir::GlobalOp global = builder->getNamedGlobal(globalName); + if (global) { + if (!lookupSymbol(sym)) { + // Reference from an alternate entry point - use primary entry name. + auto addrOf = builder->create(loc, global.resultType(), + global.getSymbol()); + addSymbol(sym, addrOf); + } return; + } if (const auto *details = sym.detailsIf()) { if (details->init()) { @@ -1635,35 +1654,35 @@ class FirConverter : public Fortran::lower::AbstractConverter { } auto addrOf = builder->create(loc, global.resultType(), global.getSymbol()); - SymbolBoxAnalyzer sia(sym); - sia.analyze(); - if (sia.isTrivial()) { + SymbolBoxAnalyzer sba(sym); + sba.analyze(); + if (sba.isTrivial()) { addSymbol(sym, addrOf); return; } mlir::Value len; - if (sia.isChar) { - auto c = sia.getCharLenConst(); + if (sba.isChar) { + auto c = sba.getCharLenConst(); assert(c.hasValue()); len = builder->createIntegerConstant(loc, idxTy, *c); } llvm::SmallVector extents; llvm::SmallVector lbounds; - if (sia.isArray) { - assert(sia.staticSize); - for (auto i : sia.staticShape) + if (sba.isArray) { + assert(sba.staticSize); + for (auto i : sba.staticShape) extents.push_back(builder->createIntegerConstant(loc, idxTy, i)); - if (!sia.lboundIsAllOnes()) - for (auto i : sia.staticLBound) + if (!sba.lboundIsAllOnes()) + for (auto i : sba.staticLBound) lbounds.push_back(builder->createIntegerConstant(loc, idxTy, i)); } - if (sia.isChar && sia.isArray) { + if (sba.isChar && sba.isArray) { localSymbols.addCharSymbolWithBounds(sym, addrOf, len, extents, lbounds); - } else if (sia.isChar) { + } else if (sba.isChar) { localSymbols.addCharSymbol(sym, addrOf, len); } else { - assert(sia.isArray); + assert(sba.isArray); localSymbols.addSymbolWithBounds(sym, addrOf, extents, lbounds); } } else if (const auto *details = @@ -1779,10 +1798,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { const auto isDummy = Fortran::semantics::IsDummy(sym); const auto isResult = Fortran::semantics::IsFunctionResult(sym); Fortran::lower::CharacterExprHelper charHelp{*builder, loc}; - SymbolBoxAnalyzer sia(sym); - sia.analyze(); + SymbolBoxAnalyzer sba(sym); + sba.analyze(); - if (sia.isTrivial()) { + if (sba.isTrivial()) { if (isDummy) { // This is an argument. assert(lookupSymbol(sym) && "must already be in map"); @@ -1791,7 +1810,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // TODO: What about lower host-associated variables? (They probably need // to be handled as dummy parameters.) - // Otherwise, it's a local variable. + // Otherwise, it's a local variable or function result. auto local = createNewLocal(loc, var, preAlloc); addSymbol(sym, local); return; @@ -1808,16 +1827,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Value len{}; [[maybe_unused]] bool mustBeDummy = false; - if (sia.isChar) { + if (sba.isChar) { // if element type is a CHARACTER, determine the LEN value if (isDummy || isResult) { auto unboxchar = charHelp.createUnboxChar(addr); auto boxAddr = unboxchar.first; - if (auto c = sia.getCharLenConst()) { + if (auto c = sba.getCharLenConst()) { // Set/override LEN with a constant len = builder->createIntegerConstant(loc, idxTy, *c); addr = charHelp.createEmboxChar(boxAddr, len); - } else if (auto e = sia.getCharLenExpr()) { + } else if (auto e = sba.getCharLenExpr()) { // Set/override LEN with an expression len = genExprValue(*e); addr = charHelp.createEmboxChar(boxAddr, len); @@ -1829,13 +1848,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { // XXX: Subsequent lowering expects a CHARACTER variable to be in a // boxchar. We assert that here. We might want to reconsider this // precondition. - assert(addr.getType().isa()); + // Update: Skeleton entry point dummy char argument generation hits + // this assert. Suppress it pending further investigation. + // assert(addr.getType().isa()); } else { // local CHARACTER variable - if (auto c = sia.getCharLenConst()) { + if (auto c = sba.getCharLenConst()) { len = builder->createIntegerConstant(loc, idxTy, *c); } else { - auto e = sia.getCharLenExpr(); + auto e = sba.getCharLenExpr(); assert(e && "CHARACTER variable must have LEN parameter"); len = genExprValue(*e); } @@ -1843,23 +1864,23 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } - if (sia.isArray) { + if (sba.isArray) { // if object is an array process the lower bound and extent values llvm::SmallVector extents; llvm::SmallVector lbounds; mustBeDummy = !isExplicitShape(sym) && !Fortran::semantics::IsAllocatableOrPointer(sym); - if (sia.staticSize) { + if (sba.staticSize) { // object shape is constant auto castTy = builder->getRefType(genType(var)); if (addr) addr = builder->createConvert(loc, castTy, addr); - if (sia.lboundIsAllOnes()) { + if (sba.lboundIsAllOnes()) { // if lower bounds are all ones, build simple shaped object llvm::SmallVector shape; - for (auto i : sia.staticShape) + for (auto i : sba.staticShape) shape.push_back(builder->createIntegerConstant(loc, idxTy, i)); - if (sia.isChar) { + if (sba.isChar) { if (isDummy || isResult) { localSymbols.addCharSymbolWithShape(sym, addr, len, shape, true); return; @@ -1891,7 +1912,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } // construct constants and populate `bounds` - for (const auto &i : llvm::zip(sia.staticLBound, sia.staticShape)) { + for (const auto &i : llvm::zip(sba.staticLBound, sba.staticShape)) { auto fst = builder->createIntegerConstant(loc, idxTy, std::get<0>(i)); auto snd = builder->createIntegerConstant(loc, idxTy, std::get<1>(i)); lbounds.emplace_back(fst); @@ -1899,7 +1920,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // default array case: populate `bounds` with lower and extent values - for (const auto &spec : sia.dynamicBound) { + for (const auto &spec : sba.dynamicBound) { auto low = spec->lbound().GetExplicit(); auto high = spec->ubound().GetExplicit(); if (low && high) { @@ -1924,7 +1945,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { break; } - if (sia.isChar) { + if (sba.isChar) { if (isDummy || isResult) { localSymbols.addCharSymbolWithBounds(sym, addr, len, extents, lbounds, true); @@ -1951,14 +1972,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // not an array, so process as scalar argument - if (sia.isChar) { + if (sba.isChar) { if (isDummy || isResult) { addCharSymbol(sym, addr, len, true); return; } assert(!mustBeDummy); auto charTy = genType(var); - auto c = sia.getCharLenConst(); + auto c = sba.getCharLenConst(); mlir::Value local = c ? charHelp.createCharacterTemp(charTy, *c) : charHelp.createCharacterTemp(charTy, len); addCharSymbol(sym, local, len); @@ -2012,7 +2033,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { instantiateLocal(var); } - void mapDummyAndResults(const Fortran::lower::CalleeInterface &callee) { + void mapDummiesAndResults(const Fortran::lower::pft::FunctionLikeUnit &funit, + const Fortran::lower::CalleeInterface &callee) { assert(builder && "need a builder at this point"); using PassBy = Fortran::lower::CalleeInterface::PassEntityBy; auto mapPassedEntity = [&](const auto arg) -> void { @@ -2028,8 +2050,21 @@ class FirConverter : public Fortran::lower::AbstractConverter { for (const auto &arg : callee.getPassedArguments()) { mapPassedEntity(arg); } + // Allocate local skeleton instances of dummies from other entry points. + // Most of these locals will not survive into final generated code, but + // some will. It is illegal to reference them at run time if they do. + for (const auto *arg : funit.nonUniversalDummyArguments) { + if (lookupSymbol(*arg)) + continue; + auto type = genType(*arg); + // TODO: Account for VALUE arguments (and possibly other variants). + type = builder->getRefType(type); + addSymbol(*arg, builder->create(toLocation(), type)); + } if (auto passedResult = callee.getPassedResult()) { mapPassedEntity(*passedResult); + if (*passedResult->entity != *funit.primaryResult) + addSymbol(*funit.primaryResult, lookupSymbol(passedResult->entity)); } } @@ -2042,13 +2077,37 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(builder && "FirOpBuilder did not instantiate"); builder->setInsertionPointToStart(&func.front()); - mapDummyAndResults(callee); - - for (const auto &var : funit.getOrderedSymbolTable()) - instantiateVar(var); + mapDummiesAndResults(funit, callee); + + mlir::Value primaryFuncResult; + llvm::SmallVector + deferredFuncResultList; + for (const auto &var : funit.getOrderedSymbolTable()) { + const Fortran::semantics::Symbol *sym = &var.getSymbol(); + if (!sym->IsFuncResult() || !funit.primaryResult) { + instantiateVar(var); + } else if (sym == funit.primaryResult) { + instantiateVar(var); + primaryFuncResult = lookupSymbol(*sym); + } else { + deferredFuncResultList.push_back(sym); + } + } + for (auto altResult : deferredFuncResultList) + addSymbol(*altResult, primaryFuncResult); // Create most function blocks in advance. - createEmptyBlocks(funit.evaluationList); + auto *alternateEntryEval = funit.getEntryEval(); + if (alternateEntryEval) { + // Move to executable successor. + alternateEntryEval = alternateEntryEval->lexicalSuccessor; + bool evalIsNewBlock = alternateEntryEval->isNewBlock; + alternateEntryEval->isNewBlock = true; + createEmptyBlocks(funit.evaluationList); + alternateEntryEval->isNewBlock = evalIsNewBlock; + } else { + createEmptyBlocks(funit.evaluationList); + } // Reinstate entry block as the current insertion point. builder->setInsertionPointToEnd(&func.front()); @@ -2067,6 +2126,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->createIntegerConstant(loc, builder->getIndexType(), 0); builder->create(loc, zero, altResult); } + + if (alternateEntryEval) { + genBranch(alternateEntryEval->block); + builder->setInsertionPointToStart( + builder->createBlock(&builder->getRegion())); + } } /// Create empty blocks for the current function. @@ -2116,29 +2181,30 @@ class FirConverter : public Fortran::lower::AbstractConverter { void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { setCurrentPosition( Fortran::lower::pft::FunctionLikeUnit::stmtSourceLoc(funit.endStmt)); - if (funit.isMainProgram()) genExitRoutine(); else genFIRProcedureExit(funit, funit.getSubprogramSymbol()); - - // immediately throw away any dead code just created - mlir::simplifyRegions({builder->getRegion()}); + funit.finalBlock = nullptr; + mlir::simplifyRegions({builder->getRegion()}); // remove dead code delete builder; builder = nullptr; localSymbols.clear(); } - /// Lower a procedure-like construct + /// Lower a procedure (nest). void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) { - startNewFunction(funit); - // lower this procedure - for (auto &eval : funit.evaluationList) - genFIR(eval); - endNewFunction(funit); - // recursively lower internal procedures + for (int entryIndex = 0, last = funit.entryPointList.size(); + entryIndex < last; ++entryIndex) { + funit.setActiveEntry(entryIndex); + startNewFunction(funit); // this entry point of this procedure + for (auto &eval : funit.evaluationList) + genFIR(eval); + endNewFunction(funit); + } + funit.setActiveEntry(0); for (auto &f : funit.nestedFunctions) - lowerFunc(f); + lowerFunc(f); // internal procedure } void lowerMod(Fortran::lower::pft::ModuleLikeUnit &mod) { diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 4879c7d70890c..ba2bb583b20a5 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -310,15 +310,27 @@ class ExprLowering { fir::ExtendedValue genval(Fortran::semantics::SymbolRef sym) { auto var = gen(sym); if (auto *s = var.getUnboxed()) - if (fir::isReferenceLike(s->getType())) - return genLoad(*s); + if (fir::isReferenceLike(s->getType())) { + // A function with multiple entry points returning different types + // tags all result variables with one of the largest types to allow + // them to share the same storage. A reference to a result variable + // of one of the other types requires conversion to the actual type. + auto addr = *s; + if (Fortran::semantics::IsFunctionResult(sym)) { + auto resultType = converter.genType(*sym); + if (addr.getType() != resultType) + addr = builder.createConvert(getLoc(), + builder.getRefType(resultType), addr); + } + return genLoad(addr); + } if (inArrayContext()) { // FIXME: make this more robust auto base = fir::getBase(var); auto ty = builder.getRefType( - peelType(base.getType(), exprCtx.getLoopVars().size() + 1)); + peelType(base.getType(), context.getLoopVars().size() + 1)); auto coor = builder.create(getLoc(), ty, base, - exprCtx.getLoopVars()); + context.getLoopVars()); return genLoad(coor); } return var; @@ -1029,9 +1041,9 @@ class ExprLowering { auto tlb = builder.createConvert(loc, idxTy, std::get<0>(*trip)); auto dlb = builder.createConvert(loc, idxTy, getLB(arr, dim)); auto diff = builder.create(loc, tlb, dlb); - assert(idx < exprCtx.getLoopVars().size()); + assert(idx < context.getLoopVars().size()); auto sum = builder.create(loc, diff, - exprCtx.getLoopVars()[idx++]); + context.getLoopVars()[idx++]); auto del = builder.createConvert(loc, idxTy, std::get<2>(*trip)); auto scaled = builder.create(loc, del, delta); auto prod = builder.create(loc, scaled, sum); @@ -1115,7 +1127,7 @@ class ExprLowering { auto ty = builder.getIndexType(); auto step = builder.createConvert(loc, ty, std::get<2>(*range)); auto scale = builder.create( - loc, ty, exprCtx.getLoopVars()[i], step); + loc, ty, context.getLoopVars()[i], step); auto off = builder.createConvert(loc, ty, std::get<0>(*range)); args.push_back(builder.create(loc, ty, off, scale)); } diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index f1908ad6eb215..548e6ba56052e 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -176,14 +176,18 @@ class PFTBuilder { resetFunctionState(); } - /// Ensure that a function has a branch target after the last user statement. + /// Ensure that a function ends with a valid branch target (and is nonempty). void endFunctionBody() { - if (lastLexicalEvaluation) { + if (evaluationListStack.empty()) + return; + auto evaluationList = evaluationListStack.back(); + if (evaluationList->empty() || + !evaluationList->back().isA()) { static const parser::ContinueStmt endTarget{}; addEvaluation( lower::pft::Evaluation{endTarget, parentVariantStack.back(), {}, {}}); - lastLexicalEvaluation = nullptr; } + lastLexicalEvaluation = nullptr; } /// Initialize a new function-like unit and make it the builder's focus. @@ -204,6 +208,7 @@ class PFTBuilder { void exitFunction() { endFunctionBody(); analyzeBranches(nullptr, *evaluationListStack.back()); // add branch links + processEntryPoints(); popEvaluationList(); labelEvaluationMap = nullptr; assignSymbolLabelMap = nullptr; @@ -281,10 +286,10 @@ class PFTBuilder { /// Append an Evaluation to the end of the current list. lower::pft::Evaluation &addEvaluation(lower::pft::Evaluation &&eval) { assert(functionList && "not in a function"); - assert(evaluationListStack.size() > 0); - if (constructAndDirectiveStack.size() > 0) { + assert(!evaluationListStack.empty() && "empty evaluation list stack"); + if (!constructAndDirectiveStack.empty()) eval.parentConstruct = constructAndDirectiveStack.back(); - } + auto &entryPointList = eval.getOwningProcedure()->entryPointList; evaluationListStack.back()->emplace_back(std::move(eval)); lower::pft::Evaluation *p = &evaluationListStack.back()->back(); if (p->isActionStmt() || p->isConstructStmt()) { @@ -295,6 +300,19 @@ class PFTBuilder { p->printIndex = 1; } lastLexicalEvaluation = p; + for (auto entryIndex = entryPointList.size() - 1; + entryIndex && !entryPointList[entryIndex].second->lexicalSuccessor; + --entryIndex) + // Link to the entry's first executable statement. + entryPointList[entryIndex].second->lexicalSuccessor = p; + } else if (const auto *entryStmt = p->getIf()) { + const auto *sym = std::get(entryStmt->t).symbol; + if (sym->IsFuncResult()) + // Switch to the function sym. + sym = sym->owner().parent().FindSymbol(sym->name()); + assert(sym->has() && + "entry must be a subprogram"); + entryPointList.push_back(std::pair{sym, p}); } if (p->label.has_value()) { labelEvaluationMap->try_emplace(*p->label, p); @@ -743,6 +761,46 @@ class PFTBuilder { } } + /// For multiple entry subprograms, build a list of the dummy arguments that + /// appear in some, but not all entry points. For those that are functions, + /// also find one of the largest function results, since a single result + /// container holds the result for all entries. + void processEntryPoints() { + auto *unit = evaluationListStack.back()->front().getOwningProcedure(); + int entryCount = unit->entryPointList.size(); + if (entryCount == 1) + return; + llvm::DenseMap dummyCountMap; + for (int entryIndex = 0; entryIndex < entryCount; ++entryIndex) { + unit->setActiveEntry(entryIndex); + const auto &details = unit->getSubprogramSymbol() + .get(); + for (auto *arg : details.dummyArgs()) { + if (!arg) + continue; // alternate return specifier (no actual argument) + const auto iter = dummyCountMap.find(arg); + if (iter == dummyCountMap.end()) + dummyCountMap.try_emplace(arg, 1); + else + ++iter->second; + } + if (details.isFunction()) { + const auto *resultSym = &details.result(); + assert(resultSym && "missing result symbol"); + if (!unit->primaryResult || + unit->primaryResult->size() < resultSym->size()) + unit->primaryResult = resultSym; + } + } + unit->setActiveEntry(0); + for (auto arg : dummyCountMap) + if (arg.second < entryCount) + unit->nonUniversalDummyArguments.push_back(arg.first); + // Sort to provide generated code order stability. + std::sort(unit->nonUniversalDummyArguments.begin(), + unit->nonUniversalDummyArguments.end(), std::greater<>()); + } + std::unique_ptr pgm; std::vector parentVariantStack; const semantics::SemanticsContext &semanticsContext; @@ -815,7 +873,7 @@ class PFTDumper { if (eval.isNewBlock) { outputStream << '^'; } - if (eval.localBlocks.size()) { + if (!eval.localBlocks.empty()) { outputStream << '*'; } outputStream << name << bang; @@ -823,8 +881,10 @@ class PFTDumper { if (eval.controlSuccessor) { outputStream << " -> " << eval.controlSuccessor->printIndex; } + } else if (eval.isA() && eval.lexicalSuccessor) { + outputStream << " -> " << eval.lexicalSuccessor->printIndex; } - if (eval.position.size()) { + if (!eval.position.empty()) { outputStream << ": " << eval.position.ToString(); } outputStream << '\n'; @@ -865,7 +925,7 @@ class PFTDumper { name = ""; } outputStream << unitKind << ' ' << name; - if (header.size()) + if (!header.empty()) outputStream << ": " << header; outputStream << '\n'; dumpEvaluationList(outputStream, functionLikeUnit.evaluationList); @@ -1084,12 +1144,12 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( : ProgramUnit{func, parent}, endStmt{ getFunctionStmt( func)} { - const auto &ps{ + const auto &programStmt{ std::get>>(func.t)}; - if (ps.has_value()) { - FunctionStatement begin{ps.value()}; - beginStmt = begin; - symbol = getSymbol(beginStmt); + if (programStmt.has_value()) { + beginStmt = programStmt.value(); + auto symbol = getSymbol(beginStmt); + entryPointList[0].first = symbol; processSymbolTable(*symbol->scope()); } else { processSymbolTable(semanticsContext.FindScope( @@ -1103,8 +1163,9 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( const semantics::SemanticsContext &) : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, - endStmt{getFunctionStmt(func)}, symbol{getSymbol( - beginStmt)} { + endStmt{getFunctionStmt(func)} { + auto symbol = getSymbol(beginStmt); + entryPointList[0].first = symbol; processSymbolTable(*symbol->scope()); } @@ -1114,8 +1175,9 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( const semantics::SemanticsContext &) : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, - endStmt{getFunctionStmt(func)}, - symbol{getSymbol(beginStmt)} { + endStmt{getFunctionStmt(func)} { + auto symbol = getSymbol(beginStmt); + entryPointList[0].first = symbol; processSymbolTable(*symbol->scope()); } @@ -1125,8 +1187,9 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( const semantics::SemanticsContext &) : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, - endStmt{getFunctionStmt(func)}, - symbol{getSymbol(beginStmt)} { + endStmt{getFunctionStmt(func)} { + auto symbol = getSymbol(beginStmt); + entryPointList[0].first = symbol; processSymbolTable(*symbol->scope()); } diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 2820ab62922e8..c8141d604952c 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3088,6 +3088,7 @@ void SubprogramVisitor::Post(const parser::EntryStmt &stmt) { } else { dummy = &MakeSymbol(*dummyName, EntityDetails{true}); } + ApplyImplicitRules(*dummy); entryDetails.add_dummyArg(*dummy); } else { if (inFunction) { // C1573 diff --git a/flang/test/Lower/entry.f90 b/flang/test/Lower/entry.f90 new file mode 100644 index 0000000000000..8cee9374990b8 --- /dev/null +++ b/flang/test/Lower/entry.f90 @@ -0,0 +1,70 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +! CHECK-LABEL: func @_QPss(%arg0: !fir.ref) +subroutine ss(n1) + ! CHECK: fir.alloca i32 {name = "nx"} + ! CHECK: fir.alloca i32 {name = "ny"} + integer n17, n2 + nx = 100 + n1 = nx + 10 + return + +! CHECK-LABEL: func @_QPe1(%arg0: !fir.ref, %arg1: !fir.ref) +entry e1(n2, n17) + ! CHECK: fir.alloca i32 {name = "nx"} + ! CHECK: fir.alloca i32 {name = "ny"} + ny = 200 + n2 = ny + 20 + return + +! CHECK-LABEL: func @_QPe2(%arg0: !fir.ref, %arg1: !fir.ref) +entry e2(n3, n1) + ! CHECK: fir.alloca i32 {name = "nx"} + ! CHECK: fir.alloca i32 {name = "ny"} + +! CHECK-LABEL: func @_QPe3(%arg0: !fir.ref) +entry e3(n1) + ! CHECK: fir.alloca i32 {name = "nx"} + ! CHECK: fir.alloca i32 {name = "ny"} + n1 = 30 +end + +! CHECK-LABEL: func @_QPjj(%arg0: !fir.ref) -> i32 +function jj(n1) + ! CHECK: fir.alloca i32 {name = "jj"} + jj = 100 + jj = jj + n1 + return + +! CHECK-LABEL: func @_QPrr(%arg0: !fir.ref) -> f32 +entry rr(n2) + ! CHECK: fir.alloca i32 {name = "jj"} + rr = 200.0 + rr = rr + n2 +end + +program entries + character(10) hh, qq, m + integer mm + call ss(mm); print*, mm + call e1(mm, 17); print*, mm + call e2(17, mm); print*, mm + call e3(mm); print*, mm + print*, jj(11) + print*, rr(22) + m = 'abcd efgh' + print*, hh(m) + print*, qq(m) +end + +! CHECK-LABEL: func @_QPhh(%arg0: !fir.ref>, %arg1: index, %arg2: +! !fir.boxchar<1>) -> !fir.boxchar<1> +function hh(c1) + character(10) c1, hh, qq + hh = c1 + return +! CHECK-LABEL: func @_QPqq(%arg0: !fir.ref>, %arg1: index, %arg2: +! !fir.boxchar<1>) -> !fir.boxchar<1> +entry qq(c1) + qq = c1 +end From 5daf098568526bded418d801b22bd9ef6c8a02cb Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 14 Jul 2020 19:16:41 -0700 Subject: [PATCH 0178/1017] Handle EQUIVALENCE of local variables. Add LLVM style dump methods. Fix const correctness issues. Misc. LLVM coding convention cleanup. add test deal with conflicts from ENTRY --- flang/include/flang/Lower/PFTBuilder.h | 48 +++- flang/lib/Lower/Bridge.cpp | 108 ++++++-- flang/lib/Lower/ConvertExpr.cpp | 10 +- flang/lib/Lower/PFTBuilder.cpp | 333 ++++++++++++++++--------- flang/test/Lower/equivalence.f90 | 33 +++ 5 files changed, 377 insertions(+), 155 deletions(-) create mode 100644 flang/test/Lower/equivalence.f90 diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 66927cba10ab5..0e8ebf2892f57 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -253,6 +253,8 @@ struct Evaluation : EvaluationVariant { }}); } + LLVM_DUMP_METHOD void dump() const; + /// Return the first non-nop successor of an evaluation, possibly exiting /// from one or more enclosing constructs. Evaluation &nonNopSuccessor() const { @@ -361,33 +363,64 @@ struct ProgramUnit : ProgramVariant { /// A variable captures an object to be created per the declaration part of a /// function like unit. /// +/// Fortran EQUIVALENCE statements are a mechanism that introduces aliasing +/// between named variables. The set of overlapping aliases will materialize a +/// generic store object with a designated offset and size. Participant +/// symbols will simply be pointers into the primary store. +/// /// Properties can be applied by lowering. For example, a local array that is /// known to be very large may be transformed into a heap allocated entity by /// lowering. That decision would be tracked in its Variable instance. struct Variable { + using StoreInterval = std::tuple; explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false, int depth = 0) - : sym{&sym}, depth{depth}, global{global} {} + : u{&sym}, depth{depth}, global{global} {} + explicit Variable(StoreInterval &&store, bool global = false) + : u{std::move(store)}, depth{0}, global{global} {} + + const Fortran::semantics::Symbol &getSymbol() const { + assert(hasSymbol()); + return *std::get(u); + } - const Fortran::semantics::Symbol &getSymbol() const { return *sym; } + const StoreInterval &getPrimaryStore() const { + assert(isPrimaryStore()); + return std::get(u); + } + bool hasSymbol() const { + return std::holds_alternative(u); + } + bool isPrimaryStore() const { return !hasSymbol(); } bool isGlobal() const { return global; } bool isHeapAlloc() const { return heapAlloc; } bool isPointer() const { return pointer; } bool isTarget() const { return target; } int getDepth() const { return depth; } + bool isAlias() const { return aliasee; } + std::size_t getAlias() const { return aliasOffset; } + void setAlias(std::size_t offset) { + aliasee = true; + aliasOffset = offset; + } + void setHeapAlloc(bool to = true) { heapAlloc = to; } void setPointer(bool to = true) { pointer = to; } void setTarget(bool to = true) { target = to; } + LLVM_DUMP_METHOD void dump() const; + private: - const Fortran::semantics::Symbol *sym; + std::variant u; int depth; bool global; bool heapAlloc{false}; // variable needs deallocation on exit bool pointer{false}; bool target{false}; + bool aliasee{false}; // participates in EQUIVALENCE union + std::size_t aliasOffset{}; }; /// Function-like units may contain evaluations (executable statements) and @@ -460,6 +493,8 @@ struct FunctionLikeUnit : public ProgramUnit { return stmt.visit(common::visitors{[](const auto &x) { return x.source; }}); } + LLVM_DUMP_METHOD void dump() const; + /// Anonymous programs do not have a begin statement std::optional beginStmt; FunctionStatement endStmt; @@ -502,6 +537,8 @@ struct ModuleLikeUnit : public ProgramUnit { ModuleLikeUnit(ModuleLikeUnit &&) = default; ModuleLikeUnit(const ModuleLikeUnit &) = delete; + LLVM_DUMP_METHOD void dump() const; + ModuleStatement beginStmt; ModuleStatement endStmt; std::list nestedFunctions; @@ -522,10 +559,11 @@ struct Program { Program(Program &&) = default; Program(const Program &) = delete; + const std::list &getUnits() const { return units; } std::list &getUnits() { return units; } /// LLVM dump method on a Program. - void dump(); + LLVM_DUMP_METHOD void dump() const; private: std::list units; @@ -546,7 +584,7 @@ createPFT(const parser::Program &root, const Fortran::semantics::SemanticsContext &semanticsContext); /// Dumper for displaying a PFT. -void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft); +void dumpPFT(llvm::raw_ostream &outputStream, const pft::Program &pft); } // namespace lower } // namespace Fortran diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 28e0ba5ee62df..8283e5ef25056 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -956,12 +956,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { forall.t); setCurrentPosition(stmt.source); auto &fas = stmt.statement; - auto &ctrl = + [[maybe_unused]] auto &ctrl = std::get< Fortran::common::Indirection>( fas.t) .value(); - (void)ctrl; for (auto &s : std::get>(forall.t)) { std::visit( @@ -1587,13 +1586,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (unstructuredContext && blockIsUnterminated()) { // Exit from an unstructured IF or SELECT construct block. Fortran::lower::pft::Evaluation *successor{}; - if (eval.isActionStmt()) { + if (eval.isActionStmt()) successor = eval.controlSuccessor; - } else if (eval.isConstruct() && - eval.getLastNestedEvaluation() - .lexicalSuccessor->isIntermediateConstructStmt()) { + else if (eval.isConstruct() && + eval.getLastNestedEvaluation() + .lexicalSuccessor->isIntermediateConstructStmt()) successor = eval.constructExit; - } + if (successor && successor->block) genBranch(successor->block); } @@ -1787,14 +1786,60 @@ class FirConverter : public Fortran::lower::AbstractConverter { return local; } + /// This is a primary store for a set of EQUIVALENCED variables. Create the + /// store on the stack and add it to the map. + void + instantiatePrimaryStore(const Fortran::lower::pft::Variable &var, + llvm::DenseMap &storeMap) { + assert(var.isPrimaryStore()); + // Allocate an anonymous block of memory. + auto off = std::get<0>(var.getPrimaryStore()); + auto size = std::get<1>(var.getPrimaryStore()); + auto i8Ty = builder->getIntegerType(8); + auto loc = toLocation(); + auto idxTy = builder->getIndexType(); + llvm::SmallVector shape = { + builder->createIntegerConstant(loc, idxTy, size)}; + auto local = + builder->allocateLocal(toLocation(), i8Ty, "", shape, /*target=*/false); + storeMap[off] = local; + } + /// Instantiate a local variable. Precondition: Each variable will be visited /// such that if it's properties depend on other variables, the variables upon /// which its properties depend will already have been visited. void instantiateLocal(const Fortran::lower::pft::Variable &var, + llvm::DenseMap &storeMap, mlir::Value *preAlloc = nullptr) { + mlir::Value result; const auto &sym = var.getSymbol(); const auto loc = genLocation(sym.name()); auto idxTy = builder->getIndexType(); + if (var.isAlias()) { + // If var is an alias, then use the alias offset to lookup the + // corresponding primary storage for this alias set. The primary storage + // must have already been instantiated and added to the `storeMap`. Note + // that this does not handle EQUIVALENCED globals. Assumably those will be + // like COMMON blocks. + if (preAlloc) { + llvm::errs() << "TODO: EQUIVALENCE used on variable in COMMON\n"; + exit(1); + } + assert(!preAlloc && "cannot be in COMMON"); + auto aliasOffset = var.getAlias(); + assert(storeMap.count(aliasOffset)); + auto store = storeMap.find(aliasOffset)->second; + auto i8Ty = builder->getIntegerType(8); + auto i8Ptr = builder->getRefType(i8Ty); + auto seqTy = builder->getRefType(builder->getVarLenSeqTy(i8Ty)); + auto base = builder->createConvert(loc, seqTy, store); + llvm::SmallVector offs{builder->createIntegerConstant( + loc, idxTy, sym.offset() - aliasOffset)}; + auto ptr = builder->create(loc, i8Ptr, base, offs); + result = + builder->createConvert(loc, builder->getRefType(genType(sym)), ptr); + preAlloc = &result; + } const auto isDummy = Fortran::semantics::IsDummy(sym); const auto isResult = Fortran::semantics::IsFunctionResult(sym); Fortran::lower::CharacterExprHelper charHelp{*builder, loc}; @@ -1997,7 +2042,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// within the COMMON block. Adds the address of `var` (COMMON + offset) to /// the symbol map. void instantiateCommon(const Fortran::semantics::Symbol &common, - const Fortran::lower::pft::Variable &var) { + const Fortran::lower::pft::Variable &var, + llvm::DenseMap &storeMap) { auto commonName = mangleName(common); auto global = builder->getNamedGlobal(commonName); if (!global) @@ -2012,25 +2058,28 @@ class FirConverter : public Fortran::lower::AbstractConverter { } auto byteOffset = varSym.offset(); auto i8Ty = builder->getIntegerType(8); - auto i8Ptr = fir::ReferenceType::get(i8Ty); - auto seqTy = fir::ReferenceType::get(builder->getVarLenSeqTy(i8Ty)); + auto i8Ptr = builder->getRefType(i8Ty); + auto seqTy = builder->getRefType(builder->getVarLenSeqTy(i8Ty)); auto base = builder->createConvert(loc, seqTy, commonAddr); llvm::SmallVector offs{builder->createIntegerConstant( loc, builder->getIndexType(), byteOffset)}; auto varAddr = builder->create(loc, i8Ptr, base, offs); - auto localTy = fir::ReferenceType::get(genType(var)); + auto localTy = builder->getRefType(genType(var)); mlir::Value local = builder->createConvert(loc, localTy, varAddr); - instantiateLocal(var, &local); + instantiateLocal(var, storeMap, &local); } - void instantiateVar(const Fortran::lower::pft::Variable &var) { - if (auto *common = - Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) - instantiateCommon(*common, var); + void instantiateVar(const Fortran::lower::pft::Variable &var, + llvm::DenseMap &storeMap) { + if (var.isPrimaryStore()) + instantiatePrimaryStore(var, storeMap); + else if (auto *common = + Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) + instantiateCommon(*common, var, storeMap); else if (var.isGlobal()) instantiateGlobal(var); else - instantiateLocal(var); + instantiateLocal(var, storeMap); } void mapDummiesAndResults(const Fortran::lower::pft::FunctionLikeUnit &funit, @@ -2047,9 +2096,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { addSymbol(arg.entity.get(), arg.firArgument); } }; - for (const auto &arg : callee.getPassedArguments()) { + for (const auto &arg : callee.getPassedArguments()) mapPassedEntity(arg); - } + // Allocate local skeleton instances of dummies from other entry points. // Most of these locals will not survive into final generated code, but // some will. It is illegal to reference them at run time if they do. @@ -2082,15 +2131,20 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Value primaryFuncResult; llvm::SmallVector deferredFuncResultList; + llvm::DenseMap storeMap; for (const auto &var : funit.getOrderedSymbolTable()) { - const Fortran::semantics::Symbol *sym = &var.getSymbol(); - if (!sym->IsFuncResult() || !funit.primaryResult) { - instantiateVar(var); - } else if (sym == funit.primaryResult) { - instantiateVar(var); - primaryFuncResult = lookupSymbol(*sym); + if (var.isPrimaryStore()) { + instantiateVar(var, storeMap); + continue; + } + const Fortran::semantics::Symbol &sym = var.getSymbol(); + if (!sym.IsFuncResult() || !funit.primaryResult) { + instantiateVar(var, storeMap); + } else if (&sym == funit.primaryResult) { + instantiateVar(var, storeMap); + primaryFuncResult = lookupSymbol(sym); } else { - deferredFuncResultList.push_back(sym); + deferredFuncResultList.push_back(&sym); } } for (auto altResult : deferredFuncResultList) @@ -2101,7 +2155,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (alternateEntryEval) { // Move to executable successor. alternateEntryEval = alternateEntryEval->lexicalSuccessor; - bool evalIsNewBlock = alternateEntryEval->isNewBlock; + auto evalIsNewBlock = alternateEntryEval->isNewBlock; alternateEntryEval->isNewBlock = true; createEmptyBlocks(funit.evaluationList); alternateEntryEval->isNewBlock = evalIsNewBlock; diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index ba2bb583b20a5..9ff7d8154a697 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -328,9 +328,9 @@ class ExprLowering { // FIXME: make this more robust auto base = fir::getBase(var); auto ty = builder.getRefType( - peelType(base.getType(), context.getLoopVars().size() + 1)); + peelType(base.getType(), exprCtx.getLoopVars().size() + 1)); auto coor = builder.create(getLoc(), ty, base, - context.getLoopVars()); + exprCtx.getLoopVars()); return genLoad(coor); } return var; @@ -1041,9 +1041,9 @@ class ExprLowering { auto tlb = builder.createConvert(loc, idxTy, std::get<0>(*trip)); auto dlb = builder.createConvert(loc, idxTy, getLB(arr, dim)); auto diff = builder.create(loc, tlb, dlb); - assert(idx < context.getLoopVars().size()); + assert(idx < exprCtx.getLoopVars().size()); auto sum = builder.create(loc, diff, - context.getLoopVars()[idx++]); + exprCtx.getLoopVars()[idx++]); auto del = builder.createConvert(loc, idxTy, std::get<2>(*trip)); auto scaled = builder.create(loc, del, delta); auto prod = builder.create(loc, scaled, sum); @@ -1127,7 +1127,7 @@ class ExprLowering { auto ty = builder.getIndexType(); auto step = builder.createConvert(loc, ty, std::get<2>(*range)); auto scale = builder.create( - loc, ty, context.getLoopVars()[i], step); + loc, ty, exprCtx.getLoopVars()[i], step); auto off = builder.createConvert(loc, ty, std::get<0>(*range)); args.push_back(builder.create(loc, ty, off, scale)); } diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 548e6ba56052e..248e7f0cc7068 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -12,6 +12,7 @@ #include "flang/Parser/parse-tree-visitor.h" #include "flang/Semantics/semantics.h" #include "flang/Semantics/tools.h" +#include "llvm/ADT/IntervalMap.h" #include "llvm/Support/CommandLine.h" static llvm::cl::opt clDisableStructuredFir( @@ -385,9 +386,8 @@ class PFTBuilder { void markBranchTarget(lower::pft::Evaluation &sourceEvaluation, lower::pft::Evaluation &targetEvaluation) { sourceEvaluation.isUnstructured = true; - if (!sourceEvaluation.controlSuccessor) { + if (!sourceEvaluation.controlSuccessor) sourceEvaluation.controlSuccessor = &targetEvaluation; - } targetEvaluation.isNewBlock = true; // If this is a branch into the body of a construct (usually illegal, // but allowed in some legacy cases), then the targetEvaluation and its @@ -450,9 +450,8 @@ class PFTBuilder { // These statements have several std::optional if constexpr (std::is_same_v || std::is_same_v) { - if (auto name{std::get<0>(stmt.t)}) { + if (auto name{std::get<0>(stmt.t)}) return name->ToString(); - } } return {}; } @@ -463,9 +462,8 @@ class PFTBuilder { void insertConstructName(const A &stmt, lower::pft::Evaluation *parentConstruct) { std::string name{getConstructName(stmt)}; - if (!name.empty()) { + if (!name.empty()) constructNameMap[name] = parentConstruct; - } } /// Insert branch links for a list of Evaluations. @@ -518,9 +516,8 @@ class PFTBuilder { markSuccessorAsNewBlock(eval); }, [&](const parser::ComputedGotoStmt &s) { - for (auto &label : std::get>(s.t)) { + for (auto &label : std::get>(s.t)) markBranchTarget(eval, label); - } }, [&](const parser::ArithmeticIfStmt &s) { markBranchTarget(eval, std::get<1>(s.t)); @@ -600,9 +597,8 @@ class PFTBuilder { } eval.nonNopSuccessor().isNewBlock = true; eval.controlSuccessor = &evaluationList.back(); - if (std::holds_alternative(control->u)) { + if (std::holds_alternative(control->u)) eval.isUnstructured = true; // while loop - } // Defer additional processing for an unstructured concurrent loop // to the EndDoStmt, when the loop is known to be unstructured. }, @@ -610,40 +606,39 @@ class PFTBuilder { lower::pft::Evaluation &doEval{evaluationList.front()}; eval.controlSuccessor = &doEval; doConstructStack.pop_back(); - if (parentConstruct->lowerAsStructured()) { + if (parentConstruct->lowerAsStructured()) return; - } + // Now that the loop is known to be unstructured, finish concurrent // loop processing, using NonLabelDoStmt information. parentConstruct->constructExit->isNewBlock = true; - const auto &doStmt{doEval.getIf()}; + const auto &doStmt = doEval.getIf(); assert(doStmt && "missing NonLabelDoStmt"); - auto &control{ - std::get>(doStmt->t)}; - if (!control.has_value()) { + auto &control = + std::get>(doStmt->t); + if (!control.has_value()) return; // infinite loop - } - const auto *concurrent{ - std::get_if(&control->u)}; - if (!concurrent) { + + const auto *concurrent = + std::get_if(&control->u); + if (!concurrent) return; - } + // Unstructured concurrent loop. NonLabelDoStmt code accounts // for one concurrent loop dimension. Reserve preheader, // header, and latch blocks for the remaining dimensions, and // one block for a mask expression. - const auto &header{ - std::get(concurrent->t)}; - auto dims{std::get>(header.t) - .size()}; + const auto &header = + std::get(concurrent->t); + auto dims = + std::get>(header.t).size(); for (; dims > 1; --dims) { doEval.localBlocks.emplace_back(nullptr); // preheader doEval.localBlocks.emplace_back(nullptr); // header eval.localBlocks.emplace_back(nullptr); // latch } - if (std::get>(header.t)) { + if (std::get>(header.t)) doEval.localBlocks.emplace_back(nullptr); // mask - } }, [&](const parser::IfThenStmt &s) { insertConstructName(s, parentConstruct); @@ -662,9 +657,8 @@ class PFTBuilder { lastConstructStmtEvaluation = nullptr; }, [&](const parser::EndIfStmt &) { - if (parentConstruct->lowerAsUnstructured()) { + if (parentConstruct->lowerAsUnstructured()) parentConstruct->constructExit->isNewBlock = true; - } if (lastConstructStmtEvaluation) { lastConstructStmtEvaluation->controlSuccessor = parentConstruct->constructExit; @@ -725,9 +719,8 @@ class PFTBuilder { }); // Analyze construct evaluations. - if (eval.evaluationList) { + if (eval.evaluationList) analyzeBranches(&eval, *eval.evaluationList); - } // Insert branch links for an unstructured IF statement. if (lastIfStmtEvaluation && lastIfStmtEvaluation != &eval) { @@ -812,8 +805,7 @@ class PFTBuilder { std::vector doConstructStack{}; /// evaluationListStack is the current nested construct evaluationList state. std::vector evaluationListStack{}; - llvm::DenseMap *labelEvaluationMap{ - nullptr}; + llvm::DenseMap *labelEvaluationMap{}; lower::pft::SymbolLabelMap *assignSymbolLabelMap{nullptr}; std::map constructNameMap{}; lower::pft::Evaluation *lastLexicalEvaluation{nullptr}; @@ -821,18 +813,19 @@ class PFTBuilder { class PFTDumper { public: - void dumpPFT(llvm::raw_ostream &outputStream, lower::pft::Program &pft) { + void dumpPFT(llvm::raw_ostream &outputStream, + const lower::pft::Program &pft) { for (auto &unit : pft.getUnits()) { std::visit(common::visitors{ - [&](lower::pft::BlockDataUnit &unit) { + [&](const lower::pft::BlockDataUnit &unit) { outputStream << getNodeIndex(unit) << " "; outputStream << "BlockData: "; outputStream << "\nEndBlockData\n\n"; }, - [&](lower::pft::FunctionLikeUnit &func) { + [&](const lower::pft::FunctionLikeUnit &func) { dumpFunctionLikeUnit(outputStream, func); }, - [&](lower::pft::ModuleLikeUnit &unit) { + [&](const lower::pft::ModuleLikeUnit &unit) { dumpModuleLikeUnit(outputStream, unit); }, }, @@ -840,85 +833,88 @@ class PFTDumper { } } - llvm::StringRef evaluationName(lower::pft::Evaluation &eval) { - return eval.visit(common::visitors{ - [](const auto &parseTreeNode) { - return parser::ParseTreeDumper::GetNodeName(parseTreeNode); - }, + llvm::StringRef evaluationName(const lower::pft::Evaluation &eval) { + return eval.visit([](const auto &parseTreeNode) { + return parser::ParseTreeDumper::GetNodeName(parseTreeNode); }); } - void dumpEvaluationList(llvm::raw_ostream &outputStream, - lower::pft::EvaluationList &evaluationList, - int indent = 1) { - static const std::string white{" ++"}; - std::string indentString{white.substr(0, indent * 2)}; - for (lower::pft::Evaluation &eval : evaluationList) { - llvm::StringRef name{evaluationName(eval)}; - std::string bang{eval.isUnstructured ? "!" : ""}; - if (eval.isConstruct() || eval.isDirective()) { - outputStream << indentString << "<<" << name << bang << ">>"; - if (eval.constructExit) { - outputStream << " -> " << eval.constructExit->printIndex; - } - outputStream << '\n'; - dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1); - outputStream << indentString << "<>\n"; - continue; - } - outputStream << indentString; - if (eval.printIndex) { - outputStream << eval.printIndex << ' '; - } - if (eval.isNewBlock) { - outputStream << '^'; - } - if (!eval.localBlocks.empty()) { - outputStream << '*'; - } - outputStream << name << bang; - if (eval.isActionStmt() || eval.isConstructStmt()) { - if (eval.controlSuccessor) { - outputStream << " -> " << eval.controlSuccessor->printIndex; - } - } else if (eval.isA() && eval.lexicalSuccessor) { - outputStream << " -> " << eval.lexicalSuccessor->printIndex; - } - if (!eval.position.empty()) { - outputStream << ": " << eval.position.ToString(); - } + void dumpEvaluation(llvm::raw_ostream &outputStream, + const lower::pft::Evaluation &eval, + const std::string &indentString, int indent = 1) { + llvm::StringRef name = evaluationName(eval); + std::string bang = eval.isUnstructured ? "!" : ""; + if (eval.isConstruct() || eval.isDirective()) { + outputStream << indentString << "<<" << name << bang << ">>"; + if (eval.constructExit) + outputStream << " -> " << eval.constructExit->printIndex; outputStream << '\n'; + dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1); + outputStream << indentString << "<>\n"; + return; } + outputStream << indentString; + if (eval.printIndex) + outputStream << eval.printIndex << ' '; + if (eval.isNewBlock) + outputStream << '^'; + if (eval.localBlocks.size()) + outputStream << '*'; + outputStream << name << bang; + if (eval.isActionStmt() || eval.isConstructStmt()) { + if (eval.controlSuccessor) + outputStream << " -> " << eval.controlSuccessor->printIndex; + } else if (eval.isA() && eval.lexicalSuccessor) { + outputStream << " -> " << eval.lexicalSuccessor->printIndex; + } + if (!eval.position.empty()) + outputStream << ": " << eval.position.ToString(); + outputStream << '\n'; + } + + void dumpEvaluation(llvm::raw_ostream &ostream, + const lower::pft::Evaluation &eval) { + dumpEvaluation(ostream, eval, ""); + } + + void dumpEvaluationList(llvm::raw_ostream &outputStream, + const lower::pft::EvaluationList &evaluationList, + int indent = 1) { + static const auto white = " ++"s; + auto indentString = white.substr(0, indent * 2); + for (const auto &eval : evaluationList) + dumpEvaluation(outputStream, eval, indentString, indent); } - void dumpFunctionLikeUnit(llvm::raw_ostream &outputStream, - lower::pft::FunctionLikeUnit &functionLikeUnit) { + void + dumpFunctionLikeUnit(llvm::raw_ostream &outputStream, + const lower::pft::FunctionLikeUnit &functionLikeUnit) { outputStream << getNodeIndex(functionLikeUnit) << " "; - llvm::StringRef unitKind{}; - std::string name{}; - std::string header{}; + llvm::StringRef unitKind; + llvm::StringRef name; + llvm::StringRef header; if (functionLikeUnit.beginStmt) { functionLikeUnit.beginStmt->visit(common::visitors{ - [&](const parser::Statement &statement) { + [&](const parser::Statement &stmt) { unitKind = "Program"; - name = statement.statement.v.ToString(); + name = toStringRef(stmt.statement.v.source); }, - [&](const parser::Statement &statement) { + [&](const parser::Statement &stmt) { unitKind = "Function"; - name = std::get(statement.statement.t).ToString(); - header = statement.source.ToString(); + name = toStringRef(std::get(stmt.statement.t).source); + header = toStringRef(stmt.source); }, - [&](const parser::Statement &statement) { + [&](const parser::Statement &stmt) { unitKind = "Subroutine"; - name = std::get(statement.statement.t).ToString(); - header = statement.source.ToString(); + name = toStringRef(std::get(stmt.statement.t).source); + header = toStringRef(stmt.source); }, - [&](const parser::Statement &statement) { + [&](const parser::Statement &stmt) { unitKind = "MpSubprogram"; - name = statement.statement.v.ToString(); - header = statement.source.ToString(); + name = toStringRef(stmt.statement.v.source); + header = toStringRef(stmt.source); }, - [&](const auto &) {}, + [&](const auto &) { llvm_unreachable("not a valid begin stmt"); }, }); } else { unitKind = "Program"; @@ -939,7 +935,7 @@ class PFTDumper { } void dumpModuleLikeUnit(llvm::raw_ostream &outputStream, - lower::pft::ModuleLikeUnit &moduleLikeUnit) { + const lower::pft::ModuleLikeUnit &moduleLikeUnit) { outputStream << getNodeIndex(moduleLikeUnit) << " "; outputStream << "ModuleLike: "; outputStream << "\nContains\n"; @@ -950,11 +946,10 @@ class PFTDumper { template std::size_t getNodeIndex(const T &node) { - auto addr{static_cast(&node)}; - auto it{nodeIndexes.find(addr)}; - if (it != nodeIndexes.end()) { + auto addr = static_cast(&node); + auto it = nodeIndexes.find(addr); + if (it != nodeIndexes.end()) return it->second; - } nodeIndexes.try_emplace(addr, nextIndex); return nextIndex++; } @@ -1024,6 +1019,29 @@ Fortran::lower::pft::Evaluation::getOwningProcedure() const { }); } +namespace { +struct IntervalSet : public llvm::IntervalMap { + using IntervalMap::IntervalMap; + using Allocator = IntervalMap::Allocator; + + // Handles the merging of overlapping intervals correctly, efficiently. + bool merge(std::size_t lo, std::size_t up) { + assert(lo < up); + auto first = lookup(lo); + auto last = lookup(up); + if (!first && !last) + insert(lo, up, 1); + else if (!first) + find(up).setStart(lo); + else if (!last) + find(lo).setStop(up); + else + return false; + return true; + } +}; +} // namespace + namespace { /// This helper class is for sorting the symbols in the symbol table. We want /// the symbols in an order such that a symbol will be visited after those it @@ -1034,6 +1052,31 @@ struct SymbolDependenceDepth { std::vector> &vars) : vars{vars} {} + // Analyze the equivalence sets. This analysis need not be performed when the + // scope has no equivalence sets. + void analyzeAliases(const semantics::Scope &scope) { + IntervalSet::Allocator allocator; + IntervalSet intervals(allocator); + + // Collect the offset ranges which have aliasing. + for (const auto &set : scope.equivalenceSets()) + for (const auto &eqv : set) { + const auto &sym = eqv.symbol; + aliasSyms.insert(&sym); + intervals.merge(sym.offset(), sym.offset() + sym.size() - 1); + } + + // Create a primary store for each aliased interval. + adjustSize(1); + for (auto i = intervals.begin(), end = intervals.end(); i != end; ++i) { + vars[0].emplace_back( + lower::pft::Variable::StoreInterval{i.start(), + i.stop() - i.start() + 1}, + /*isGlobal=*/false); + stores.emplace_back(i.start(), i.stop() + 1); + } + } + // Recursively visit each symbol to determine the height of its dependence on // other symbols. int analyze(const semantics::Symbol &sym) { @@ -1058,6 +1101,11 @@ struct SymbolDependenceDepth { const auto *symTy = sym.GetType(); assert(symTy && "symbol must have a type"); + // Make sure an aliasing variable appears after its primary storage. + if (!aliasSyms.empty()) + if (aliasSyms.find(&sym) != aliasSyms.end()) + depth = std::max(1, depth); + // check CHARACTER's length if (symTy->category() == semantics::DeclTypeSpec::Character) if (auto e = symTy->characterTypeSpec().length().GetExplicit()) @@ -1092,12 +1140,31 @@ struct SymbolDependenceDepth { } adjustSize(depth + 1); vars[depth].emplace_back(sym, global, depth); - if (Fortran::semantics::IsAllocatable(sym)) + if (semantics::IsAllocatable(sym)) vars[depth].back().setHeapAlloc(); - if (Fortran::semantics::IsPointer(sym)) + if (semantics::IsPointer(sym)) vars[depth].back().setPointer(); - if (sym.attrs().test(Fortran::semantics::Attr::TARGET)) + if (sym.attrs().test(semantics::Attr::TARGET)) vars[depth].back().setTarget(); + + // If there are alias sets, then link the participating variables to their + // primary stores when constructing the new variable on the list. + if (!aliasSyms.empty()) + if (aliasSyms.find(&sym) != aliasSyms.end()) { + if (global) + llvm::report_fatal_error("TODO: EQUIVALENCE on global"); + // Expect the total number of EQUIVALENCE sets to be small for a typical + // Fortran program. + auto findStore = [&](std::size_t off) -> std::size_t { + for (auto v : stores) { + auto bot = std::get<0>(v); + if (off >= bot && off < std::get<1>(v)) + return bot; + } + llvm_unreachable("the store must be present"); + }; + vars[depth].back().setAlias(findStore(sym.offset())); + } return depth; } @@ -1117,22 +1184,16 @@ struct SymbolDependenceDepth { llvm::SmallSet seen; std::vector> &vars; + llvm::SmallSet aliasSyms; + std::vector> stores; }; } // namespace void Fortran::lower::pft::FunctionLikeUnit::processSymbolTable( const semantics::Scope &scope) { - // TODO: handle equivalence and common blocks - if (!scope.equivalenceSets().empty()) { - llvm::errs() << "TODO: equivalence not yet handled in lowering.\n" - << "note: equivalence used in " - << (scope.GetName() && !scope.GetName()->empty() - ? scope.GetName()->ToString() - : "unnamed program"s) - << "\n"; - exit(1); - } SymbolDependenceDepth sdd{varList}; + if (!scope.equivalenceSets().empty()) + sdd.analyzeAliases(scope); for (const auto &iter : scope) sdd.analyze(iter.second.get()); sdd.finalize(); @@ -1217,8 +1278,44 @@ Fortran::lower::createPFT(const parser::Program &root, } void Fortran::lower::dumpPFT(llvm::raw_ostream &outputStream, - lower::pft::Program &pft) { + const lower::pft::Program &pft) { PFTDumper{}.dumpPFT(outputStream, pft); } -void Fortran::lower::pft::Program::dump() { dumpPFT(llvm::errs(), *this); } +void Fortran::lower::pft::Program::dump() const { + dumpPFT(llvm::errs(), *this); +} + +void Fortran::lower::pft::Evaluation::dump() const { + PFTDumper{}.dumpEvaluation(llvm::errs(), *this); +} + +void Fortran::lower::pft::Variable::dump() const { + if (auto *sym = std::get_if(&u)) + llvm::errs() << "symbol: " << (*sym)->name(); + else if (auto *store = std::get_if(&u)) + llvm::errs() << "interval[" << std::get<0>(*store) << ", " + << std::get<1>(*store) << "]:"; + else + llvm_unreachable("not a Variable"); + llvm::errs() << " depth: " << depth; + if (global) + llvm::errs() << ", global"; + if (heapAlloc) + llvm::errs() << ", allocatable"; + if (pointer) + llvm::errs() << ", pointer"; + if (target) + llvm::errs() << ", target"; + if (aliasee) + llvm::errs() << ", equivalence(" << aliasOffset << ")"; + llvm::errs() << '\n'; +} + +void Fortran::lower::pft::FunctionLikeUnit::dump() const { + PFTDumper{}.dumpFunctionLikeUnit(llvm::errs(), *this); +} + +void Fortran::lower::pft::ModuleLikeUnit::dump() const { + PFTDumper{}.dumpModuleLikeUnit(llvm::errs(), *this); +} diff --git a/flang/test/Lower/equivalence.f90 b/flang/test/Lower/equivalence.f90 new file mode 100644 index 0000000000000..ccfe0bc2319a7 --- /dev/null +++ b/flang/test/Lower/equivalence.f90 @@ -0,0 +1,33 @@ +! RUN: bbc -o - %s | FileCheck %s + +! CHECK-LABEL: func @_QPs1 +SUBROUTINE s1 + INTEGER i + REAL r + ! CHECK: = fir.alloca i8, % + EQUIVALENCE (r,i) + ! CHECK: %[[coor:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[iloc:.*]] = fir.convert %[[coor]] : (!fir.ref) -> !fir.ref + ! CHECK-DAG: fir.store %{{.*}} to %[[iloc]] : !fir.ref + i = 4 + ! CHECK-DAG: %[[floc:.*]] = fir.convert %[[coor]] : (!fir.ref) -> !fir.ref + ! CHECK: %[[ld:.*]] = fir.load %[[floc]] : !fir.ref + PRINT *, r +END SUBROUTINE s1 + +! CHECK-LABEL: func @_QPs2 +SUBROUTINE s2 + INTEGER i(10) + REAL r(10) + ! CHECK: = fir.alloca i8, % + EQUIVALENCE (r(3),i(5)) + ! CHECK: %[[iarr:.*]] = fir.convert %{{.*}} : (!fir.ref) -> !fir.ref> + ! CHECK: %[[ioff:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[farr:.*]] = fir.convert %[[ioff]] : (!fir.ref) -> !fir.ref> + ! CHECK: %[[ia:.*]] = fir.coordinate_of %[[iarr]], %{{.*}} : (!fir.ref>, i64) -> !fir.ref + ! CHECK: fir.store %{{.*}} to %[[ia]] : !fir.ref + i(5) = 18 + ! CHECK: %[[fld:.*]] = fir.coordinate_of %[[farr]], %{{.*}} : (!fir.ref>, i64) -> !fir.ref + ! CHECK: = fir.load %[[fld]] : !fir.ref + PRINT *, r(3) +END SUBROUTINE s2 From fd08458b04f9a38827cdaada81aaec1059e9721b Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 21 Jul 2020 16:00:47 -0700 Subject: [PATCH 0179/1017] Fix for #288 - character literals have wrong linkage. --- flang/include/flang/Lower/FIRBuilder.h | 20 ++++++++++++++++++++ flang/lib/Lower/Bridge.cpp | 6 +++--- flang/lib/Lower/ConvertExpr.cpp | 2 +- flang/test/Lower/character-assignment.f90 | 2 +- flang/test/Lower/global-format-strings.f90 | 2 +- flang/test/Lower/read-write-buffer.f90 | 4 ++-- 6 files changed, 28 insertions(+), 8 deletions(-) diff --git a/flang/include/flang/Lower/FIRBuilder.h b/flang/include/flang/Lower/FIRBuilder.h index ecfa88a5ea06a..0bf54c9e15638 100644 --- a/flang/include/flang/Lower/FIRBuilder.h +++ b/flang/include/flang/Lower/FIRBuilder.h @@ -137,6 +137,26 @@ class FirOpBuilder : public mlir::OpBuilder { fir::StringLitOp createStringLit(mlir::Location loc, mlir::Type eleTy, llvm::StringRef string); + //===--------------------------------------------------------------------===// + // Linkage helpers (inline). The default linkage is external. + //===--------------------------------------------------------------------===// + + mlir::StringAttr createCommonLinkage() { + return getStringAttr("common"); + } + + mlir::StringAttr createInternalLinkage() { + return getStringAttr("internal"); + } + + mlir::StringAttr createLinkOnceLinkage() { + return getStringAttr("linkonce"); + } + + mlir::StringAttr createWeakLinkage() { + return getStringAttr("weak"); + } + /// Get a function by name. If the function exists in the current module, it /// is returned. Otherwise, a null FuncOp is returned. mlir::FuncOp getNamedFunction(llvm::StringRef name) { diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 8283e5ef25056..428aa617aa9ce 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1631,7 +1631,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { len.push_back(std::get(*chLit)); symTy = fir::SequenceType::get(len, symTy); auto init = builder->getStringAttr(std::get(*chLit)); - auto linkage = builder->getStringAttr("internal"); + auto linkage = builder->createInternalLinkage(); global = builder->createGlobal(loc, symTy, globalName, linkage, init, isConst); } else { @@ -1698,7 +1698,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (!sym.name().size() || !hasInit) { // anonymous COMMON must always be initialized to zero // a named COMMON sans initializers is also initialized to zero - auto linkage = builder->getStringAttr("common"); + auto linkage = builder->createCommonLinkage(); fir::SequenceType::Shape shape = {sz}; auto i8Ty = builder->getIntegerType(8); auto commonTy = fir::SequenceType::get(shape, i8Ty); @@ -1721,7 +1721,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { members.push_back(genType(*obj)); return mlir::TupleType::get(members, builder->getContext()); }(); - auto linkage = builder->getStringAttr("linkonce"); + auto linkage = builder->createLinkOnceLinkage(); auto initFunc = [&](Fortran::lower::FirOpBuilder &builder) { mlir::Value cb = builder.create(loc, commonTy); unsigned offset = 0; diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 9ff7d8154a697..809916c90ef06 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -731,7 +731,7 @@ class ExprLowering { [&](Fortran::lower::FirOpBuilder &builder) { auto str = consLit(); builder.create(getLoc(), str); - }); + }, builder.createLinkOnceLinkage()); auto addr = builder.create(getLoc(), global.resultType(), global.getSymbol()); auto lenp = builder.createIntegerConstant( diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index 2d0ba2720a2fd..494e16a853f6a 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -117,7 +117,7 @@ subroutine assign_constant(lhs) ! CHECK: } end subroutine -! CHECK-LABEL: fir.global @_QQcl.48656C6C6F20576F726C64 +! CHECK-LABEL: fir.global linkonce @_QQcl.48656C6C6F20576F726C64 ! CHECK: %[[lit:.*]] = fir.string_lit "Hello World"(11) : !fir.char<1> ! CHECK: fir.has_value %[[lit]] : !fir.array<11x!fir.char<1>> ! CHECK: } diff --git a/flang/test/Lower/global-format-strings.f90 b/flang/test/Lower/global-format-strings.f90 index 4eff504231a9b..95ad618b9b6f2 100644 --- a/flang/test/Lower/global-format-strings.f90 +++ b/flang/test/Lower/global-format-strings.f90 @@ -8,7 +8,7 @@ program other ! CHECK: fir.address_of(@{{.*}}) : 1008 format('ok') end -! CHECK-LABEL: fir.global @_QQcl.28276F6B2729 constant +! CHECK-LABEL: fir.global linkonce @_QQcl.28276F6B2729 constant ! CHECK: %[[lit:.*]] = fir.string_lit "('ok')"(6) : !fir.char<1> ! CHECK: fir.has_value %[[lit]] : !fir.array<6x!fir.char<1>> ! CHECK: } diff --git a/flang/test/Lower/read-write-buffer.f90 b/flang/test/Lower/read-write-buffer.f90 index 296c2158909d1..ca28282dafe29 100644 --- a/flang/test/Lower/read-write-buffer.f90 +++ b/flang/test/Lower/read-write-buffer.f90 @@ -6,11 +6,11 @@ subroutine some() character(LEN=255):: buffer character(LEN=255):: greeting 10 format (A255) - ! CHECK: fir.address_of(@{{.*}}) : + ! CHECK: fir.address_of(@_QQcl.636F6D70696C6572) : write (buffer, 10) "compiler" read (buffer, 10) greeting end -! CHECK-LABEL: fir.global @_QQcl.636F6D70696C6572 +! CHECK-LABEL: fir.global linkonce @_QQcl.636F6D70696C6572 ! CHECK: %[[lit:.*]] = fir.string_lit "compiler"(8) : !fir.char<1> ! CHECK: fir.has_value %[[lit]] : !fir.array<8x!fir.char<1>> ! CHECK: } From ce23d050ccae931b14f034f25e5991bed123b0f9 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 21 Jul 2020 18:06:56 -0700 Subject: [PATCH 0180/1017] Fix for #272 - globals have external linkage when they should not --- flang/lib/Lower/Bridge.cpp | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 428aa617aa9ce..a6b51663717cc 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1620,6 +1620,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } if (const auto *details = sym.detailsIf()) { + // FIXME: an exported module variable will have external linkage. + auto linkage = builder->createInternalLinkage(); if (details->init()) { if (!sym.GetType()->AsIntrinsic()) { TODO(); // Derived type / polymorphic @@ -1631,7 +1633,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { len.push_back(std::get(*chLit)); symTy = fir::SequenceType::get(len, symTy); auto init = builder->getStringAttr(std::get(*chLit)); - auto linkage = builder->createInternalLinkage(); global = builder->createGlobal(loc, symTy, globalName, linkage, init, isConst); } else { @@ -1646,10 +1647,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto castTo = builder.createConvert(loc, symTy, fir::getBase(initVal)); builder.create(loc, castTo); - }); + }, linkage); } } else { - global = builder->createGlobal(loc, genType(var), globalName); + global = builder->createGlobal(loc, genType(var), globalName, linkage); } auto addrOf = builder->create(loc, global.resultType(), global.getSymbol()); From 2829271430f910996688e8121dadc029ead26eb6 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 21 Jul 2020 07:01:42 -0700 Subject: [PATCH 0181/1017] Fix unrestricted specific intrinsic dummy with name different from generic Use the specific to generic intrinsic name mapping before generating the unrestricted intrinsic. Also workaround mlir lack of internal linkage: do not outline intrinsics (temporary) --- flang/lib/Lower/ConvertExpr.cpp | 8 +++++++- flang/lib/Lower/IntrinsicCall.cpp | 4 +++- flang/test/Lower/dummy-procedure.f90 | 10 ++++++++++ flang/test/Lower/intrinsics.f90 | 22 ++++++++++++++++++++++ 4 files changed, 42 insertions(+), 2 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 809916c90ef06..95771c2abffe7 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -343,9 +343,15 @@ class ExprLowering { genval(const Fortran::evaluate::ProcedureDesignator &proc) { if (const auto *intrinsic = proc.GetSpecificIntrinsic()) { auto signature = Fortran::lower::translateSignature(proc, converter); + // Intrinsic lowering is based on the generic name, so retrieve it here in + // case it is different from the specific name. The type of the specific + // intrinsic is retained in the signature. + auto genericName = + converter.getFoldingContext().intrinsics().GetGenericIntrinsicName( + intrinsic->name); auto symbolRefAttr = Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr( - builder, getLoc(), intrinsic->name, signature); + builder, getLoc(), genericName, signature); mlir::Value funcPtr = builder.create(getLoc(), signature, symbolRefAttr); return funcPtr; diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp index b9c2bba03631c..5758a143c3c1d 100644 --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -727,8 +727,10 @@ IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, mlir::Type resultType, getFunctionType(resultType, mlirArgs, builder); auto runtimeCallGenerator = getRuntimeCallGenerator(name, soughtFuncType); + // FIXME: set outline back to true and use linkOnce for the wrapper + // instead. return genElementalCall(runtimeCallGenerator, name, resultType, args, - /* outline */ true); + /* outline */ false); } mlir::Value diff --git a/flang/test/Lower/dummy-procedure.f90 b/flang/test/Lower/dummy-procedure.f90 index c4b1f6ee52cff..4af0a743d6f84 100644 --- a/flang/test/Lower/dummy-procedure.f90 +++ b/flang/test/Lower/dummy-procedure.f90 @@ -124,6 +124,16 @@ subroutine test_len() !CHECK: %[[len:.*]] = fir.convert %[[unboxed]]#1 : (index) -> i32 !CHECK: return %[[len]] : i32 +! Intrinsic implemented inlined with specific name different from generic +! CHECK-LABEL: func @_QPtest_iabs +subroutine test_iabs() + intrinsic :: iabs + ! CHECK: %[[f:.*]] = constant @fir.abs.i32.ref_i32 : (!fir.ref) -> i32 + ! CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> i32) -> (() -> ()) + ! CHECK: fir.call @_QPfoo_iabs(%[[fcast]]) : (() -> ()) -> () + call foo_iabs(iabs) +end subroutine + ! TODO: exhaustive test of unrestricted intrinsic table 16.2 diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index 5141954051676..a6dd4062192f7 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -147,6 +147,28 @@ subroutine floor_test2(i, a) ! CHECK: fir.convert %[[f]] : (f32) -> i64 end subroutine +! IABS +! CHECK-LABEL: iabs_test +subroutine iabs_test(a, b) + integer :: a, b + ! CHECK: shift_right_signed + ! CHECK: xor + ! CHECK: subi + b = iabs(a) +end subroutine + +! IABS - Check if the return type (RT) has default kind. +! CHECK-LABEL: iabs_test +subroutine iabs_testRT(a, b) + integer(KIND=4) :: a + integer(KIND=16) :: b + ! CHECK: shift_right_signed + ! CHECK: xor + ! CHECK: %[[RT:.*]] = subi + ! CHECK: fir.convert %[[RT]] : (i32) + b = iabs(a) +end subroutine + ! IAND ! CHECK-LABEL: iand_test subroutine iand_test(a, b) From 7f9f74db9e625c3f68d0073805fb2942c562a32e Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Wed, 22 Jul 2020 05:03:27 -0700 Subject: [PATCH 0182/1017] Fix visibility of globals in regression tests after changes in PR 294 --- flang/test/Lower/global-init.f90 | 12 ++++++------ flang/test/Lower/pointer.f90 | 10 +++++----- flang/test/Lower/program-units-fir-mangling.f90 | 4 ++-- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/flang/test/Lower/global-init.f90 b/flang/test/Lower/global-init.f90 index ec92e1b2fe949..f764a025bfab7 100644 --- a/flang/test/Lower/global-init.f90 +++ b/flang/test/Lower/global-init.f90 @@ -2,7 +2,7 @@ program bar ! CHECK: fir.address_of(@[[name1:.*]]my_data) -! CHECK: fir.global @[[name1]] +! CHECK: fir.global internal @[[name1]] integer, save :: my_data = 1 print *, my_data contains @@ -10,7 +10,7 @@ program bar ! CHECK-LABEL: func @_QPfoo subroutine foo() ! CHECK: fir.address_of(@[[name2:.*foo.*my_data]]) -! CHECK: fir.global @[[name2]] +! CHECK: fir.global internal @[[name2]] integer, save :: my_data = 2 print *, my_data + 1 end subroutine @@ -18,7 +18,7 @@ subroutine foo() ! CHECK-LABEL: func @_QPfoo2 subroutine foo2() ! CHECK: fir.address_of(@[[name3:.*foo2.*my_data]]) -! CHECK: fir.global @[[name3]] +! CHECK: fir.global internal @[[name3]] integer, save :: my_data my_data = 4 print *, my_data @@ -27,11 +27,11 @@ subroutine foo2() ! CHECK-LABEL: func @_QPfoo3 subroutine foo3() ! CHECK-DAG: fir.address_of(@[[name4:.*foo3.*idata]]){{.*}}fir.array<5xi32> -! CHECK-DAG: fir.global @[[name4]]{{.*}}fir.array<5xi32> +! CHECK-DAG: fir.global internal @[[name4]]{{.*}}fir.array<5xi32> ! CHECK-DAG: fir.address_of(@[[name5:.*foo3.*rdata]]){{.*}}fir.array<3xf16> -! CHECK-DAG: fir.global @[[name5]]{{.*}}fir.array<3xf16> +! CHECK-DAG: fir.global internal @[[name5]]{{.*}}fir.array<3xf16> ! CHECK-DAG: fir.address_of(@[[name6:.*foo3.*my_data]]){{.*}}fir.array<2x4xi64> -! CHECK-DAG: fir.global @[[name6]]{{.*}}fir.array<2x4xi64> +! CHECK-DAG: fir.global internal @[[name6]]{{.*}}fir.array<2x4xi64> integer*4, dimension(5), save :: idata = (/ (i*i, i=1,5) /) integer*8, dimension(2, 10:13), save :: my_data = reshape((/1,2,3,4,5,6,7,8/), shape(my_data)) real*2, dimension(7:9), save :: rdata = (/100., 99., 98./) diff --git a/flang/test/Lower/pointer.f90 b/flang/test/Lower/pointer.f90 index 2526ea36f0129..fb9a20fb484d5 100644 --- a/flang/test/Lower/pointer.f90 +++ b/flang/test/Lower/pointer.f90 @@ -2,35 +2,35 @@ ! CHECK-LABEL: func @_QPpointertests subroutine pointerTests - ! CHECK: fir.global @_QFpointertestsEptr1 : !fir.ptr + ! CHECK: fir.global internal @_QFpointertestsEptr1 : !fir.ptr integer, pointer :: ptr1 => NULL() ! CHECK: %[[c0:.*]] = constant 0 : index ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr ! CHECK: fir.has_value [[reg2]] : !fir.ptr - ! CHECK: fir.global @_QFpointertestsEptr2 : !fir.ptr + ! CHECK: fir.global internal @_QFpointertestsEptr2 : !fir.ptr real, pointer :: ptr2 => NULL() ! CHECK: %[[c0:.*]] = constant 0 : index ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr ! CHECK: fir.has_value [[reg2]] : !fir.ptr - ! CHECK: fir.global @_QFpointertestsEptr3 : !fir.ptr> + ! CHECK: fir.global internal @_QFpointertestsEptr3 : !fir.ptr> complex, pointer :: ptr3 => NULL() ! CHECK: %[[c0:.*]] = constant 0 : index ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> ! CHECK: fir.has_value [[reg2]] : !fir.ptr> - ! CHECK: fir.global @_QFpointertestsEptr4 : !fir.ptr> + ! CHECK: fir.global internal @_QFpointertestsEptr4 : !fir.ptr> character, pointer :: ptr4 => NULL() ! CHECK: %[[c0:.*]] = constant 0 : index ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> ! CHECK: fir.has_value [[reg2]] : !fir.ptr> - ! CHECK: fir.global @_QFpointertestsEptr5 : !fir.ptr> + ! CHECK: fir.global internal @_QFpointertestsEptr5 : !fir.ptr> logical, pointer :: ptr5 => NULL() ! CHECK: %[[c0:.*]] = constant 0 : index ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref diff --git a/flang/test/Lower/program-units-fir-mangling.f90 b/flang/test/Lower/program-units-fir-mangling.f90 index 5eab37e8f7586..6d7c08e52e44a 100644 --- a/flang/test/Lower/program-units-fir-mangling.f90 +++ b/flang/test/Lower/program-units-fir-mangling.f90 @@ -17,7 +17,7 @@ function foo() ! CHECK: } end function -! CHECK-LABEL: fir.global @_QFfooEpi : f32 { +! CHECK-LABEL: fir.global internal @_QFfooEpi : f32 { ! CHECK-LABEL: func @_QPfunctn() -> f32 { function functn @@ -25,7 +25,7 @@ function functn ! CHECK: } end function -! CHECK-LABEL: fir.global @_QFfunctnECpi constant : f32 { +! CHECK-LABEL: fir.global internal @_QFfunctnECpi constant : f32 { module testMod contains From 2ebe4a2c318a859fc6c5c734263a3675727195e3 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Wed, 22 Jul 2020 21:23:18 +0530 Subject: [PATCH 0183/1017] Relpace `LoopOp` Op with `DoLoopOp` Op in FIR Dialect --- flang/documentation/BurnsideToFIR.md | 10 +- .../flang/Optimizer/Transforms/Passes.td | 98 ++++++++++++++++--- flang/lib/Lower/Bridge.cpp | 16 +-- .../Optimizer/Transforms/AffinePromotion.cpp | 37 +++---- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 15 +-- 5 files changed, 124 insertions(+), 52 deletions(-) diff --git a/flang/documentation/BurnsideToFIR.md b/flang/documentation/BurnsideToFIR.md index de4d1ff44dd9b..425887909ed18 100644 --- a/flang/documentation/BurnsideToFIR.md +++ b/flang/documentation/BurnsideToFIR.md @@ -428,7 +428,7 @@ Fortran into FIR in a semantics preserving way. // create a temporary to hold E(V) %v = ... : !fir.array<4:i32> %8 = fir.alloca !fir.array<4:f32> : !fir.ref> - fir.loop %i = %c1 to %c4 unordered { + fir.doloop %i = %c1 to %c4 unordered { %9 = fir.extract_value %v, %i : (!fir.array<4:i32>, index) -> i32 %10 = fir.extract_value %e, %9 : (!fir.array, i32) -> f32 %11 = fir.coordinate_of %8, %i : (!fir.ref>, index) -> !fir.ref @@ -615,7 +615,7 @@ One must also specify to LLVM that these operations will not be reassociated. ```mlir %arr = ... : !fir.array %threshold = ... : !fir.array - fir.loop %i = %c1 to %size { + fir.doloop %i = %c1 to %size { %arr_i = fir.extract_value %arr, %i : ... -> !T %threshold_i = fir.extract_value %threshold, %i : ... -> !T %1 = cmp "lt" %arr_i, %threshold_i : ... -> i1 @@ -639,7 +639,7 @@ One must also specify to LLVM that these operations will not be reassociated. ``` ---- ```mlir - fir.loop %i = %c1 to %c100 unordered { + fir.doloop %i = %c1 to %c100 unordered { %1 = fir.extract_value %b, %i : (!fir.array, index) -> f32 %2 = fir.extract_value %c, %i : (!fir.array, index) -> f32 %3 = divf %1, %2 : f32 @@ -686,8 +686,8 @@ One must also specify to LLVM that these operations will not be reassociated. %1 = fir.gendims %c1, %c1000, %c100 : !fir.dims<1> %2 = fir.gendims %c1, %c10, %c1 : !fir.dims<1> - fir.loop %i = %c1 to %m { - fir.loop %i = %c1 to %n { + fir.doloop %i = %c1 to %m { + fir.doloop %i = %c1 to %n { %13 = fir.coordinate_of %a, %i, %j : !fir.ref> %14 = fir.embox %13, %1 : (!fir.ref>, !fir.dims<1>) -> !fir.box> %15 = fir.coordinate_of %b, %c1, %i, %j : !fir.ref diff --git a/flang/include/flang/Optimizer/Transforms/Passes.td b/flang/include/flang/Optimizer/Transforms/Passes.td index cfa7e34bf8077..8e21fc971ebb3 100644 --- a/flang/include/flang/Optimizer/Transforms/Passes.td +++ b/flang/include/flang/Optimizer/Transforms/Passes.td @@ -11,41 +11,111 @@ // //===----------------------------------------------------------------------===// -#ifndef FLANG_OPTIMIZER_TRANSFORMS_PASSES -#define FLANG_OPTIMIZER_TRANSFORMS_PASSES +#ifndef FORTRAN_OPTIMIZER_TRANSFORMS_FIR_PASSES +#define FORTRAN_OPTIMIZER_TRANSFORMS_FIR_PASSES include "mlir/Pass/PassBase.td" def AffineDialectPromotion : FunctionPass<"promote-to-affine"> { - let summary = "Promotes fir.do_loop and fir.where to affine.for and affine.if where possible"; + let summary = "Promotes `fir.{do_loop,if}` to `affine.{for,if}`."; let description = [{ - TODO + Convert fir operations which satisfy affine constraints to the affine + dialect. + + `fir.do_loop` will be converted to `affine.for` if the loops inside the body + can be converted and the indices for memory loads and stores satisfy + `affine.apply` criteria for symbols and dimensions. + + `fir.if` will be converted to `affine.if` where possible. `affine.if`'s + condition uses an integer set (==, >=) and an analysis is done to determine + the fir condition's parent operations to construct the integer set. + + `fir.load` (`fir.store`) will be converted to `affine.load` (`affine.store`) + where possible. This conversion includes adding a dummy `fir.convert` cast + to adapt values of type `!fir.ref` to `memref`. This is done + because the affine dialect presently only understands the `memref` type. + }]; + let constructor = "::fir::createPromoteToAffinePass()"; +} + +def AffineDialectDemotion : FunctionPass<"demote-affine"> { + let summary = "Converts `affine.{load,store}` back to fir operations"; + let description = [{ + Affine dialect's default lowering for loads and stores is different from + fir as it uses the `memref` type. The `memref` type is not compatible with + the Fortran runtime. Therefore, conversion of memory operations back to + `fir.load` and `fir.store` with `!fir.ref` types is required. + }]; + let constructor = "::fir::createAffineDemotionPass()"; +} + +def FirLoopResultOpt : FunctionPass<"fir-loop-result-opt"> { + let summary = "Optimizes `fir.do_loop` by removing unused final iteration values."; + let description = [{ + TODO - do we need this if we overhaul fir.do_loop a bit? }]; - let constructor = "fir::createPromoteToAffinePass()"; + let constructor = "::fir::createFirLoopResultOptPass()"; +} + +def MemRefDataFlowOpt : FunctionPass<"fir-memref-dataflow-opt"> { + let summary = "Perform store/load forwarding and potentially removing dead stores."; + let description = [{ + This pass performs store to load forwarding to eliminate memory accesses and + potentially the entire allocation if all the accesses are forwarded. + }]; + let constructor = "::fir::createMemDataFlowOptPass()"; } def BasicCSE : FunctionPass<"basic-cse"> { - let summary = "Basic common sub-expression elimination"; + let summary = "Basic common sub-expression elimination."; let description = [{ - TODO + Perform common subexpression elimination on FIR operations. This pass + differs from the MLIR CSE pass in that it is FIR/Fortran semantics aware. }]; - let constructor = "fir::createCSEPass()"; + let constructor = "::fir::createCSEPass()"; } def ControlFlowLowering : FunctionPass<"lower-control-flow"> { - let summary = "Convert affine dialect, fir.select_type to standard dialect"; + let summary = "Convert affine dialect, fir.select_type to standard dialect."; let description = [{ - TODO + This converts the affine dialect back to standard dialect. It also converts + `fir.select_type` to more primitive operations. This pass is required before + code gen to the LLVM IR dialect. + + TODO: Should the affine rewriting by moved to AffineDialectDemotion? }]; - let constructor = "fir::createControlFlowLoweringPass()"; + let constructor = "::fir::createControlFlowLoweringPass()"; } def CFGConversion : FunctionPass<"cfg-conversion"> { let summary = "Convert FIR structured control flow ops to CFG ops."; let description = [{ - TODO + Transform the `fir.do_loop`, `fir.if`, and `fir.iterate_while` ops into + plain old test and branch operations. Removing the high-level control + structures can enable other optimizations. + + This pass is required before code gen to the LLVM IR dialect. + }]; + let constructor = "::fir::createFirToCfgPass()"; +} + +def ArrayValueCopy : FunctionPass<"array-value-copy"> { + let summary = "Convert array value operations to memory operations."; + let description = [{ + Transform the set of array value primitives to a memory-based array + representation. + + The Ops `array_load`, `array_store`, `array_fetch`, and `array_update` are + used to manage abstract aggregate array values. A simple analysis is done + to determine if there are potential dependences between these operations. + If not, these array operations can be lowered to work directly on the memory + representation. If there is a potential conflict, a temporary is created + along with appropriate copy-in/copy-out operations. Here, a more refined + analysis might be deployed, such as using the affine framework. + + This pass is required before code gen to the LLVM IR dialect. }]; - let constructor = "fir::createFirToCfgPass()"; + let constructor = "::fir::createArrayValueCopyPass()"; } -#endif // FLANG_OPTIMIZER_TRANSFORMS_PASSES +#endif // FORTRAN_OPTIMIZER_TRANSFORMS_FIR_PASSES diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index a6b51663717cc..982169ca01cab 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -80,7 +80,7 @@ struct IncrementLoopInfo { mlir::Value stepValue{}; // possible uses in multiple blocks // Data members for structured loops. - fir::LoopOp doLoop{}; + fir::DoLoopOp doLoop{}; mlir::OpBuilder::InsertPoint insertionPoint{}; // Data members for unstructured loops. @@ -813,11 +813,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(loc, *info.loopVariableSym); - // Structured loop - generate fir.loop. + // Structured loop - generate fir.doloop. if (info.isStructured()) { // Perform the default initial assignment of the DO variable. info.insertionPoint = builder->saveInsertionPoint(); - info.doLoop = builder->create( + info.doLoop = builder->create( loc, lowerValue, upperValue, info.stepValue, /*unordered=*/false, ArrayRef{lowerValue}); builder->setInsertionPointToStart(info.doLoop.getBody()); @@ -864,7 +864,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIRIncrementLoopEnd(IncrementLoopInfo &info) { auto loc = toLocation(); if (info.isStructured()) { - // End fir.loop. + // End fir.doloop. mlir::Value inc = builder->create( loc, info.doLoop.getInductionVar(), info.doLoop.step()); builder->create(loc, inc); @@ -1269,8 +1269,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { genLockStatement(*this, stmt); } - fir::LoopOp createLoopNest(llvm::SmallVectorImpl &lcvs, - const Fortran::evaluate::Shape &shape) { + fir::DoLoopOp createLoopNest(llvm::SmallVectorImpl &lcvs, + const Fortran::evaluate::Shape &shape) { auto loc = toLocation(); auto idxTy = builder->getIndexType(); auto zero = builder->createIntegerConstant(loc, idxTy, 0); @@ -1290,12 +1290,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { } // Iteration space is created with outermost columns, innermost rows std::reverse(extents.begin(), extents.end()); - fir::LoopOp inner; + fir::DoLoopOp inner; auto insPt = builder->saveInsertionPoint(); for (auto e : extents) { if (inner) builder->setInsertionPointToStart(inner.getBody()); - auto loop = builder->create(loc, zero, e, one); + auto loop = builder->create(loc, zero, e, one); lcvs.push_back(loop.getInductionVar()); if (!inner) insPt = builder->saveInsertionPoint(); diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index ddf76218a3753..4010a5abafa5d 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -39,7 +39,7 @@ class AffineIfConversion; class AffineLoopAnalysis { public: - AffineLoopAnalysis(fir::LoopOp op, AffineFunctionAnalysis &afa) + AffineLoopAnalysis(fir::DoLoopOp op, AffineFunctionAnalysis &afa) : legality(analyzeLoop(op, afa)) {} bool canPromoteToAffine() { return legality; } friend AffineFunctionAnalysis; @@ -49,15 +49,15 @@ class AffineLoopAnalysis { struct MemoryLoadAnalysis {}; DenseMap loadAnalysis; AffineLoopAnalysis(bool forcedLegality) : legality(forcedLegality) {} - bool analyzeBody(fir::LoopOp, AffineFunctionAnalysis &); - bool analyzeLoop(fir::LoopOp loopOperation, + bool analyzeBody(fir::DoLoopOp, AffineFunctionAnalysis &); + bool analyzeLoop(fir::DoLoopOp loopOperation, AffineFunctionAnalysis &functionAnalysis) { LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: \n"; loopOperation.dump();); return analyzeMemoryAccess(loopOperation) && analyzeBody(loopOperation, functionAnalysis); } bool analyzeArrayReference(mlir::Value); - bool analyzeMemoryAccess(fir::LoopOp loopOperation) { + bool analyzeMemoryAccess(fir::DoLoopOp loopOperation) { for (auto loadOp : loopOperation.getOps()) if (!analyzeArrayReference(loadOp.memref())) return false; @@ -125,7 +125,7 @@ class AffineIfCondition { return toAffineExpr(intConstant.getInt()); if (auto blockArg = value.dyn_cast()) { affineArgs.push_back(value); - if (isa(blockArg.getOwner()->getParentOp()) || + if (isa(blockArg.getOwner()->getParentOp()) || isa(blockArg.getOwner()->getParentOp())) return {mlir::getAffineDimExpr(dimCount++, value.getContext())}; return {mlir::getAffineSymbolExpr(symCount++, value.getContext())}; @@ -186,10 +186,10 @@ class AffineIfAnalysis { class AffineFunctionAnalysis { public: AffineFunctionAnalysis(mlir::FuncOp funcOp) { - for (fir::LoopOp op : funcOp.getOps()) + for (fir::DoLoopOp op : funcOp.getOps()) loopAnalysisMap.try_emplace(op, op, *this); } - AffineLoopAnalysis getChildLoopAnalysis(fir::LoopOp op) const { + AffineLoopAnalysis getChildLoopAnalysis(fir::DoLoopOp op) const { auto it = loopAnalysisMap.find_as(op); if (it == loopAnalysisMap.end()) { LLVM_DEBUG(llvm::dbgs() << "AffineFunctionAnalysis: not computed for:\n"; @@ -220,7 +220,7 @@ class AffineFunctionAnalysis { bool analyzeCoordinate(mlir::Value coordinate) { if (auto blockArg = coordinate.dyn_cast()) { - if (isa(blockArg.getOwner()->getParentOp())) { + if (isa(blockArg.getOwner()->getParentOp())) { return true; } else { llvm::dbgs() << "AffineLoopAnalysis: array coordinate is not a " @@ -246,9 +246,9 @@ bool AffineLoopAnalysis::analyzeArrayReference(mlir::Value arrayRef) { return canPromote; } -bool AffineLoopAnalysis::analyzeBody(fir::LoopOp loopOperation, +bool AffineLoopAnalysis::analyzeBody(fir::DoLoopOp loopOperation, AffineFunctionAnalysis &functionAnalysis) { - for (auto loopOp : loopOperation.getOps()) { + for (auto loopOp : loopOperation.getOps()) { auto analysis = functionAnalysis.loopAnalysisMap .try_emplace(loopOp, loopOp, functionAnalysis) .first->getSecond(); @@ -362,17 +362,17 @@ void rewriteMemoryOps(Block *block, mlir::PatternRewriter &rewriter) { } } -/// Convert `fir.loop` to `affine.for`, creates fir.convert for arrays to +/// Convert `fir.doloop` to `affine.for`, creates fir.convert for arrays to /// memref, rewrites array_coor to affine.apply with affine_map. Rewrites fir /// loads and stores to affine. -class AffineLoopConversion : public mlir::OpRewritePattern { +class AffineLoopConversion : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; AffineLoopConversion(mlir::MLIRContext *context, AffineFunctionAnalysis &afa) : OpRewritePattern(context), functionAnalysis(afa) {} mlir::LogicalResult - matchAndRewrite(fir::LoopOp loop, + matchAndRewrite(fir::DoLoopOp loop, mlir::PatternRewriter &rewriter) const override { LLVM_DEBUG(llvm::dbgs() << "AffineLoopConversion: rewriting loop:\n"; loop.dump();); @@ -402,7 +402,7 @@ class AffineLoopConversion : public mlir::OpRewritePattern { private: std::pair - createAffineFor(fir::LoopOp op, mlir::PatternRewriter &rewriter) const { + createAffineFor(fir::DoLoopOp op, mlir::PatternRewriter &rewriter) const { if (auto constantStep = constantIntegerLike(op.step())) if (constantStep.getValue() > 0) return positiveConstantStep(op, constantStep.getValue(), rewriter); @@ -410,7 +410,7 @@ class AffineLoopConversion : public mlir::OpRewritePattern { } // when step for the loop is positive compile time constant std::pair - positiveConstantStep(fir::LoopOp op, int64_t step, + positiveConstantStep(fir::DoLoopOp op, int64_t step, mlir::PatternRewriter &rewriter) const { auto affineFor = rewriter.create( op.getLoc(), ValueRange(op.lowerBound()), @@ -423,7 +423,7 @@ class AffineLoopConversion : public mlir::OpRewritePattern { return std::make_pair(affineFor, affineFor.getInductionVar()); } std::pair - genericBounds(fir::LoopOp op, mlir::PatternRewriter &rewriter) const { + genericBounds(fir::DoLoopOp op, mlir::PatternRewriter &rewriter) const { auto lowerBound = mlir::getAffineSymbolExpr(0, op.getContext()); auto upperBound = mlir::getAffineSymbolExpr(1, op.getContext()); auto step = mlir::getAffineSymbolExpr(2, op.getContext()); @@ -496,7 +496,7 @@ class AffineIfConversion : public mlir::OpRewritePattern { AffineFunctionAnalysis &functionAnalysis; }; -/// Promote fir.loop and fir.if to affine.for and affine.if, in the cases +/// Promote fir.doloop and fir.if to affine.for and affine.if, in the cases /// where such a promotion is possible. class AffineDialectPromotion : public AffineDialectPromotionBase { @@ -517,7 +517,8 @@ class AffineDialectPromotion target.addDynamicallyLegalOp([&functionAnalysis](fir::IfOp op) { return !(functionAnalysis.getChildIfAnalysis(op).canPromoteToAffine()); }); - target.addDynamicallyLegalOp([&functionAnalysis](fir::LoopOp op) { + target.addDynamicallyLegalOp([&functionAnalysis]( + fir::DoLoopOp op) { return !(functionAnalysis.getChildLoopAnalysis(op).canPromoteToAffine()); }); diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index be3ed83d6d9b3..2564f3cf44726 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -38,21 +38,22 @@ namespace { // `fir.do_loop` operations. These can be converted to control-flow operations. /// Convert `fir.do_loop` to CFG -class CfgLoopConv : public mlir::OpRewritePattern { +class CfgLoopConv : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; mlir::LogicalResult - matchAndRewrite(LoopOp loop, mlir::PatternRewriter &rewriter) const override { + matchAndRewrite(DoLoopOp loop, + mlir::PatternRewriter &rewriter) const override { auto loc = loop.getLoc(); - // Create the start and end blocks that will wrap the LoopOp with an + // Create the start and end blocks that will wrap the DoLoopOp with an // initalizer and an end point auto *initBlock = rewriter.getInsertionBlock(); auto initPos = rewriter.getInsertionPoint(); auto *endBlock = rewriter.splitBlock(initBlock, initPos); - // Split the first LoopOp block in two parts. The part before will be the + // Split the first DoLoopOp block in two parts. The part before will be the // conditional block since it already has the induction variable and // loop-carried values as arguments. auto *conditionalBlock = &loop.region().front(); @@ -61,10 +62,10 @@ class CfgLoopConv : public mlir::OpRewritePattern { rewriter.splitBlock(conditionalBlock, conditionalBlock->begin()); auto *lastBlock = &loop.region().back(); - // Move the blocks from the LoopOp between initBlock and endBlock + // Move the blocks from the DoLoopOp between initBlock and endBlock rewriter.inlineRegionBefore(loop.region(), endBlock); - // Get loop values from the LoopOp + // Get loop values from the DoLoopOp auto low = loop.lowerBound(); auto high = loop.upperBound(); assert(low && high && "must be a Value"); @@ -280,7 +281,7 @@ class CfgConversion : public CFGConversionBase { mlir::StandardOpsDialect>(); // apply the patterns - target.addIllegalOp(); + target.addIllegalOp(); target.markUnknownOpDynamicallyLegal([](Operation *) { return true; }); if (mlir::failed( mlir::applyPartialConversion(getFunction(), target, patterns))) { From fd290413fcc9922ce9b8bbfc23a03350c839a20c Mon Sep 17 00:00:00 2001 From: rajan Date: Wed, 22 Jul 2020 13:09:17 -0400 Subject: [PATCH 0184/1017] converting affine memory loads to fir (#277) --- .../flang/Optimizer/Transforms/Passes.h | 3 + .../flang/Optimizer/Transforms/Passes.td | 8 ++ flang/lib/Optimizer/CMakeLists.txt | 1 + .../Optimizer/Transforms/AffineDemotion.cpp | 124 ++++++++++++++++++ .../Optimizer/Transforms/AffinePromotion.cpp | 5 +- 5 files changed, 137 insertions(+), 4 deletions(-) create mode 100644 flang/lib/Optimizer/Transforms/AffineDemotion.cpp diff --git a/flang/include/flang/Optimizer/Transforms/Passes.h b/flang/include/flang/Optimizer/Transforms/Passes.h index 8235e0b8d577a..069dfdc1c54f0 100644 --- a/flang/include/flang/Optimizer/Transforms/Passes.h +++ b/flang/include/flang/Optimizer/Transforms/Passes.h @@ -31,6 +31,9 @@ std::unique_ptr createCSEPass(); /// Convert FIR loop constructs to the Affine dialect std::unique_ptr createPromoteToAffinePass(); +/// Convert Affine operations back to FIR +std::unique_ptr createAffineDemotionPass(); + /// Convert `fir.do_loop` and `fir.if` to a CFG. This /// conversion enables the `createLowerToCFGPass` to transform these to CFG /// form. diff --git a/flang/include/flang/Optimizer/Transforms/Passes.td b/flang/include/flang/Optimizer/Transforms/Passes.td index 8e21fc971ebb3..bfe3fbe46aa6a 100644 --- a/flang/include/flang/Optimizer/Transforms/Passes.td +++ b/flang/include/flang/Optimizer/Transforms/Passes.td @@ -66,6 +66,14 @@ def MemRefDataFlowOpt : FunctionPass<"fir-memref-dataflow-opt"> { let constructor = "::fir::createMemDataFlowOptPass()"; } +def AffineDialectDemotion : FunctionPass<"demote-to-affine"> { + let summary = "Converts affine.load and affine.store back to fir operations"; + let description = [{ + TODO + }]; + let constructor = "fir::createAffineDemotionPass()"; +} + def BasicCSE : FunctionPass<"basic-cse"> { let summary = "Basic common sub-expression elimination."; let description = [{ diff --git a/flang/lib/Optimizer/CMakeLists.txt b/flang/lib/Optimizer/CMakeLists.txt index 246117c0b35ad..8fec6d1e6ac0b 100644 --- a/flang/lib/Optimizer/CMakeLists.txt +++ b/flang/lib/Optimizer/CMakeLists.txt @@ -21,6 +21,7 @@ add_flang_library(FIROptimizer Transforms/Inliner.cpp Transforms/MemToReg.cpp Transforms/AffinePromotion.cpp + Transforms/AffineDemotion.cpp Transforms/RewriteLoop.cpp DEPENDS diff --git a/flang/lib/Optimizer/Transforms/AffineDemotion.cpp b/flang/lib/Optimizer/Transforms/AffineDemotion.cpp new file mode 100644 index 0000000000000..1eb3d7c18721e --- /dev/null +++ b/flang/lib/Optimizer/Transforms/AffineDemotion.cpp @@ -0,0 +1,124 @@ +//===-- AffineDemotion.cpp -----------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "PassDetail.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Conversion/AffineToStandard/AffineToStandard.h" +#include "mlir/Dialect/Affine/IR/AffineOps.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/IR/Attributes.h" +#include "mlir/IR/IntegerSet.h" +#include "mlir/IR/Visitors.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Transforms/DialectConversion.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/Optional.h" +#include "llvm/Support/CommandLine.h" +#define DEBUG_TYPE "flang-affine-demotion" + +using namespace fir; + +namespace { + +class AffineLoadConversion : public OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + + LogicalResult matchAndRewrite(mlir::AffineLoadOp op, + PatternRewriter &rewriter) const override { + SmallVector indices(op.getMapOperands()); + auto maybeExpandedMap = + expandAffineMap(rewriter, op.getLoc(), op.getAffineMap(), indices); + if (!maybeExpandedMap) + return failure(); + + auto coorOp = rewriter.create( + op.getLoc(), fir::ReferenceType::get(op.getResult().getType()), + op.getMemRef(), *maybeExpandedMap); + + rewriter.replaceOpWithNewOp(op, coorOp.getResult()); + return success(); + } +}; + +class AffineStoreConversion : public OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + + LogicalResult matchAndRewrite(mlir::AffineStoreOp op, + PatternRewriter &rewriter) const override { + SmallVector indices(op.getMapOperands()); + auto maybeExpandedMap = + expandAffineMap(rewriter, op.getLoc(), op.getAffineMap(), indices); + if (!maybeExpandedMap) + return failure(); + + auto coorOp = rewriter.create( + op.getLoc(), fir::ReferenceType::get(op.getValueToStore().getType()), + op.getMemRef(), *maybeExpandedMap); + rewriter.replaceOpWithNewOp(op, op.getValueToStore(), + coorOp.getResult()); + return success(); + } +}; + +class ConvertConversion : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + mlir::LogicalResult + matchAndRewrite(fir::ConvertOp op, + mlir::PatternRewriter &rewriter) const override { + if (op.res().getType().isa()) { + rewriter.startRootUpdate(op.getParentOp()); + op.getResult().replaceAllUsesWith(op.value()); + rewriter.finalizeRootUpdate(op.getParentOp()); + rewriter.eraseOp(op); + } + return success(); + } +}; + +class AffineDialectDemotion + : public AffineDialectDemotionBase { +public: + void runOnFunction() override { + auto *context = &getContext(); + auto function = getFunction(); + LLVM_DEBUG(llvm::dbgs() << "AffineDemotion: running on function:\n"; + function.print(llvm::dbgs());); + + mlir::OwningRewritePatternList patterns; + patterns.insert(context); + patterns.insert(context); + patterns.insert(context); + mlir::ConversionTarget target = *context; + target.addDynamicallyLegalOp([](fir::ConvertOp op) { + if (op.res().getType().isa()) + return false; + return true; + }); + target.addLegalDialect(); + + if (mlir::failed(mlir::applyPartialConversion(function, target, + std::move(patterns)))) { + mlir::emitError(mlir::UnknownLoc::get(context), + "error in converting affine dialect\n"); + signalPassFailure(); + } + } +}; + +} // namespace + +std::unique_ptr fir::createAffineDemotionPass() { + return std::make_unique(); +} diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index 4010a5abafa5d..7b026726e402e 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -457,7 +457,7 @@ class AffineIfConversion : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; AffineIfConversion(mlir::MLIRContext *context, AffineFunctionAnalysis &afa) - : OpRewritePattern(context), functionAnalysis(afa) {} + : OpRewritePattern(context) {} mlir::LogicalResult matchAndRewrite(fir::IfOp op, mlir::PatternRewriter &rewriter) const override { @@ -491,9 +491,6 @@ class AffineIfConversion : public mlir::OpRewritePattern { rewriter.replaceOp(op, affineIf.getOperation()->getResults()); return success(); } - -private: - AffineFunctionAnalysis &functionAnalysis; }; /// Promote fir.doloop and fir.if to affine.for and affine.if, in the cases From 4b688358b7af0cf47e8ff4bdc1c35c1036622886 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Wed, 22 Jul 2020 21:55:15 +0530 Subject: [PATCH 0185/1017] Addressed schweitzpgi review comments [flang][OpenMP] Added support for lowering OpenMP taskyield construct This patch adds lowering support for OpenMP-5.0 taskyield construct to OpenMP Dialect operations. --- flang/documentation/BurnsideToFIR.md | 10 ++++---- .../flang/Optimizer/Transforms/Passes.td | 8 ------- flang/lib/Lower/Bridge.cpp | 4 ++-- .../Optimizer/Transforms/AffinePromotion.cpp | 4 ++-- flang/test/Lower/omp-taskyield.f90 | 24 +++++++++++++++++++ 5 files changed, 33 insertions(+), 17 deletions(-) create mode 100644 flang/test/Lower/omp-taskyield.f90 diff --git a/flang/documentation/BurnsideToFIR.md b/flang/documentation/BurnsideToFIR.md index 425887909ed18..9bd2e6337c087 100644 --- a/flang/documentation/BurnsideToFIR.md +++ b/flang/documentation/BurnsideToFIR.md @@ -428,7 +428,7 @@ Fortran into FIR in a semantics preserving way. // create a temporary to hold E(V) %v = ... : !fir.array<4:i32> %8 = fir.alloca !fir.array<4:f32> : !fir.ref> - fir.doloop %i = %c1 to %c4 unordered { + fir.do_loop %i = %c1 to %c4 unordered { %9 = fir.extract_value %v, %i : (!fir.array<4:i32>, index) -> i32 %10 = fir.extract_value %e, %9 : (!fir.array, i32) -> f32 %11 = fir.coordinate_of %8, %i : (!fir.ref>, index) -> !fir.ref @@ -615,7 +615,7 @@ One must also specify to LLVM that these operations will not be reassociated. ```mlir %arr = ... : !fir.array %threshold = ... : !fir.array - fir.doloop %i = %c1 to %size { + fir.do_loop %i = %c1 to %size { %arr_i = fir.extract_value %arr, %i : ... -> !T %threshold_i = fir.extract_value %threshold, %i : ... -> !T %1 = cmp "lt" %arr_i, %threshold_i : ... -> i1 @@ -639,7 +639,7 @@ One must also specify to LLVM that these operations will not be reassociated. ``` ---- ```mlir - fir.doloop %i = %c1 to %c100 unordered { + fir.do_loop %i = %c1 to %c100 unordered { %1 = fir.extract_value %b, %i : (!fir.array, index) -> f32 %2 = fir.extract_value %c, %i : (!fir.array, index) -> f32 %3 = divf %1, %2 : f32 @@ -686,8 +686,8 @@ One must also specify to LLVM that these operations will not be reassociated. %1 = fir.gendims %c1, %c1000, %c100 : !fir.dims<1> %2 = fir.gendims %c1, %c10, %c1 : !fir.dims<1> - fir.doloop %i = %c1 to %m { - fir.doloop %i = %c1 to %n { + fir.do_loop %i = %c1 to %m { + fir.do_loop %i = %c1 to %n { %13 = fir.coordinate_of %a, %i, %j : !fir.ref> %14 = fir.embox %13, %1 : (!fir.ref>, !fir.dims<1>) -> !fir.box> %15 = fir.coordinate_of %b, %c1, %i, %j : !fir.ref diff --git a/flang/include/flang/Optimizer/Transforms/Passes.td b/flang/include/flang/Optimizer/Transforms/Passes.td index bfe3fbe46aa6a..8e21fc971ebb3 100644 --- a/flang/include/flang/Optimizer/Transforms/Passes.td +++ b/flang/include/flang/Optimizer/Transforms/Passes.td @@ -66,14 +66,6 @@ def MemRefDataFlowOpt : FunctionPass<"fir-memref-dataflow-opt"> { let constructor = "::fir::createMemDataFlowOptPass()"; } -def AffineDialectDemotion : FunctionPass<"demote-to-affine"> { - let summary = "Converts affine.load and affine.store back to fir operations"; - let description = [{ - TODO - }]; - let constructor = "fir::createAffineDemotionPass()"; -} - def BasicCSE : FunctionPass<"basic-cse"> { let summary = "Basic common sub-expression elimination."; let description = [{ diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 982169ca01cab..b1c43931def70 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -813,7 +813,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(info.stepValue && "step value must be set"); info.loopVariable = createTemp(loc, *info.loopVariableSym); - // Structured loop - generate fir.doloop. + // Structured loop - generate fir.do_loop. if (info.isStructured()) { // Perform the default initial assignment of the DO variable. info.insertionPoint = builder->saveInsertionPoint(); @@ -864,7 +864,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIRIncrementLoopEnd(IncrementLoopInfo &info) { auto loc = toLocation(); if (info.isStructured()) { - // End fir.doloop. + // End fir.do_loop. mlir::Value inc = builder->create( loc, info.doLoop.getInductionVar(), info.doLoop.step()); builder->create(loc, inc); diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index 7b026726e402e..f8ce346f9c063 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -362,7 +362,7 @@ void rewriteMemoryOps(Block *block, mlir::PatternRewriter &rewriter) { } } -/// Convert `fir.doloop` to `affine.for`, creates fir.convert for arrays to +/// Convert `fir.do_loop` to `affine.for`, creates fir.convert for arrays to /// memref, rewrites array_coor to affine.apply with affine_map. Rewrites fir /// loads and stores to affine. class AffineLoopConversion : public mlir::OpRewritePattern { @@ -493,7 +493,7 @@ class AffineIfConversion : public mlir::OpRewritePattern { } }; -/// Promote fir.doloop and fir.if to affine.for and affine.if, in the cases +/// Promote fir.do_loop and fir.if to affine.for and affine.if, in the cases /// where such a promotion is possible. class AffineDialectPromotion : public AffineDialectPromotionBase { diff --git a/flang/test/Lower/omp-taskyield.f90 b/flang/test/Lower/omp-taskyield.f90 new file mode 100644 index 0000000000000..01436f870c737 --- /dev/null +++ b/flang/test/Lower/omp-taskyield.f90 @@ -0,0 +1,24 @@ +! This test checks lowering of OpenMP taskyield Directive. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: tco | FileCheck %s --check-prefix=LLVMIR + +program taskyield + + integer :: a,b,c + +!$OMP TASKYIELD +!FIRDialect: omp.taskyield +!LLVMIRDialect: omp.taskyield +!LLVMIR: %{{.*}} = call i32 @__kmpc_omp_taskyield(%struct.ident_t* @{{.*}}, i32 %{{.*}}) + c = a + b +!$OMP TASKYIELD +!FIRDialect: omp.taskyield +!LLVMIRDialect: omp.taskyield +!LLVMIR: %{{.*}} = call i32 @__kmpc_omp_taskyield(%struct.ident_t* @{{.*}}, i32 %{{.*}}) + +end program From bd748b47520b812c16245d5663bed2054be148e8 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 22 Jul 2020 15:36:39 -0700 Subject: [PATCH 0186/1017] codegen for static shaped boxes --- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 72 ++++++++++++++++---- 1 file changed, 57 insertions(+), 15 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index d1190619188d0..bcb8b346e2aea 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -45,18 +45,60 @@ class EmboxConversion : public mlir::OpRewritePattern { mlir::LogicalResult matchAndRewrite(EmboxOp embox, mlir::PatternRewriter &rewriter) const override { - auto loc = embox.getLoc(); - auto dimsVal = embox.getShape(); + auto shapeVal = embox.getShape(); // If the embox does not include a shape, then do not convert it - if (!dimsVal) - return mlir::failure(); - auto shapeOp = dyn_cast(dimsVal.getDefiningOp()); + if (shapeVal) + return rewriteDynamicShape(embox, rewriter, shapeVal); + if (auto boxTy = embox.getType().dyn_cast()) + if (auto seqTy = boxTy.getEleTy().dyn_cast()) + if (seqTy.hasConstantShape()) + return rewriteStaticShape(embox, rewriter, seqTy); + return mlir::failure(); + } + + mlir::LogicalResult rewriteStaticShape(EmboxOp embox, + mlir::PatternRewriter &rewriter, + fir::SequenceType seqTy) const { + auto loc = embox.getLoc(); + llvm::SmallVector shapeOpers; + auto idxTy = rewriter.getIndexType(); + for (auto ext : seqTy.getShape()) { + auto iAttr = rewriter.getIndexAttr(ext); + auto extVal = rewriter.create(loc, idxTy, iAttr); + shapeOpers.push_back(extVal); + } + mlir::NamedAttrList attrs; + auto rank = seqTy.getDimension(); + auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); + attrs.push_back(rewriter.getNamedAttr(XEmboxOp::rankAttrName(), rankAttr)); + auto zeroAttr = rewriter.getIntegerAttr(idxTy, 0); + attrs.push_back( + rewriter.getNamedAttr(XEmboxOp::lenParamAttrName(), zeroAttr)); + auto shapeAttr = rewriter.getIntegerAttr(idxTy, shapeOpers.size()); + attrs.push_back( + rewriter.getNamedAttr(XEmboxOp::shapeAttrName(), shapeAttr)); + attrs.push_back( + rewriter.getNamedAttr(XEmboxOp::shiftAttrName(), zeroAttr)); + attrs.push_back( + rewriter.getNamedAttr(XEmboxOp::sliceAttrName(), zeroAttr)); + auto xbox = rewriter.create(loc, embox.getType(), embox.memref(), + shapeOpers, llvm::None, llvm::None, + llvm::None, attrs); + rewriter.replaceOp(embox, xbox.getOperation()->getResults()); + return mlir::success(); + } + + mlir::LogicalResult rewriteDynamicShape(EmboxOp embox, + mlir::PatternRewriter &rewriter, + mlir::Value shapeVal) const { + auto loc = embox.getLoc(); + auto shapeOp = dyn_cast(shapeVal.getDefiningOp()); llvm::SmallVector shapeOpers; llvm::SmallVector shiftOpers; if (shapeOp) { populateShape(shapeOpers, shapeOp); } else { - auto shiftOp = dyn_cast(dimsVal.getDefiningOp()); + auto shiftOp = dyn_cast(shapeVal.getDefiningOp()); assert(shiftOp && "shape is neither fir.shape nor fir.shape_shift"); populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); } @@ -77,8 +119,7 @@ class EmboxConversion : public mlir::OpRewritePattern { rewriter.getNamedAttr(XEmboxOp::shiftAttrName(), shiftAttr)); llvm::SmallVector sliceOpers; if (auto s = embox.getSlice()) - if (auto sliceOp = - dyn_cast_or_null(s.getDefiningOp())) + if (auto sliceOp = dyn_cast_or_null(s.getDefiningOp())) sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); auto sliceAttr = rewriter.getIntegerAttr(idxTy, sliceOpers.size()); attrs.push_back( @@ -131,16 +172,14 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { rewriter.getNamedAttr(XArrayCoorOp::shapeAttrName(), dimAttr)); llvm::SmallVector sliceOpers; if (auto s = arrCoor.getSlice()) - if (auto sliceOp = - dyn_cast_or_null(s.getDefiningOp())) + if (auto sliceOp = dyn_cast_or_null(s.getDefiningOp())) sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); auto sliceAttr = rewriter.getIntegerAttr(idxTy, sliceOpers.size()); attrs.push_back( rewriter.getNamedAttr(XArrayCoorOp::sliceAttrName(), sliceAttr)); auto xArrCoor = rewriter.create( - loc, arrCoor.getType(), arrCoor.memref(), shapeOpers, - shiftOpers, sliceOpers, - arrCoor.getIndices(), arrCoor.getLenParams(), attrs); + loc, arrCoor.getType(), arrCoor.memref(), shapeOpers, shiftOpers, + sliceOpers, arrCoor.getIndices(), arrCoor.getLenParams(), attrs); rewriter.replaceOp(arrCoor, xArrCoor.getOperation()->getResults()); return mlir::success(); } @@ -156,8 +195,11 @@ class CodeGenRewrite : public CodeGenRewriteBase { mlir::ConversionTarget target(context); target.addLegalDialect(); target.addIllegalOp(); - target.addDynamicallyLegalOp( - [](EmboxOp embox) { return !embox.getShape(); }); + target.addDynamicallyLegalOp([](EmboxOp embox) { + return !( + embox.getShape() || + embox.getType().cast().getEleTy().isa()); + }); // Do the conversions. if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, From 3a1a64ab9d1359ab962c9b00d6e6758e83d137fd Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 22 Jul 2020 12:27:32 -0700 Subject: [PATCH 0187/1017] [mlir] changes to mlir::FuncOp, etc. to support adding linkage attribute These changes are temporary as MLIR may have different ideas on the interface. --- .../StandardToLLVM/StandardToLLVM.cpp | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/mlir/lib/Conversion/StandardToLLVM/StandardToLLVM.cpp b/mlir/lib/Conversion/StandardToLLVM/StandardToLLVM.cpp index 7e289a5f5d995..834dd56d62551 100644 --- a/mlir/lib/Conversion/StandardToLLVM/StandardToLLVM.cpp +++ b/mlir/lib/Conversion/StandardToLLVM/StandardToLLVM.cpp @@ -1414,8 +1414,24 @@ struct FuncOpConversionBase : public ConvertOpToLLVMPattern { // Create an LLVM function, use external linkage by default until MLIR // functions have linkage. + // TODO: Add some code to work around the linkage limitation, but it's not + // clear what MLIR's intented design should be. + auto convertLinkage = [&]() -> mlir::LLVM::Linkage { + if (auto link = funcOp.getAttrOfType("linkName")) { + auto name = link.getValue(); + if (name == "internal") + return mlir::LLVM::Linkage::Internal; + if (name == "linkonce") + return mlir::LLVM::Linkage::Linkonce; + if (name == "common") + return mlir::LLVM::Linkage::Common; + if (name == "weak") + return mlir::LLVM::Linkage::Weak; + } + return mlir::LLVM::Linkage::External; + }; auto newFuncOp = rewriter.create( - funcOp.getLoc(), funcOp.getName(), llvmType, LLVM::Linkage::External, + funcOp.getLoc(), funcOp.getName(), llvmType, convertLinkage(), attributes); rewriter.inlineRegionBefore(funcOp.getBody(), newFuncOp.getBody(), newFuncOp.end()); From 5e6629e26334b87d4f21ccbdc5799d159265aaf3 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 23 Jul 2020 01:47:20 -0700 Subject: [PATCH 0188/1017] Add internal linkage to intrinsics wrappers Intrinsic wrappers can be emitted in several compilation unit so they cannot have external linkage to avoid conflicting. linkonce would also be an option but LLVM LangRef says regarding linkonce: "Note that linkonce linkage does not actually allow the optimizer to inline the body of this function into callers" So stick to internal linkage since we do want wrappers to be inlinable. --- flang/lib/Lower/IntrinsicCall.cpp | 5 ++--- flang/test/Lower/intrinsic-wrappers.f90 | 13 +++++++++++++ 2 files changed, 15 insertions(+), 3 deletions(-) create mode 100644 flang/test/Lower/intrinsic-wrappers.f90 diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp index 5758a143c3c1d..cd77a5ad419b2 100644 --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -727,10 +727,8 @@ IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, mlir::Type resultType, getFunctionType(resultType, mlirArgs, builder); auto runtimeCallGenerator = getRuntimeCallGenerator(name, soughtFuncType); - // FIXME: set outline back to true and use linkOnce for the wrapper - // instead. return genElementalCall(runtimeCallGenerator, name, resultType, args, - /* outline */ false); + /* outline */ true); } mlir::Value @@ -772,6 +770,7 @@ mlir::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator, // First time this wrapper is needed, build it. function = builder.createFunction(loc, wrapperName, funcType); function->setAttr("fir.intrinsic", builder.getUnitAttr()); + function->setAttr("linkName", builder.createInternalLinkage()); function.addEntryBlock(); // Create local context to emit code into the newly created function diff --git a/flang/test/Lower/intrinsic-wrappers.f90 b/flang/test/Lower/intrinsic-wrappers.f90 new file mode 100644 index 0000000000000..49096f9fab519 --- /dev/null +++ b/flang/test/Lower/intrinsic-wrappers.f90 @@ -0,0 +1,13 @@ +! RUN: bbc -emit-llvm -outline-intrinsics %s -o - | FileCheck %s + +! Test properties of intrinsic function wrappers + +! Test that intrinsic wrappers have internal linkage +function foo(x) + foo = acos(x) +end function + +! CHECK: llvm.func internal @fir.acos.f32.f32 + + +! TODO: test wrapper mangling, attributes ... From 834fd2d36fd2def06eb1f61d8bef76aeb42f4c15 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 23 Jul 2020 10:11:23 -0700 Subject: [PATCH 0189/1017] rebase fallout: changes to downstream LLVM sources not built/tested against fir-dev --- flang/lib/Lower/Bridge.cpp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index b1c43931def70..8ced6b3fb1f68 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -997,6 +997,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::emitWarning(toLocation(), "ignoring all compiler directives"); } + void genFIR(const Fortran::parser::OpenACCConstruct &) { TODO(); } + void genFIR(const Fortran::parser::OpenMPConstruct &omp) { genOpenMPConstruct(*this, getEval(), omp); } From 9468cc5584223fe8f6174a04faf73ed5598c0c4f Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 23 Jul 2020 13:32:02 -0700 Subject: [PATCH 0190/1017] flag pre-fir-tree05.f90 as an expected fail --- flang/test/Lower/pre-fir-tree05.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/test/Lower/pre-fir-tree05.f90 b/flang/test/Lower/pre-fir-tree05.f90 index 9096e38423850..862bf87d9a3f7 100644 --- a/flang/test/Lower/pre-fir-tree05.f90 +++ b/flang/test/Lower/pre-fir-tree05.f90 @@ -1,4 +1,4 @@ -! RUN: %flang_fc1 -fsyntax-only -fdebug-pre-fir-tree -fopenacc %s | FileCheck %s +! RUN: bbc -I %moddir -pft-test -fopenacc -o %t %s | FileCheck %s ! Test structure of the Pre-FIR tree with OpenACC construct From 636004bb897eb9e86c9ff6380ebf4b85dfd46c46 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Thu, 23 Jul 2020 11:53:17 -0700 Subject: [PATCH 0191/1017] Call InputComplex{32,64} for formatted COMPLEX input These are new runtime I/O APIs that, as it turns out, need to exist so that list-directed I/O can distinguish COMPLEX from REAL when dealing with null inputs. --- flang/lib/Lower/RTBuilder.h | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/flang/lib/Lower/RTBuilder.h b/flang/lib/Lower/RTBuilder.h index d41a45cfee35e..693e2857bfbb7 100644 --- a/flang/lib/Lower/RTBuilder.h +++ b/flang/lib/Lower/RTBuilder.h @@ -131,6 +131,13 @@ constexpr TypeBuilderFunc getModel() { }; } template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::PointerType::get(f(context)); + }; +} +template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return mlir::FloatType::getF32(context); @@ -144,6 +151,13 @@ constexpr TypeBuilderFunc getModel() { }; } template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::PointerType::get(f(context)); + }; +} +template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return mlir::IntegerType::get(context, 1); From a886c2a9a9e64433e93b91e5b91b977569a44a81 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Thu, 23 Jul 2020 13:21:31 -0700 Subject: [PATCH 0192/1017] address review comment --- flang/lib/Lower/RTBuilder.h | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/flang/lib/Lower/RTBuilder.h b/flang/lib/Lower/RTBuilder.h index 693e2857bfbb7..5dba1a47100f2 100644 --- a/flang/lib/Lower/RTBuilder.h +++ b/flang/lib/Lower/RTBuilder.h @@ -132,10 +132,7 @@ constexpr TypeBuilderFunc getModel() { } template <> constexpr TypeBuilderFunc getModel() { - return [](mlir::MLIRContext *context) -> mlir::Type { - TypeBuilderFunc f{getModel()}; - return fir::PointerType::get(f(context)); - }; + return getModel(); } template <> constexpr TypeBuilderFunc getModel() { @@ -152,10 +149,7 @@ constexpr TypeBuilderFunc getModel() { } template <> constexpr TypeBuilderFunc getModel() { - return [](mlir::MLIRContext *context) -> mlir::Type { - TypeBuilderFunc f{getModel()}; - return fir::PointerType::get(f(context)); - }; + return getModel(); } template <> constexpr TypeBuilderFunc getModel() { From 9999f5b5db22fe3de49d442c791bd9f3358adeab Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 23 Jul 2020 09:35:40 -0700 Subject: [PATCH 0193/1017] Pre-declare FuncOp of all procedures declared in a program unit before lowering bodies The need to do this arise from the implicit interface rules that lead to situation where the signature of a a function on call site is different from the definition signature. This is particularly important when the first usage of a function is to be passed as dummy argument, in which case we do know how many arguments the FuncOp must have, leading to crashes if we later try to define it with one or more arguments. To ensure that the definition signature prevail if it is accessible, pre-declare all mlir::FuncOp before lowering the bodies. This is done by making a pass on the top level of the PFT before the pass to lower the bodies. The CallInterface is refactored a bit to help do that. --- flang/include/flang/Lower/CallInterface.h | 24 ++++++---- flang/lib/Lower/Bridge.cpp | 47 ++++++++++++++++++- flang/lib/Lower/CallInterface.cpp | 22 ++++++--- flang/test/Lower/dummy-procedure.f90 | 32 ++++++------- flang/test/Lower/global-init.f90 | 13 ++--- .../test/Lower/program-units-fir-mangling.f90 | 6 ++- flang/test/Lower/stop.f90 | 3 +- 7 files changed, 105 insertions(+), 42 deletions(-) diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index 2585455af6750..19997891003ff 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -174,10 +174,16 @@ class CallInterface { void buildExplicitInterface(const Fortran::evaluate::characteristics::Procedure &); -private: +protected: + CallInterface(Fortran::lower::AbstractConverter &c) : converter{c} {} /// CRTP handle. T &side() { return *static_cast(this); } - /// Second pass entry point, once the mlir::FuncOp is created + /// Entry point to be called by child ctor to analyze the signature and + /// create/find the mlir::FuncOp. Child needs to be initialized first. + void declare(); + /// Second pass entry point, once the mlir::FuncOp is created. + /// Nothing is done if it was already called. + void mapPassedEntities(); void mapBackInputToPassedEntity(const FirPlaceHolder &, FirValue); llvm::SmallVector outputs; @@ -186,11 +192,6 @@ class CallInterface { llvm::SmallVector passedArguments; std::optional passedResult; -protected: - CallInterface(Fortran::lower::AbstractConverter &c) : converter{c} {} - /// Entry point to be called by child ctor (childs need to be initialized - /// first). - void init(); Fortran::lower::AbstractConverter &converter; /// Store characteristic once created, it is required for further information /// (e.g. getting the length of character result) @@ -210,7 +211,8 @@ class CallerInterface : public CallInterface { CallerInterface(const Fortran::evaluate::ProcedureRef &p, Fortran::lower::AbstractConverter &c) : CallInterface{c}, procRef{p} { - init(); + declare(); + mapPassedEntities(); actualInputs = llvm::SmallVector(getNumFIRArguments()); } /// CRTP callbacks @@ -261,7 +263,7 @@ class CalleeInterface : public CallInterface { CalleeInterface(Fortran::lower::pft::FunctionLikeUnit &f, Fortran::lower::AbstractConverter &c) : CallInterface{c}, funit{f} { - init(); + declare(); } bool hasAlternateReturns() const; std::string getMangledName() const; @@ -275,6 +277,10 @@ class CalleeInterface : public CallInterface { /// called through pointers or not. bool isIndirectCall() const { return false; } + /// Add mlir::FuncOp entry block and map fir block arguments to Fortran dummy + /// argument symbols. + mlir::FuncOp addEntryBlockAndMapArguments(); + private: Fortran::lower::pft::FunctionLikeUnit &funit; }; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 8ced6b3fb1f68..734c87bf17162 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -260,6 +260,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// Convert the PFT to FIR void run(Fortran::lower::pft::Program &pft) { + // Declare mlir::FuncOp for all the FunctionLikeUnit defined in the PFT + // before lowering any function bodies so that the definition signatures + // prevail on call spot signatures. + declareFunctions(pft); // do translation for (auto &u : pft.getUnits()) { std::visit( @@ -275,6 +279,44 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } + /// Declare mlir::FuncOp for all the FunctionLikeUnit defined in the PFT + /// without any other side-effects. + void declareFunctions(Fortran::lower::pft::Program &pft) { + for (auto &u : pft.getUnits()) { + std::visit(Fortran::common::visitors{ + [&](Fortran::lower::pft::FunctionLikeUnit &f) { + declareFunction(f); + }, + [&](Fortran::lower::pft::ModuleLikeUnit &m) { + for (auto &f : m.nestedFunctions) + declareFunction(f); + }, + [&](Fortran::lower::pft::BlockDataUnit &) { + // No functions defined in block data. + }, + }, + u); + } + } + void declareFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { + for (int entryIndex = 0, last = funit.entryPointList.size(); + entryIndex < last; ++entryIndex) { + funit.setActiveEntry(entryIndex); + // Calling CalleeInterface ctor will build the mlir::FuncOp with no other + // side effects. + // TODO: when doing some compiler profiling on real apps, it may be worth + // to check it's better to save the CalleeInterface instead of recomputing + // it later when lowering the body. CalleeInterface ctor should be linear + // with the number of arguments, so it is not awful to do it that way for + // now, but the linear coefficient might be non negligible. Until + // measured, stick to the solution that impacts the code less. + Fortran::lower::CalleeInterface{funit, *this}; + } + funit.setActiveEntry(0); + for (auto &f : funit.nestedFunctions) + declareFunction(f); // internal procedure + } + //===--------------------------------------------------------------------===// // AbstractConverter overrides //===--------------------------------------------------------------------===// @@ -1649,7 +1691,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto castTo = builder.createConvert(loc, symTy, fir::getBase(initVal)); builder.create(loc, castTo); - }, linkage); + }, + linkage); } } else { global = builder->createGlobal(loc, genType(var), globalName, linkage); @@ -2124,7 +2167,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { assert(!builder && "expected nullptr"); Fortran::lower::CalleeInterface callee(funit, *this); - mlir::FuncOp func = callee.getFuncOp(); + mlir::FuncOp func = callee.addEntryBlockAndMapArguments(); builder = new Fortran::lower::FirOpBuilder(func, bridge.getKindMap()); assert(builder && "FirOpBuilder did not instantiate"); builder->setInsertionPointToStart(&func.front()); diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index 6d1e8d89e9ceb..539b1939852ad 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -178,15 +178,23 @@ bool Fortran::lower::CalleeInterface::isMainProgram() const { return funit.isMainProgram(); } +mlir::FuncOp Fortran::lower::CalleeInterface::addEntryBlockAndMapArguments() { + // On the callee side, directly map the mlir::value argument of + // the function block to the Fortran symbols. + func.addEntryBlock(); + mapPassedEntities(); + return func; +} + //===----------------------------------------------------------------------===// // CallInterface implementation: this part is common to both caller and caller // sides. //===----------------------------------------------------------------------===// -/// Init drives the different actions to be performed while building a -/// CallInterface, it does not decide anything about the interface. +/// Declare drives the different actions to be performed while analyzing the +/// signature and building/finding the mlir::FuncOp. template -void Fortran::lower::CallInterface::init() { +void Fortran::lower::CallInterface::declare() { if (!side().isMainProgram()) { characteristic = std::make_unique( @@ -212,12 +220,14 @@ void Fortran::lower::CallInterface::init() { Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty); } } +} +/// Once the signature has been analyzed and the mlir::FuncOp was built/found, +/// map the fir inputs to Fortran entities (the symbols or expressions). +template +void Fortran::lower::CallInterface::mapPassedEntities() { // map back fir inputs to passed entities if constexpr (std::is_same_v) { - // On the callee side, directly map the mlir::value argument of - // the function block to the Fortran symbols. - func.addEntryBlock(); assert(inputs.size() == func.front().getArguments().size() && "function previously created with different number of arguments"); for (const auto &pair : llvm::zip(inputs, func.front().getArguments())) diff --git a/flang/test/Lower/dummy-procedure.f90 b/flang/test/Lower/dummy-procedure.f90 index 4af0a743d6f84..a9baa2976756a 100644 --- a/flang/test/Lower/dummy-procedure.f90 +++ b/flang/test/Lower/dummy-procedure.f90 @@ -87,11 +87,6 @@ subroutine test_acos(x) call foo_acos(acos) end subroutine -! CHECK-LABEL: func @fir.acos.f32.ref_f32(%arg0: !fir.ref) -> f32 - !CHECK: %[[load:.*]] = fir.load %arg0 - !CHECK: %[[res:.*]] = call @__fs_acos_1(%[[load]]) : (f32) -> f32 - !CHECK: return %[[res]] : f32 - ! Intrinsic implemented inlined ! CHECK-LABEL: func @_QPtest_aimag subroutine test_aimag() @@ -102,13 +97,6 @@ subroutine test_aimag() call foo_aimag(aimag) end subroutine -!CHECK-LABEL: func @fir.aimag.f32.ref_z4(%arg0: !fir.ref>) - !CHECK: %[[load:.*]] = fir.load %arg0 - !CHECK: %[[cst1:.*]] = constant 1 - !CHECK: %[[imag:.*]] = fir.extract_value %[[load]], %[[cst1]] : (!fir.complex<4>, index) -> f32 - !CHECK: return %[[imag]] : f32 - - ! Character Intrinsic implemented inlined ! CHECK-LABEL: func @_QPtest_len subroutine test_len() @@ -119,10 +107,6 @@ subroutine test_len() call foo_len(len) end subroutine -!CHECK-LABEL: func @fir.len.i32.bc1(%arg0: !fir.boxchar<1>) - !CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) - !CHECK: %[[len:.*]] = fir.convert %[[unboxed]]#1 : (index) -> i32 - !CHECK: return %[[len]] : i32 ! Intrinsic implemented inlined with specific name different from generic ! CHECK-LABEL: func @_QPtest_iabs @@ -150,3 +134,19 @@ subroutine todo3(dummy_proc) intrinsic :: acos procedure(acos) :: dummy_proc end subroutine + +! CHECK-LABEL: func @fir.acos.f32.ref_f32(%arg0: !fir.ref) -> f32 + !CHECK: %[[load:.*]] = fir.load %arg0 + !CHECK: %[[res:.*]] = call @__fs_acos_1(%[[load]]) : (f32) -> f32 + !CHECK: return %[[res]] : f32 + +!CHECK-LABEL: func @fir.aimag.f32.ref_z4(%arg0: !fir.ref>) + !CHECK: %[[load:.*]] = fir.load %arg0 + !CHECK: %[[cst1:.*]] = constant 1 + !CHECK: %[[imag:.*]] = fir.extract_value %[[load]], %[[cst1]] : (!fir.complex<4>, index) -> f32 + !CHECK: return %[[imag]] : f32 + +!CHECK-LABEL: func @fir.len.i32.bc1(%arg0: !fir.boxchar<1>) + !CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) + !CHECK: %[[len:.*]] = fir.convert %[[unboxed]]#1 : (index) -> i32 + !CHECK: return %[[len]] : i32 diff --git a/flang/test/Lower/global-init.f90 b/flang/test/Lower/global-init.f90 index f764a025bfab7..413be85ff1ccb 100644 --- a/flang/test/Lower/global-init.f90 +++ b/flang/test/Lower/global-init.f90 @@ -2,7 +2,6 @@ program bar ! CHECK: fir.address_of(@[[name1:.*]]my_data) -! CHECK: fir.global internal @[[name1]] integer, save :: my_data = 1 print *, my_data contains @@ -10,7 +9,6 @@ program bar ! CHECK-LABEL: func @_QPfoo subroutine foo() ! CHECK: fir.address_of(@[[name2:.*foo.*my_data]]) -! CHECK: fir.global internal @[[name2]] integer, save :: my_data = 2 print *, my_data + 1 end subroutine @@ -18,7 +16,6 @@ subroutine foo() ! CHECK-LABEL: func @_QPfoo2 subroutine foo2() ! CHECK: fir.address_of(@[[name3:.*foo2.*my_data]]) -! CHECK: fir.global internal @[[name3]] integer, save :: my_data my_data = 4 print *, my_data @@ -27,11 +24,8 @@ subroutine foo2() ! CHECK-LABEL: func @_QPfoo3 subroutine foo3() ! CHECK-DAG: fir.address_of(@[[name4:.*foo3.*idata]]){{.*}}fir.array<5xi32> -! CHECK-DAG: fir.global internal @[[name4]]{{.*}}fir.array<5xi32> ! CHECK-DAG: fir.address_of(@[[name5:.*foo3.*rdata]]){{.*}}fir.array<3xf16> -! CHECK-DAG: fir.global internal @[[name5]]{{.*}}fir.array<3xf16> ! CHECK-DAG: fir.address_of(@[[name6:.*foo3.*my_data]]){{.*}}fir.array<2x4xi64> -! CHECK-DAG: fir.global internal @[[name6]]{{.*}}fir.array<2x4xi64> integer*4, dimension(5), save :: idata = (/ (i*i, i=1,5) /) integer*8, dimension(2, 10:13), save :: my_data = reshape((/1,2,3,4,5,6,7,8/), shape(my_data)) real*2, dimension(7:9), save :: rdata = (/100., 99., 98./) @@ -40,3 +34,10 @@ subroutine foo3() print *, my_data(1,11) end subroutine end program + +! CHECK: fir.global internal @[[name1]] +! CHECK: fir.global internal @[[name2]] +! CHECK: fir.global internal @[[name3]] +! CHECK-DAG: fir.global internal @[[name4]]{{.*}}fir.array<5xi32> +! CHECK-DAG: fir.global internal @[[name5]]{{.*}}fir.array<3xf16> +! CHECK-DAG: fir.global internal @[[name6]]{{.*}}fir.array<2x4xi64> diff --git a/flang/test/Lower/program-units-fir-mangling.f90 b/flang/test/Lower/program-units-fir-mangling.f90 index 6d7c08e52e44a..0adf438667035 100644 --- a/flang/test/Lower/program-units-fir-mangling.f90 +++ b/flang/test/Lower/program-units-fir-mangling.f90 @@ -17,7 +17,6 @@ function foo() ! CHECK: } end function -! CHECK-LABEL: fir.global internal @_QFfooEpi : f32 { ! CHECK-LABEL: func @_QPfunctn() -> f32 { function functn @@ -25,7 +24,6 @@ function functn ! CHECK: } end function -! CHECK-LABEL: fir.global internal @_QFfunctnECpi constant : f32 { module testMod contains @@ -126,3 +124,7 @@ module subroutine draw() program test ! CHECK: } end program + +! CHECK-LABEL: fir.global internal @_QFfooEpi : f32 { +! CHECK-LABEL: fir.global internal @_QFfunctnECpi constant : f32 { + diff --git a/flang/test/Lower/stop.f90 b/flang/test/Lower/stop.f90 index 70bab23097a12..3643d8a0e8e2f 100644 --- a/flang/test/Lower/stop.f90 +++ b/flang/test/Lower/stop.f90 @@ -7,7 +7,6 @@ subroutine stop_test(b) ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[false]]) stop end subroutine -! CHECK: func @_Fortran{{.*}}StopStatement(i32, i1, i1) -> none ! CHECK-LABEL stop_code subroutine stop_code() @@ -47,3 +46,5 @@ subroutine stop_error_code_quiet(b) ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c66]], %[[true]], %[[bi1]]) end subroutine + +! CHECK: func @_Fortran{{.*}}StopStatement(i32, i1, i1) -> none From 6f60e419b7f71e7924c99195486026b944f31c5e Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 23 Jul 2020 15:49:47 -0700 Subject: [PATCH 0194/1017] bug #247 -- not fixed yet, but here is the test --- flang/test/Lower/stmt-function.f90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/flang/test/Lower/stmt-function.f90 b/flang/test/Lower/stmt-function.f90 index 4d6f5be4f1d36..47f8c934b6c88 100644 --- a/flang/test/Lower/stmt-function.f90 +++ b/flang/test/Lower/stmt-function.f90 @@ -81,6 +81,7 @@ real function test_stmt_no_args(x, y) end function ! Test statement function with character arguments +! CHECK-LABEL: @_QPtest_stmt_character integer function test_stmt_character(c, j) integer :: i, j, func, argj character(10) :: c, argc @@ -95,3 +96,12 @@ integer function test_stmt_character(c, j) !CHECK: addi %[[len_trim]], %[[j]] test_stmt_character = func(c, j) end function + +! issue #247 +! CHECK-LABEL: @_QPbug247 +subroutine bug247(r) + I(R) = R + ! CHECK: call {{.*}}OutputInteger + PRINT *, I(2.5) + ! CHECK: call {{.*}}EndIo +END subroutine bug247 From 529c1874e208b41c1005c3401ca00f1ee5e06315 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 23 Jul 2020 13:02:52 -0700 Subject: [PATCH 0195/1017] fix for issue #302 --- flang/include/flang/Lower/Support/TypeCode.h | 81 ++++++++++++++++++ flang/lib/Optimizer/CodeGen/CodeGen.cpp | 86 +++++++------------- 2 files changed, 111 insertions(+), 56 deletions(-) create mode 100644 flang/include/flang/Lower/Support/TypeCode.h diff --git a/flang/include/flang/Lower/Support/TypeCode.h b/flang/include/flang/Lower/Support/TypeCode.h new file mode 100644 index 0000000000000..d57657e739294 --- /dev/null +++ b/flang/include/flang/Lower/Support/TypeCode.h @@ -0,0 +1,81 @@ +//===-- Lower/Support/TypeCode.h --------------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#ifndef LOWER_SUPPORT_TYPECODE_H +#define LOWER_SUPPORT_TYPECODE_H + +#include "flang/ISO_Fortran_binding.h" +#include "llvm/Support/ErrorHandling.h" + +namespace fir { + +//===----------------------------------------------------------------------===// +// Translations of category and bitwidths to the type codes defined in flang's +// ISO_Fortran_binding.h. +//===----------------------------------------------------------------------===// + +inline int characterBitsToTypeCode(unsigned bits) { + // clang-format off + switch (bits) { + case 8: return CFI_type_char; + case 16: return CFI_type_char16_t; + case 32: return CFI_type_char32_t; + default: llvm_unreachable("unsupported character size"); + } + // clang-format on +} + +inline int complexBitsToTypeCode(unsigned bits) { + // clang-format off + switch (bits) { + case 32: return CFI_type_float_Complex; + case 64: return CFI_type_double_Complex; + case 80: + case 128: return CFI_type_long_double_Complex; + default: llvm_unreachable("unsupported complex size"); + } + // clang-format on +} + +inline int integerBitsToTypeCode(unsigned bits) { + // clang-format off + switch (bits) { + case 8: return CFI_type_int8_t; + case 16: return CFI_type_int16_t; + case 32: return CFI_type_int32_t; + case 64: return CFI_type_int64_t; + case 128: return CFI_type_int128_t; + default: llvm_unreachable("unsupported integer size"); + } + // clang-format on +} + +// FIXME: LOGICAL has no type codes defined; using integer for now +inline int logicalBitsToTypeCode(unsigned bits) { + llvm_unreachable("logical type has no direct support; use integer"); +} + +inline int realBitsToTypeCode(unsigned bits) { + // clang-format off + switch (bits) { + case 32: return CFI_type_float; + case 64: return CFI_type_double; + case 80: + case 128: return CFI_type_long_double; + default: llvm_unreachable("unsupported real size"); + } + // clang-format on +} + +} // namespace fir + +#endif // LOWER_SUPPORT_TYPECODE_H diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index cde3caf24acf4..bf592df07cc65 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -12,6 +12,7 @@ #include "flang/Optimizer/CodeGen/CodeGen.h" #include "DescriptorModel.h" +#include "flang/Lower/Support/TypeCode.h" #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" @@ -1228,66 +1229,26 @@ struct EmboxCommonConversion : public FIROpConversion { mlir::Type boxEleTy) const { auto doInteger = [&](unsigned width) -> std::tuple { - int typeCode; - switch (width) { - case 8: - typeCode = CFI_type_int8_t; - break; - case 16: - typeCode = CFI_type_int16_t; - break; - case 32: - typeCode = CFI_type_int32_t; - break; - case 64: - typeCode = CFI_type_int64_t; - break; - case 128: - typeCode = CFI_type_int128_t; - break; - default: - llvm_unreachable("unsupported integer size"); - } + int typeCode = fir::integerBitsToTypeCode(width); return {this->genConstantOffset(loc, rewriter, width / 8), this->genConstantOffset(loc, rewriter, typeCode)}; }; auto doFloat = [&](unsigned width) -> std::tuple { - int typeCode; - switch (width) { - case 32: - typeCode = CFI_type_float; - break; - case 64: - typeCode = CFI_type_double; - break; - case 80: - case 128: - typeCode = CFI_type_long_double; - break; - default: - llvm_unreachable("unsupported real size"); - } + int typeCode = fir::realBitsToTypeCode(width); return {this->genConstantOffset(loc, rewriter, width / 8), this->genConstantOffset(loc, rewriter, typeCode)}; }; auto doComplex = [&](unsigned width) -> std::tuple { - int typeCode; - switch (width) { - case 32: - typeCode = CFI_type_float_Complex; - break; - case 64: - typeCode = CFI_type_double_Complex; - break; - case 80: - case 128: - typeCode = CFI_type_long_double_Complex; - break; - default: - llvm_unreachable("unsupported complex size"); - } - return {this->genConstantOffset(loc, rewriter, width / 4), + auto typeCode = fir::complexBitsToTypeCode(width); + return {this->genConstantOffset(loc, rewriter, width / 8 * 2), + this->genConstantOffset(loc, rewriter, typeCode)}; + }; + auto doCharacter = + [&](unsigned width, + int64_t len) -> std::tuple { + auto typeCode = fir::characterBitsToTypeCode(width); + return {this->genConstantOffset(loc, rewriter, len), this->genConstantOffset(loc, rewriter, typeCode)}; }; auto getKindMap = [&]() -> fir::KindMapping & { @@ -1313,13 +1274,26 @@ struct EmboxCommonConversion : public FIROpConversion { auto ty = boxEleTy.cast(); return doComplex(getKindMap().getRealBitsize(ty.getFKind())); } - if (auto ty = boxEleTy.dyn_cast()) { - TODO(); - } - if (auto ty = boxEleTy.dyn_cast()) + if (auto ty = boxEleTy.dyn_cast()) + return doCharacter(getKindMap().getCharacterBitsize(ty.getFKind()), + ty.getLen()); + if (auto ty = boxEleTy.dyn_cast()) { + // TODO: doesn't the runtime need to know these are LOGICAL? Pretend they + // are INTEGER for now. return doInteger(getKindMap().getLogicalBitsize(ty.getFKind())); - if (auto seqTy = boxEleTy.dyn_cast()) + } + if (auto seqTy = boxEleTy.dyn_cast()) { + if (auto charTy = seqTy.getEleTy().dyn_cast()) { + // TODO: assumes the row is the length of the CHARACTER. This is true by + // construction, but it may not hold after optimizations have run. + auto rowSize = seqTy.getShape()[0]; + assert(rowSize != fir::SequenceType::getUnknownExtent()); + auto strTy = fir::CharacterType::get(rewriter.getContext(), + charTy.getFKind(), rowSize); + return getSizeAndTypeCode(loc, rewriter, strTy); + } return getSizeAndTypeCode(loc, rewriter, seqTy.getEleTy()); + } if (boxEleTy.isa()) { TODO(); } From 44537e65b1630d80d7836f51a0c5bfafa5fac546 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Fri, 24 Jul 2020 02:59:32 -0700 Subject: [PATCH 0196/1017] Workaround mlir conversion materialization (D82831) Simply add a source and target materialization handler that do nothing and that override the default handlers that would add illegal `LLVM::DialectCastOp` otherwise. This is the simplest workaround, but not an actual fix, something may be wrong with D82831 (most likely fir lowering to llvm happens in a way that mlir infrastructure is not expecting in D82831). --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index bf592df07cc65..c5a2403edf4db 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -126,6 +126,30 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { addConversion([&](mlir::NoneType none) { return mlir::LLVM::LLVMType::getStructTy(llvmDialect, {}); }); + + // FIXME: https://reviews.llvm.org/D82831 introduced an automatic + // materliazation of conversion around function calls that is not working + // well with fir lowering to llvm (incorrect llvm.mlir.cast are inserted). + // Workaround until better analysis: register a handler that does not insert + // any conversions. + addSourceMaterialization( + [&](mlir::OpBuilder &builder, mlir::Type resultType, + mlir::ValueRange inputs, + mlir::Location loc) -> llvm::Optional { + if (inputs.size() != 1) + return llvm::None; + return inputs[0]; + }); + // Similar FIXME workaround here (needed for compare.fir/select-type.fir + // tests). + addTargetMaterialization( + [&](mlir::OpBuilder &builder, mlir::Type resultType, + mlir::ValueRange inputs, + mlir::Location loc) -> llvm::Optional { + if (inputs.size() != 1) + return llvm::None; + return inputs[0]; + }); } // This returns the type of a single column. Rows are added by the caller. From 5a23a354e2cb45d879e42bbedbcad83771f15c83 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Fri, 24 Jul 2020 09:49:53 -0700 Subject: [PATCH 0197/1017] Passing pointer to functions not defined in the program unit Add an interface to CallInterface.h to delcareFunction from a ProcedureDesignator. This allow creating mlir::FuncOp when lowering indirection to the ProcedureDesignator if this function was never seen before. On call sites, add a way to handle argument number mismatch. This is now needed to handle cases where a procedure is first pass with no type information (the created mlir::FuncOp has no arguments), and a call to it is later lowered with arguments. This is dealt with by introducing a function type cast on the the calling site. This is not ideal, but the alternative that would be to analyze all call site before lowering anything requires more expensive analysis. If the front-end does this at some point to provide error messages regarding incompatibles calls, we would take advantage of this. --- flang/include/flang/Lower/CallInterface.h | 11 ++ flang/lib/Lower/CallInterface.cpp | 24 +++ flang/lib/Lower/ConvertExpr.cpp | 39 +++-- flang/test/Lower/procedure-declarations.f90 | 169 ++++++++++++++++++++ 4 files changed, 231 insertions(+), 12 deletions(-) create mode 100644 flang/test/Lower/procedure-declarations.f90 diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index 19997891003ff..2e095a61f4916 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -290,6 +290,17 @@ mlir::FunctionType translateSignature(const Fortran::evaluate::ProcedureDesignator &, Fortran::lower::AbstractConverter &); +/// Declare or find the mlir::FuncOp named \p name. If the mlir::FuncOp does +/// not exist yet, declare it with the signature translated from the +/// ProcedureDesignator argument. +/// Due to Fortran implicit function typing rules, the returned FuncOp is not +/// guaranteed to have the signature from ProcedureDesignator if the FuncOp was +/// already declared. +mlir::FuncOp +getOrDeclareFunction(llvm::StringRef name, + const Fortran::evaluate::ProcedureDesignator &, + Fortran::lower::AbstractConverter &); + } // namespace Fortran::lower #endif // FORTRAN_LOWER_FIRBUILDER_H diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index 539b1939852ad..ebb01f078e236 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -597,3 +597,27 @@ mlir::FunctionType Fortran::lower::translateSignature( return SignatureBuilder{characteristics.value(), converter, forceImplicit} .getFunctionType(); } + +mlir::FuncOp Fortran::lower::getOrDeclareFunction( + llvm::StringRef name, const Fortran::evaluate::ProcedureDesignator &proc, + Fortran::lower::AbstractConverter &converter) { + auto module = converter.getModuleOp(); + mlir::FuncOp func = + Fortran::lower::FirOpBuilder::getNamedFunction(module, name); + if (func) + return func; + + const auto *symbol = proc.GetSymbol(); + assert(symbol && "non user function in getOrDeclareFunction"); + // getOrDeclareFunction is only used for functions not defined in the current + // program unit, so use the location of the procedure designator symbol, which + // is the first occurrence of the procedure in the program unit. + auto loc = converter.genLocation(symbol->name()); + auto characteristics = + Fortran::evaluate::characteristics::Procedure::Characterize( + proc, converter.getFoldingContext().intrinsics()); + auto ty = SignatureBuilder{characteristics.value(), converter, + /* forceImplicit */ false} + .getFunctionType(); + return Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty); +} diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 95771c2abffe7..606be35a68bab 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -339,6 +339,9 @@ class ExprLowering { fir::ExtendedValue genval(const Fortran::evaluate::BOZLiteralConstant &) { TODO(); } + /// Return indirection to function designated in ProcedureDesignator. + /// The type of the function indirection is not guaranteed to match the one + /// of the ProcedureDesignator due to Fortran implicit typing rules. fir::ExtendedValue genval(const Fortran::evaluate::ProcedureDesignator &proc) { if (const auto *intrinsic = proc.GetSpecificIntrinsic()) { @@ -364,12 +367,7 @@ class ExprLowering { return val; } auto name = converter.mangleName(*symbol); - auto func = builder.getNamedFunction(name); - // TODO: If this is an external not called/defined in this file - // (e.g, it is just being passed as a dummy procedure argument) - // we need to create a funcOp for it with the interface we have. - if (!func) - TODO(); + auto func = Fortran::lower::getOrDeclareFunction(name, proc, converter); mlir::Value funcPtr = builder.create( getLoc(), func.getType(), builder.getSymbolRefAttr(name)); return funcPtr; @@ -737,7 +735,8 @@ class ExprLowering { [&](Fortran::lower::FirOpBuilder &builder) { auto str = consLit(); builder.create(getLoc(), str); - }, builder.createLinkOnceLinkage()); + }, + builder.createLinkOnceLinkage()); auto addr = builder.create(getLoc(), global.resultType(), global.getSymbol()); auto lenp = builder.createIntegerConstant( @@ -1361,6 +1360,13 @@ class ExprLowering { } } + // In older Fortran, procedure argument types are inferred. This may lead + // different view of what the function signature is in different locations. + // Casts are inserted as needed below to acomodate this. + + // The mlir::FuncOp type prevails, unless it has a different number of + // arguments which can happen in legal program if it was passed as a dummy + // procedure argument earlier with no further type information. mlir::Value funcPointer; mlir::SymbolRefAttr funcSymbolAttr; if (const auto *sym = caller.getIfIndirectCallSymbol()) { @@ -1368,9 +1374,18 @@ class ExprLowering { assert(funcPointer && "dummy procedure or procedure pointer not in symbol map"); } else { - funcSymbolAttr = builder.getSymbolRefAttr(caller.getMangledName()); + auto funcOpType = caller.getFuncOp().getType(); + auto callSiteType = caller.genFunctionType(); + // Deal with argument number mismatch by making a function pointer so that + // function type cast can be inserted. + auto symbolAttr = builder.getSymbolRefAttr(caller.getMangledName()); + if (callSiteType.getNumResults() != funcOpType.getNumResults() || + callSiteType.getNumInputs() != funcOpType.getNumInputs()) + funcPointer = + builder.create(getLoc(), funcOpType, symbolAttr); + else + funcSymbolAttr = symbolAttr; } - auto funcType = funcPointer ? caller.genFunctionType() : caller.getFuncOp().getType(); llvm::SmallVector operands; @@ -1381,9 +1396,9 @@ class ExprLowering { if (funcPointer) operands.push_back( builder.createConvert(getLoc(), funcType, funcPointer)); - // In older Fortran, procedure argument types are inferenced. Deal with - // the potential mismatches by adding casts to the arguments when the - // inferenced types do not match exactly. + + // Deal with potential mismatches in arguments types. Passing an array to + // a scalar argument should for instance be tolerated here. for (const auto &op : llvm::zip(caller.getInputs(), funcType.getInputs())) { auto cast = builder.convertWithSemantics(getLoc(), std::get<1>(op), std::get<0>(op)); diff --git a/flang/test/Lower/procedure-declarations.f90 b/flang/test/Lower/procedure-declarations.f90 new file mode 100644 index 0000000000000..164db03adff93 --- /dev/null +++ b/flang/test/Lower/procedure-declarations.f90 @@ -0,0 +1,169 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test procedure declarations. Change appearance order of definition and usages +! (passing a procedure and calling it), with and without definitions. +! Check that the definition type prevail if available and that casts are inserted to +! accommodate for the signature mismatch in the different location due to implicit +! typing rules and Fortran loose interface compatibility rule history. + + +! Note: all the cases where their is a definition are exactly the same, +! since definition should be processed first regardless. + +! pass, call, define +! CHECK-LABEL: func @_QPpass_foo() { +subroutine pass_foo() + external :: foo + ! CHECK: %[[f:.*]] = constant @_QPfoo + ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) + call bar(foo) +end subroutine +! CHECK-LABEL: func @_QPcall_foo(%arg0: !fir.ref>) { +subroutine call_foo(i) + integer :: i(10) + ! %[[argconvert:*]] = fir.convert %arg0 : + ! fir.call @_QPfoo(%[[argconvert]]) : (!fir.ref>) -> () + call foo(i) +end subroutine +! CHECK-LABEL: func @_QPfoo(%arg0: !fir.ref>) { +subroutine foo(i) + integer :: i(2, 5) + call do_something(i) +end subroutine + +! call, pass, define +! CHECK-LABEL: func @_QPcall_foo2(%arg0: !fir.ref>) { +subroutine call_foo2(i) + integer :: i(10) + ! %[[argconvert:*]] = fir.convert %arg0 : + ! fir.call @_QPfoo2(%[[argconvert]]) : (!fir.ref>) -> () + call foo2(i) +end subroutine +! CHECK-LABEL: func @_QPpass_foo2() { +subroutine pass_foo2() + external :: foo2 + ! CHECK: %[[f:.*]] = constant @_QPfoo2 + ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) + call bar(foo2) +end subroutine +! CHECK-LABEL: func @_QPfoo2(%arg0: !fir.ref>) { +subroutine foo2(i) + integer :: i(2, 5) + call do_something(i) +end subroutine + +! call, define, pass +! CHECK-LABEL: func @_QPcall_foo3(%arg0: !fir.ref>) { +subroutine call_foo3(i) + integer :: i(10) + ! %[[argconvert:*]] = fir.convert %arg0 : + ! fir.call @_QPfoo3(%[[argconvert]]) : (!fir.ref>) -> () + call foo3(i) +end subroutine +! CHECK-LABEL: func @_QPfoo3(%arg0: !fir.ref>) { +subroutine foo3(i) + integer :: i(2, 5) + call do_something(i) +end subroutine +! CHECK-LABEL: func @_QPpass_foo3() { +subroutine pass_foo3() + external :: foo3 + ! CHECK: %[[f:.*]] = constant @_QPfoo3 + ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) + call bar(foo3) +end subroutine + +! define, call, pass +! CHECK-LABEL: func @_QPfoo4(%arg0: !fir.ref>) { +subroutine foo4(i) + integer :: i(2, 5) + call do_something(i) +end subroutine +! CHECK-LABEL: func @_QPcall_foo4(%arg0: !fir.ref>) { +subroutine call_foo4(i) + integer :: i(10) + ! %[[argconvert:*]] = fir.convert %arg0 : + ! fir.call @_QPfoo4(%[[argconvert]]) : (!fir.ref>) -> () + call foo4(i) +end subroutine +! CHECK-LABEL: func @_QPpass_foo4() { +subroutine pass_foo4() + external :: foo4 + ! CHECK: %[[f:.*]] = constant @_QPfoo4 + ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) + call bar(foo4) +end subroutine + +! define, pass, call +! CHECK-LABEL: func @_QPfoo5(%arg0: !fir.ref>) { +subroutine foo5(i) + integer :: i(2, 5) + call do_something(i) +end subroutine +! CHECK-LABEL: func @_QPpass_foo5() { +subroutine pass_foo5() + external :: foo5 + ! CHECK: %[[f:.*]] = constant @_QPfoo5 + ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) + call bar(foo5) +end subroutine +! CHECK-LABEL: func @_QPcall_foo5(%arg0: !fir.ref>) { +subroutine call_foo5(i) + integer :: i(10) + ! %[[argconvert:*]] = fir.convert %arg0 : + ! fir.call @_QPfoo5(%[[argconvert]]) : (!fir.ref>) -> () + call foo5(i) +end subroutine + + +! Test when there is no definition (declaration at the end of the mlir module) +! First use gives the function type + +! call, pass +! CHECK-LABEL: func @_QPcall_foo6(%arg0: !fir.ref>) { +subroutine call_foo6(i) + integer :: i(10) + ! CHECK-NOT: convert + call foo6(i) +end subroutine +! CHECK-LABEL: func @_QPpass_foo6() { +subroutine pass_foo6() + external :: foo6 + ! CHECK: %[[f:.*]] = constant @_QPfoo6 : (!fir.ref>) -> () + ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) + call bar(foo6) +end subroutine + +! pass, call +! CHECK-LABEL: func @_QPpass_foo7() { +subroutine pass_foo7() + external :: foo7 + ! CHECK-NOT: convert + call bar(foo7) +end subroutine +! CHECK-LABEL: func @_QPcall_foo7(%arg0: !fir.ref>) -> f32 { +function call_foo7(i) + integer :: i(10) + ! CHECK: %[[f:.*]] = constant @_QPfoo7 : () -> () + ! CHECK: %[[funccast:.*]] = fir.convert %[[f]] : (() -> ()) -> ((!fir.ref>) -> f32) + ! CHECK: fir.call %[[funccast]](%arg0) : (!fir.ref>) -> f32 + call_foo7 = foo7(i) +end function + + +! call, call with different type +! CHECK-LABEL: func @_QPcall_foo8(%arg0: !fir.ref>) { +subroutine call_foo8(i) + integer :: i(10) + ! CHECK-NOT: convert + call foo8(i) +end subroutine +! CHECK-LABEL: func @_QPcall_foo8_2(%arg0: !fir.ref>) { +subroutine call_foo8_2(i) + integer :: i(2, 5) + ! %[[argconvert:*]] = fir.convert %arg0 : + call foo8(i) +end subroutine + +! CHECK: func @_QPfoo6(!fir.ref>) +! CHECK: func @_QPfoo7() From 167d59406521ea98ea824906181e84c4766d1d68 Mon Sep 17 00:00:00 2001 From: rajan Date: Mon, 27 Jul 2020 09:13:18 -0400 Subject: [PATCH 0198/1017] converting temporary memrefs from affine optimizations to fir arrays (#316) --- .../Optimizer/Transforms/AffineDemotion.cpp | 20 +++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/flang/lib/Optimizer/Transforms/AffineDemotion.cpp b/flang/lib/Optimizer/Transforms/AffineDemotion.cpp index 1eb3d7c18721e..77e356a0911a9 100644 --- a/flang/lib/Optimizer/Transforms/AffineDemotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffineDemotion.cpp @@ -86,6 +86,24 @@ class ConvertConversion : public mlir::OpRewritePattern { } }; +mlir::Type convertMemRef(mlir::MemRefType type) { + return fir::SequenceType::get( + SmallVector(type.getShape().begin(), type.getShape().end()), + type.getElementType()); +} + +class StdAllocConversion : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + mlir::LogicalResult + matchAndRewrite(mlir::AllocOp op, + mlir::PatternRewriter &rewriter) const override { + rewriter.replaceOpWithNewOp(op, convertMemRef(op.getType()), + op.value()); + return success(); + } +}; + class AffineDialectDemotion : public AffineDialectDemotionBase { public: @@ -99,7 +117,9 @@ class AffineDialectDemotion patterns.insert(context); patterns.insert(context); patterns.insert(context); + patterns.insert(context); mlir::ConversionTarget target = *context; + target.addIllegalOp(); target.addDynamicallyLegalOp([](fir::ConvertOp op) { if (op.res().getType().isa()) return false; From b8478948e2529228ae849327018b9776907deaab Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 23 Jul 2020 18:45:27 -0700 Subject: [PATCH 0199/1017] Draft implementation for BLOCK DATA support. This will lower BLOCK DATA program units that initialize global variables, such as those placed into COMMON blocks. Some refactoring was done to start to consolidate the various and disparate code that instantiates data. More cleanup is TODO. --- flang/include/flang/Lower/PFTBuilder.h | 12 ++- flang/lib/Lower/Bridge.cpp | 120 ++++++++++++++----------- flang/lib/Lower/PFTBuilder.cpp | 17 +++- 3 files changed, 90 insertions(+), 59 deletions(-) diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 0e8ebf2892f57..19e17e94337a1 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -65,7 +65,7 @@ class ReferenceVariantBase { template constexpr BaseType &get() const { - return std::get> > (u).get(); + return std::get>> (u).get(); } template constexpr BaseType *getIf() const { @@ -544,11 +544,17 @@ struct ModuleLikeUnit : public ProgramUnit { std::list nestedFunctions; }; +/// Block data units contain the variables and data initializers for common +/// blocks, etc. struct BlockDataUnit : public ProgramUnit { - BlockDataUnit(const parser::BlockData &bd, - const ParentVariant &parentVariant); + BlockDataUnit(const parser::BlockData &bd, const ParentVariant &parentVariant, + const Fortran::semantics::SemanticsContext &semanticsContext); BlockDataUnit(BlockDataUnit &&) = default; BlockDataUnit(const BlockDataUnit &) = delete; + + LLVM_DUMP_METHOD void dump() const; + + const Fortran::semantics::Scope &symTab; // symbol table }; /// A Program is the top-level root of the PFT. diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 734c87bf17162..fe955e3101870 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -270,10 +270,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::common::visitors{ [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); }, [&](Fortran::lower::pft::ModuleLikeUnit &m) { lowerMod(m); }, - [&](Fortran::lower::pft::BlockDataUnit &) { - mlir::emitError(toLocation(), "BLOCK DATA not handled"); - exit(1); - }, + [&](Fortran::lower::pft::BlockDataUnit &b) { lowerBlockData(b); }, }, u); } @@ -1645,7 +1642,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// Instantiate a global variable. If it hasn't already been processed, add /// the global to the ModuleOp as a new uniqued symbol and initialize it with /// the correct value. It will be referenced on demand using `fir.addr_of`. - void instantiateGlobal(const Fortran::lower::pft::Variable &var) { + void instantiateGlobal(const Fortran::lower::pft::Variable &var, + llvm::DenseMap &storeMap) { const auto &sym = var.getSymbol(); auto globalName = mangleName(sym); bool isConst = sym.attrs().test(Fortran::semantics::Attr::PARAMETER); @@ -1699,39 +1697,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { } auto addrOf = builder->create(loc, global.resultType(), global.getSymbol()); - SymbolBoxAnalyzer sba(sym); - sba.analyze(); - if (sba.isTrivial()) { - addSymbol(sym, addrOf); - return; - } - mlir::Value len; - if (sba.isChar) { - auto c = sba.getCharLenConst(); - assert(c.hasValue()); - len = builder->createIntegerConstant(loc, idxTy, *c); - } - llvm::SmallVector extents; - llvm::SmallVector lbounds; - if (sba.isArray) { - assert(sba.staticSize); - for (auto i : sba.staticShape) - extents.push_back(builder->createIntegerConstant(loc, idxTy, i)); - if (!sba.lboundIsAllOnes()) - for (auto i : sba.staticLBound) - lbounds.push_back(builder->createIntegerConstant(loc, idxTy, i)); - } - if (sba.isChar && sba.isArray) { - localSymbols.addCharSymbolWithBounds(sym, addrOf, len, extents, - lbounds); - } else if (sba.isChar) { - localSymbols.addCharSymbol(sym, addrOf, len); - } else { - assert(sba.isArray); - localSymbols.addSymbolWithBounds(sym, addrOf, extents, lbounds); - } + mapSymbolAttributes(var, storeMap, addrOf); } else if (const auto *details = sym.detailsIf()) { + //===----------------------------------------------------------------===// + // COMMON blocks + //===----------------------------------------------------------------===// const int64_t sz = static_cast(sym.size()); bool hasInit = [&]() { for (const auto &obj : details->objects()) @@ -1763,8 +1734,21 @@ class FirConverter : public Fortran::lower::AbstractConverter { // the build machine. mlir::Type commonTy = [&]() { llvm::SmallVector members; - for (const auto &obj : details->objects()) - members.push_back(genType(*obj)); + for (const auto &obj : details->objects()) { + auto memTy = genType(*obj); + if (memTy.isa()) { + auto paramVal = obj->GetType()->characterTypeSpec().length(); + auto expr = paramVal.GetExplicit(); + assert(expr); + auto eval = Fortran::evaluate::AsGenericExpr(std::move(*expr)); + auto lenVal = Fortran::evaluate::ToInt64(eval); + assert(lenVal); + fir::SequenceType::Shape len; + len.push_back(*lenVal); + memTy = fir::SequenceType::get(len, memTy); + } + members.push_back(memTy); + } return mlir::TupleType::get(members, builder->getContext()); }(); auto linkage = builder->createLinkOnceLinkage(); @@ -1780,10 +1764,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (const auto *objDet = obj->detailsIf()) if (objDet->init()) { - auto initVal = genExprValue(objDet->init().value()); + auto initVal = genInitializerExprValue(objDet->init().value()); auto off = builder.createIntegerConstant(loc, idxTy, offset++); - cb = builder.create(loc, commonTy, cb, - initVal, off); + cb = builder.create( + loc, commonTy, cb, fir::getBase(initVal), off); } } builder.create(loc, cb); @@ -1804,10 +1788,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// constructed. mlir::Value createNewLocal(mlir::Location loc, const Fortran::lower::pft::Variable &var, - mlir::Value *preAlloc, + mlir::Value preAlloc, llvm::ArrayRef shape = {}) { if (preAlloc) - return *preAlloc; + return preAlloc; auto nm = var.getSymbol().name().ToString(); auto ty = genType(var); if (shape.size()) @@ -1855,9 +1839,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// such that if it's properties depend on other variables, the variables upon /// which its properties depend will already have been visited. void instantiateLocal(const Fortran::lower::pft::Variable &var, - llvm::DenseMap &storeMap, - mlir::Value *preAlloc = nullptr) { - mlir::Value result; + llvm::DenseMap &storeMap) { + mlir::Value preAlloc; const auto &sym = var.getSymbol(); const auto loc = genLocation(sym.name()); auto idxTy = builder->getIndexType(); @@ -1882,10 +1865,18 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::SmallVector offs{builder->createIntegerConstant( loc, idxTy, sym.offset() - aliasOffset)}; auto ptr = builder->create(loc, i8Ptr, base, offs); - result = + preAlloc = builder->createConvert(loc, builder->getRefType(genType(sym)), ptr); - preAlloc = &result; } + mapSymbolAttributes(var, storeMap, preAlloc); + } + + void mapSymbolAttributes(const Fortran::lower::pft::Variable &var, + llvm::DenseMap &storeMap, + mlir::Value preAlloc) { + const auto &sym = var.getSymbol(); + const auto loc = genLocation(sym.name()); + auto idxTy = builder->getIndexType(); const auto isDummy = Fortran::semantics::IsDummy(sym); const auto isResult = Fortran::semantics::IsFunctionResult(sym); Fortran::lower::CharacterExprHelper charHelp{*builder, loc}; @@ -2071,8 +2062,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { assert(!mustBeDummy); auto charTy = genType(var); auto c = sba.getCharLenConst(); - mlir::Value local = c ? charHelp.createCharacterTemp(charTy, *c) - : charHelp.createCharacterTemp(charTy, len); + // Note: `len` is the mlir ConstantOp with value `c`, if `c` is an int. + mlir::Value local = preAlloc + ? preAlloc + : (c ? charHelp.createCharacterTemp(charTy, *c) + : charHelp.createCharacterTemp(charTy, len)); addCharSymbol(sym, local, len); return; } @@ -2093,7 +2087,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto commonName = mangleName(common); auto global = builder->getNamedGlobal(commonName); if (!global) - instantiateGlobal(Fortran::lower::pft::Variable{common, true}); + instantiateGlobal(Fortran::lower::pft::Variable{common, true}, storeMap); auto commonAddr = lookupSymbol(common); const auto &varSym = var.getSymbol(); auto loc = genLocation(varSym.name()); @@ -2112,7 +2106,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto varAddr = builder->create(loc, i8Ptr, base, offs); auto localTy = builder->getRefType(genType(var)); mlir::Value local = builder->createConvert(loc, localTy, varAddr); - instantiateLocal(var, storeMap, &local); + mapSymbolAttributes(var, storeMap, local); } void instantiateVar(const Fortran::lower::pft::Variable &var, @@ -2123,7 +2117,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) instantiateCommon(*common, var, storeMap); else if (var.isGlobal()) - instantiateGlobal(var); + instantiateGlobal(var, storeMap); else instantiateLocal(var, storeMap); } @@ -2292,6 +2286,26 @@ class FirConverter : public Fortran::lower::AbstractConverter { localSymbols.clear(); } + /// Instantiate the data from a BLOCK DATA unit. + void lowerBlockData(Fortran::lower::pft::BlockDataUnit &bdunit) { + // FIXME: get rid of the bogus function context and instantiate the globals + // directly into the module. + auto *context = &getMLIRContext(); + auto func = Fortran::lower::FirOpBuilder::createFunction( + mlir::UnknownLoc::get(context), getModuleOp(), + uniquer.doGenerated("Sham"), + mlir::FunctionType::get(llvm::None, llvm::None, context)); + builder = new Fortran::lower::FirOpBuilder(func, bridge.getKindMap()); + llvm::DenseMap fakeMap; + for (const auto &[_, sym] : bdunit.symTab) { + Fortran::lower::pft::Variable var(*sym, true); + instantiateVar(var, fakeMap); + } + func.erase(); + delete builder; + builder = nullptr; + } + /// Lower a procedure (nest). void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) { for (int entryIndex = 0, last = funit.entryPointList.size(); diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 248e7f0cc7068..8e6474e3f5888 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -121,7 +121,8 @@ class PFTBuilder { // Block data bool Pre(const parser::BlockData &node) { - addUnit(lower::pft::BlockDataUnit{node, parentVariantStack.back()}); + addUnit(lower::pft::BlockDataUnit{node, parentVariantStack.back(), + semanticsContext}); return false; } @@ -1266,8 +1267,12 @@ Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit( endStmt{getModuleStmt(m)} {} Fortran::lower::pft::BlockDataUnit::BlockDataUnit( - const parser::BlockData &bd, const lower::pft::ParentVariant &parent) - : ProgramUnit{bd, parent} {} + const parser::BlockData &bd, const lower::pft::ParentVariant &parent, + const semantics::SemanticsContext &semanticsContext) + : ProgramUnit{bd, parent}, + symTab{semanticsContext.FindScope( + std::get>(bd.t).source)} { +} std::unique_ptr Fortran::lower::createPFT(const parser::Program &root, @@ -1298,6 +1303,7 @@ void Fortran::lower::pft::Variable::dump() const { << std::get<1>(*store) << "]:"; else llvm_unreachable("not a Variable"); + llvm::errs() << " depth: " << depth; if (global) llvm::errs() << ", global"; @@ -1319,3 +1325,8 @@ void Fortran::lower::pft::FunctionLikeUnit::dump() const { void Fortran::lower::pft::ModuleLikeUnit::dump() const { PFTDumper{}.dumpModuleLikeUnit(llvm::errs(), *this); } + +/// The BlockDataUnit dump is just the associated symbol table. +void Fortran::lower::pft::BlockDataUnit::dump() const { + llvm::errs() << "block data {\n" << symTab << "\n}\n"; +} From cf4b86db040022e41e974bdcb9075ff745a8f73c Mon Sep 17 00:00:00 2001 From: zacharyselk Date: Wed, 22 Jul 2020 20:59:38 -0600 Subject: [PATCH 0200/1017] Added support for variable label format statments Refactoring --- flang/include/flang/Lower/AbstractConverter.h | 7 ++++ flang/include/flang/Lower/IO.h | 22 +++-------- flang/include/flang/Lower/PFTBuilder.h | 5 +-- flang/include/flang/Lower/Utils.h | 30 ++++++++++++++ flang/lib/Lower/Bridge.cpp | 31 ++++++++++----- flang/test/Lower/format.f90 | 39 +++++++++++++++++++ 6 files changed, 104 insertions(+), 30 deletions(-) create mode 100644 flang/test/Lower/format.f90 diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h index 4effec70b9f68..bb1aa0d5a3d2a 100644 --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -14,6 +14,7 @@ #define FORTRAN_LOWER_ABSTRACTCONVERTER_H #include "flang/Common/Fortran.h" +#include "flang/Lower/Utils.h" #include "mlir/IR/BuiltinOps.h" namespace Fortran { @@ -61,6 +62,12 @@ class AbstractConverter { /// Get the mlir instance of a symbol. virtual mlir::Value getSymbolAddress(SymbolRef sym) = 0; + /// Get the label set associated with a symbol. + virtual bool lookupLabelSet(SymbolRef sym, pft::LabelSet &labelSet) = 0; + + /// Get the code defined by a label + virtual Fortran::lower::pft::Evaluation *lookupLabel(pft::Label label) = 0; + //===--------------------------------------------------------------------===// // Expressions //===--------------------------------------------------------------------===// diff --git a/flang/include/flang/Lower/IO.h b/flang/include/flang/Lower/IO.h index 69908511525dc..6c1da0bd9ab76 100644 --- a/flang/include/flang/Lower/IO.h +++ b/flang/include/flang/Lower/IO.h @@ -17,6 +17,8 @@ #include "flang/Semantics/symbol.h" #include "llvm/ADT/DenseMap.h" #include "llvm/ADT/SmallSet.h" +#include "SymbolMap.h" +#include "Utils.h" namespace mlir { class Value; @@ -43,14 +45,6 @@ namespace lower { class AbstractConverter; class BridgeImpl; -namespace pft { -struct Evaluation; -using LabelEvalMap = llvm::DenseMap; -using SymbolRef = Fortran::common::Reference; -using LabelSet = llvm::SmallSet; -using SymbolLabelMap = llvm::DenseMap; -} // namespace pft - /// Generate IO call(s) for BACKSPACE; return the IOSTAT code mlir::Value genBackspaceStatement(AbstractConverter &, const parser::BackspaceStmt &); @@ -74,15 +68,11 @@ mlir::Value genOpenStatement(AbstractConverter &, const parser::OpenStmt &); /// Generate IO call(s) for PRINT void genPrintStatement(AbstractConverter &converter, - const parser::PrintStmt &stmt, - pft::LabelEvalMap &labelMap, - pft::SymbolLabelMap &assignMap); + const parser::PrintStmt &stmt); /// Generate IO call(s) for READ; return the IOSTAT code mlir::Value genReadStatement(AbstractConverter &converter, - const parser::ReadStmt &stmt, - pft::LabelEvalMap &labelMap, - pft::SymbolLabelMap &assignMap); + const parser::ReadStmt &stmt); /// Generate IO call(s) for REWIND; return the IOSTAT code mlir::Value genRewindStatement(AbstractConverter &, const parser::RewindStmt &); @@ -92,9 +82,7 @@ mlir::Value genWaitStatement(AbstractConverter &, const parser::WaitStmt &); /// Generate IO call(s) for WRITE; return the IOSTAT code mlir::Value genWriteStatement(AbstractConverter &converter, - const parser::WriteStmt &stmt, - pft::LabelEvalMap &labelMap, - pft::SymbolLabelMap &assignMap); + const parser::WriteStmt &stmt); } // namespace lower } // namespace Fortran diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 19e17e94337a1..1dda010597c94 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -23,6 +23,7 @@ #include "llvm/ADT/DenseMap.h" #include "llvm/ADT/SmallSet.h" #include "llvm/Support/raw_ostream.h" +#include "Utils.h" namespace mlir { class Block; @@ -172,10 +173,6 @@ static constexpr bool isFunctionLike{common::HasMember< parser::SubroutineSubprogram, parser::SeparateModuleSubprogram>>}; -using LabelSet = llvm::SmallSet; -using SymbolRef = common::Reference; -using SymbolLabelMap = llvm::DenseMap; - template struct MakeReferenceVariantHelper {}; template diff --git a/flang/include/flang/Lower/Utils.h b/flang/include/flang/Lower/Utils.h index e40d6eba4f539..7def4635fdfbf 100644 --- a/flang/include/flang/Lower/Utils.h +++ b/flang/include/flang/Lower/Utils.h @@ -16,6 +16,36 @@ #include "flang/Common/indirection.h" #include "flang/Parser/char-block.h" #include "llvm/ADT/StringRef.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/SmallSet.h" + +namespace Fortran { +namespace semantics { + class Symbol; +} + +namespace evaluate { + template class Expr; + struct SomeType; +} + +namespace common { + template class Reference; +} + +namespace lower { +namespace pft { +struct Evaluation; + +using SomeExpr = Fortran::evaluate::Expr; +using SymbolRef = Fortran::common::Reference; +using Label = std::uint64_t; +using LabelSet = llvm::SmallSet; +using SymbolLabelMap = llvm::DenseMap; +using LabelEvalMap = llvm::DenseMap; +} // namespace pft +} // namespace lower +} // namespace Fortran /// Convert an F18 CharBlock to an LLVM StringRef inline llvm::StringRef toStringRef(const Fortran::parser::CharBlock &cb) { diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index fe955e3101870..dd6c3be93e17a 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -322,6 +322,25 @@ class FirConverter : public Fortran::lower::AbstractConverter { return fir::getBase(lookupSymbol(sym)); } + bool lookupLabelSet(Fortran::lower::SymbolRef sym, Fortran::lower::pft::LabelSet &labelSet) override final { + auto &owningProc = *getEval().getOwningProcedure(); + auto iter = owningProc.assignSymbolLabelMap.find(sym); + if (iter == owningProc.assignSymbolLabelMap.end()) { + return false; + } + labelSet = iter->second; + return true; + } + + Fortran::lower::pft::Evaluation* lookupLabel(Fortran::lower::pft::Label label) override final { + auto &owningProc = *getEval().getOwningProcedure(); + auto iter = owningProc.labelEvaluationMap.find(label); + if (iter == owningProc.labelEvaluationMap.end()) { + return nullptr; + } + return iter->second; + } + mlir::Value genExprAddr(const Fortran::lower::SomeExpr &expr, mlir::Location *loc = nullptr) override final { return createFIRAddr(loc ? *loc : toLocation(), &expr); @@ -1181,14 +1200,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { genIoConditionBranches(getEval(), stmt.v, iostat); } void genFIR(const Fortran::parser::PrintStmt &stmt) { - auto &owningProc = *getEval().getOwningProcedure(); - genPrintStatement(*this, stmt, owningProc.labelEvaluationMap, - owningProc.assignSymbolLabelMap); + genPrintStatement(*this, stmt); } void genFIR(const Fortran::parser::ReadStmt &stmt) { - auto &owningProc = *getEval().getOwningProcedure(); - auto iostat = genReadStatement(*this, stmt, owningProc.labelEvaluationMap, - owningProc.assignSymbolLabelMap); + auto iostat = genReadStatement(*this, stmt); genIoConditionBranches(getEval(), stmt.controls, iostat); } void genFIR(const Fortran::parser::RewindStmt &stmt) { @@ -1200,9 +1215,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { genIoConditionBranches(getEval(), stmt.v, iostat); } void genFIR(const Fortran::parser::WriteStmt &stmt) { - auto &owningProc = *getEval().getOwningProcedure(); - auto iostat = genWriteStatement(*this, stmt, owningProc.labelEvaluationMap, - owningProc.assignSymbolLabelMap); + auto iostat = genWriteStatement(*this, stmt); genIoConditionBranches(getEval(), stmt.controls, iostat); } diff --git a/flang/test/Lower/format.f90 b/flang/test/Lower/format.f90 new file mode 100644 index 0000000000000..740f74df2ff9e --- /dev/null +++ b/flang/test/Lower/format.f90 @@ -0,0 +1,39 @@ +! RUN: bbc %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPformatassign +function formatAssign() + real :: pi + integer :: label + logical :: flag + + ! CHECK: select + if (flag) then + assign 100 to label + else + assign 200 to label + end if + + ! CHECK: fir.select + ! CHECK-LABEL: ^bb{{[0-9]+}}: + ! CHECK: fir.address_of + ! CHECK: br [[END_BLOCK:\^bb[0-9]+]]{{(.*)}} + ! CHECK-LABEL: ^bb{{[0-9]+}}: // + ! CHECK: fir.address_of + ! CHECK: br [[END_BLOCK]] + ! CHECK-LABEL: ^bb{{[0-9]+}}: // + ! CHECK: fir.address_of + ! CHECK: br [[END_BLOCK]] + ! CHECK-LABEL: ^bb{{[0-9]+(.*)}}: // + ! CHECK: call{{.*}}BeginExternalFormattedOutput + ! CHECK-DAG: call{{.*}}OutputAscii + ! CHECK-DAG: call{{.*}}OutputReal32 + ! CHECK: call{{.*}}EndIoStatement + pi = 3.141592653589 + write(*, label) "PI=", pi + + +100 format (A, F10.3) +200 format (A,E8.1) +300 format (A, E2.4) + + end function From 4dde8a34b48623f123462aaade3d9a83b8756ac3 Mon Sep 17 00:00:00 2001 From: zacharyselk Date: Mon, 27 Jul 2020 08:45:49 -0600 Subject: [PATCH 0201/1017] Small change --- flang/test/Lower/format.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/test/Lower/format.f90 b/flang/test/Lower/format.f90 index 740f74df2ff9e..ce0f736e1056f 100644 --- a/flang/test/Lower/format.f90 +++ b/flang/test/Lower/format.f90 @@ -13,7 +13,7 @@ function formatAssign() assign 200 to label end if - ! CHECK: fir.select + ! CHECK: fir.select {{.*\[100, \^bb[0-9]+, 200, \^bb[0-9]+, unit, \^bb[0-9]+\]}} ! CHECK-LABEL: ^bb{{[0-9]+}}: ! CHECK: fir.address_of ! CHECK: br [[END_BLOCK:\^bb[0-9]+]]{{(.*)}} From 4b55264250cc05c7ace18f5dbb5c30082f101478 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 27 Jul 2020 10:17:10 -0700 Subject: [PATCH 0202/1017] fix include errors, build issue --- flang/include/flang/Lower/IO.h | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/flang/include/flang/Lower/IO.h b/flang/include/flang/Lower/IO.h index 6c1da0bd9ab76..ee1e4d91b349b 100644 --- a/flang/include/flang/Lower/IO.h +++ b/flang/include/flang/Lower/IO.h @@ -17,8 +17,7 @@ #include "flang/Semantics/symbol.h" #include "llvm/ADT/DenseMap.h" #include "llvm/ADT/SmallSet.h" -#include "SymbolMap.h" -#include "Utils.h" +#include "flang/Lower/Utils.h" namespace mlir { class Value; From 4bb3296bea5462760f85f2dac94ac136e90b9998 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 27 Jul 2020 09:10:56 -0700 Subject: [PATCH 0203/1017] Standardize calls to use fir.call in lowering. --- flang/lib/Lower/CharacterRuntime.cpp | 2 +- flang/lib/Lower/Runtime.cpp | 6 +++--- flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp | 2 +- flang/test/Lower/character-compare.f90 | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/flang/lib/Lower/CharacterRuntime.cpp b/flang/lib/Lower/CharacterRuntime.cpp index 4bfbf5824efbb..39c7f722c2777 100644 --- a/flang/lib/Lower/CharacterRuntime.cpp +++ b/flang/lib/Lower/CharacterRuntime.cpp @@ -111,7 +111,7 @@ Fortran::lower::genRawCharCompare(Fortran::lower::AbstractConverter &converter, auto rptr = builder.createConvert(loc, fTy.getInput(1), rhsBuff); auto rlen = builder.createConvert(loc, fTy.getInput(3), rhsLen); llvm::SmallVector args = {lptr, rptr, llen, rlen}; - auto tri = builder.create(loc, beginFunc, args).getResult(0); + auto tri = builder.create(loc, beginFunc, args).getResult(0); auto zero = builder.createIntegerConstant(loc, tri.getType(), 0); return builder.create(loc, cmp, tri, zero); } diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index 098efdf44bac5..5ccc599806ab0 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -102,7 +102,7 @@ void Fortran::lower::genStopStatement( auto type = calleeType.getInput(i++); op = builder.createConvert(loc, type, op); } - builder.create(loc, callee, operands); + builder.create(loc, callee, operands); } void Fortran::lower::genFailImageStatement( @@ -110,7 +110,7 @@ void Fortran::lower::genFailImageStatement( auto &bldr = converter.getFirOpBuilder(); auto loc = converter.getCurrentLocation(); auto callee = genRuntimeFunction(loc, bldr); - bldr.create(loc, callee, llvm::None); + bldr.create(loc, callee, llvm::None); } void Fortran::lower::genEventPostStatement( @@ -175,5 +175,5 @@ void Fortran::lower::genPauseStatement( auto &bldr = converter.getFirOpBuilder(); auto loc = converter.getCurrentLocation(); auto callee = genRuntimeFunction(loc, bldr); - bldr.create(loc, callee, llvm::None); + bldr.create(loc, callee, llvm::None); } diff --git a/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp index 45435a5d33fab..c04e6f844d7fb 100644 --- a/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp +++ b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp @@ -119,7 +119,7 @@ struct SelectTypeOpConversion : public FIROpConversion { // runtime type of the selector is an exact match to a derived type or (2) // testing if the runtime type of the selector is a derived type or one of // that derived type's subtypes. - auto cmp = rewriter.create( + auto cmp = rewriter.create( loc, fty, rewriter.getSymbolRefAttr(funName), actuals); auto *thisBlock = rewriter.getInsertionBlock(); auto *newBlock = createBlock(rewriter, dest); diff --git a/flang/test/Lower/character-compare.f90 b/flang/test/Lower/character-compare.f90 index 16d51bf076b9e..c97f479b85cbd 100644 --- a/flang/test/Lower/character-compare.f90 +++ b/flang/test/Lower/character-compare.f90 @@ -4,7 +4,7 @@ subroutine compare(x, c1, c2) character(len=4) c1, c2 logical x - ! CHECK: %[[RES:.*]] = call @_FortranACharacterCompareScalar1 + ! CHECK: %[[RES:.*]] = fir.call @_FortranACharacterCompareScalar1 ! CHECK: cmpi "slt", %[[RES]], x = c1 < c2 end subroutine compare From cfefe9f5a73ba8b3d17fecd9dc4377e9dd5ca7e4 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Sat, 11 Jul 2020 13:03:10 -0700 Subject: [PATCH 0204/1017] selectively disable the -Wc99-extensions warning --- flang/lib/Lower/CMakeLists.txt | 4 ++++ flang/runtime/CMakeLists.txt | 6 ++++++ 2 files changed, 10 insertions(+) diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt index fcf45d831e369..5aa0edc04af76 100644 --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -1,3 +1,7 @@ +check_cxx_compiler_flag("-Werror -Wc99-extensions" HAS_WC99_EXTENSIONS_FLAG) +if (HAS_WC99_EXTENSIONS_FLAG) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-c99-extensions") +endif() get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index d8755ab4408da..6221bdc310cd7 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -3,6 +3,12 @@ include(CheckCXXSymbolExists) include(CheckCXXSourceCompiles) check_cxx_symbol_exists(strerror string.h HAVE_STRERROR) check_cxx_symbol_exists(strerror_r string.h HAVE_STRERROR_R) + +check_cxx_compiler_flag("-Werror -Wc99-extensions" HAS_WC99_EXTENSIONS_FLAG) +if (HAS_WC99_EXTENSIONS_FLAG) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-c99-extensions") +endif() + # Can't use symbol exists here as the function is overloaded in C++ check_cxx_source_compiles( "#include From 3a57b9e918a775b077fcb87f6b193f8bbf0c86d1 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 27 Jul 2020 10:51:46 -0700 Subject: [PATCH 0205/1017] Cleanup IO.h removes extra, unneeded includes. --- flang/include/flang/Lower/IO.h | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/flang/include/flang/Lower/IO.h b/flang/include/flang/Lower/IO.h index ee1e4d91b349b..9815e2d743660 100644 --- a/flang/include/flang/Lower/IO.h +++ b/flang/include/flang/Lower/IO.h @@ -13,11 +13,7 @@ #ifndef FORTRAN_LOWER_IO_H #define FORTRAN_LOWER_IO_H -#include "flang/Common/reference.h" -#include "flang/Semantics/symbol.h" -#include "llvm/ADT/DenseMap.h" -#include "llvm/ADT/SmallSet.h" -#include "flang/Lower/Utils.h" +#include namespace mlir { class Value; @@ -42,7 +38,6 @@ struct WriteStmt; namespace lower { class AbstractConverter; -class BridgeImpl; /// Generate IO call(s) for BACKSPACE; return the IOSTAT code mlir::Value genBackspaceStatement(AbstractConverter &, From f73690b09b6e80436afbc0f55d7e7224b3e5e68b Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 27 Jul 2020 14:57:09 -0700 Subject: [PATCH 0206/1017] fix incorrect #include directive for build. --- flang/include/flang/Lower/PFTBuilder.h | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 1dda010597c94..b778250d311c3 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -19,11 +19,9 @@ #include "flang/Common/reference.h" #include "flang/Common/template.h" +#include "flang/Lower/Utils.h" #include "flang/Parser/parse-tree.h" -#include "llvm/ADT/DenseMap.h" -#include "llvm/ADT/SmallSet.h" #include "llvm/Support/raw_ostream.h" -#include "Utils.h" namespace mlir { class Block; @@ -66,7 +64,7 @@ class ReferenceVariantBase { template constexpr BaseType &get() const { - return std::get>> (u).get(); + return std::get>(u).get(); } template constexpr BaseType *getIf() const { @@ -550,7 +548,7 @@ struct BlockDataUnit : public ProgramUnit { BlockDataUnit(const BlockDataUnit &) = delete; LLVM_DUMP_METHOD void dump() const; - + const Fortran::semantics::Scope &symTab; // symbol table }; From 1bba9ef73de4aaa15feeb464342ade5de9e2adf5 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 27 Jul 2020 15:21:29 -0700 Subject: [PATCH 0207/1017] clang-format --- flang/include/flang/Lower/Utils.h | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/flang/include/flang/Lower/Utils.h b/flang/include/flang/Lower/Utils.h index 7def4635fdfbf..78a02e835a215 100644 --- a/flang/include/flang/Lower/Utils.h +++ b/flang/include/flang/Lower/Utils.h @@ -15,26 +15,27 @@ #include "flang/Common/indirection.h" #include "flang/Parser/char-block.h" -#include "llvm/ADT/StringRef.h" #include "llvm/ADT/DenseMap.h" #include "llvm/ADT/SmallSet.h" +#include "llvm/ADT/StringRef.h" namespace Fortran { namespace semantics { - class Symbol; +class Symbol; } namespace evaluate { - template class Expr; - struct SomeType; -} +template +class Expr; +struct SomeType; +} // namespace evaluate namespace common { - template class Reference; +template +class Reference; } -namespace lower { -namespace pft { +namespace lower::pft { struct Evaluation; using SomeExpr = Fortran::evaluate::Expr; @@ -43,9 +44,8 @@ using Label = std::uint64_t; using LabelSet = llvm::SmallSet; using SymbolLabelMap = llvm::DenseMap; using LabelEvalMap = llvm::DenseMap; -} // namespace pft -} // namespace lower -} // namespace Fortran +} // namespace lower::pft +} // namespace Fortran /// Convert an F18 CharBlock to an LLVM StringRef inline llvm::StringRef toStringRef(const Fortran::parser::CharBlock &cb) { From 6ab59339480425ecd70c1159a8e2ef28bd4f8ee0 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Mon, 27 Jul 2020 11:07:03 -0700 Subject: [PATCH 0208/1017] Improve runtime interface with C99 complex In folding, make pgmath usage conditional to C99 complex support in C++. Disable warning in such case. In lowering, use an empty class type to indicate C99 complex type in runtime interface. Add a unit test enforcing C99 complex can be processed by FIR runtime interface builder. --- flang/lib/Evaluate/CMakeLists.txt | 14 ++++++- flang/lib/Lower/CMakeLists.txt | 4 -- flang/lib/Lower/RTBuilder.h | 13 +++++-- flang/runtime/CMakeLists.txt | 5 --- flang/runtime/pgmath.h.inc | 58 +++++++++++++++++++++++----- flang/unittests/Lower/CMakeLists.txt | 15 +++++++ flang/unittests/Lower/RTBuilder.cpp | 35 +++++++++++++++++ 7 files changed, 119 insertions(+), 25 deletions(-) create mode 100644 flang/unittests/Lower/CMakeLists.txt create mode 100644 flang/unittests/Lower/RTBuilder.cpp diff --git a/flang/lib/Evaluate/CMakeLists.txt b/flang/lib/Evaluate/CMakeLists.txt index bebd6ce8ca758..dbf04d62b6076 100644 --- a/flang/lib/Evaluate/CMakeLists.txt +++ b/flang/lib/Evaluate/CMakeLists.txt @@ -2,8 +2,18 @@ if (LIBPGMATH_DIR) # If pgmath library is found, it can be used for constant folding. find_library(LIBPGMATH pgmath PATHS ${LIBPGMATH_DIR}) if(LIBPGMATH) - add_compile_definitions(LINK_WITH_LIBPGMATH) - message(STATUS "Found libpgmath: ${LIBPGMATH}") + # pgmath uses _Complex, so only enable linking pgmath with flang in environments + # that support it (MSVC is OK, pgmath uses _Fcomplex/_Dcomplex there). + if (CMAKE_CXX_COMPILER_ID MATCHES "Clang|GNU|MSVC") + check_cxx_compiler_flag("-Werror -Wc99-extensions" HAS_WC99_EXTENSIONS_FLAG) + if (HAS_WC99_EXTENSIONS_FLAG) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-c99-extensions") + endif() + add_compile_definitions(LINK_WITH_LIBPGMATH) + message(STATUS "Found libpgmath: ${LIBPGMATH}") + else() + message(STATUS "Libpgmath will not be used because C99 complex is not supported.") + endif() else() message(STATUS "Libpgmath not found in: ${LIBPGMATH_DIR}") endif() diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt index 5aa0edc04af76..fcf45d831e369 100644 --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -1,7 +1,3 @@ -check_cxx_compiler_flag("-Werror -Wc99-extensions" HAS_WC99_EXTENSIONS_FLAG) -if (HAS_WC99_EXTENSIONS_FLAG) - set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-c99-extensions") -endif() get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) diff --git a/flang/lib/Lower/RTBuilder.h b/flang/lib/Lower/RTBuilder.h index 5dba1a47100f2..b5b6eb104849e 100644 --- a/flang/lib/Lower/RTBuilder.h +++ b/flang/lib/Lower/RTBuilder.h @@ -27,6 +27,13 @@ // List the runtime headers we want to be able to dissect #include "../../runtime/io-api.h" +// Incomplete type indicating C99 complex ABI in interfaces. Beware, _Complex +// and std::complex are layout compatible, but not compatible in all ABI call +// interface (e.g. X86 32 bits). _Complex is not standard C++, so do not use +// it here. +struct c_float_complex_t; +struct c_double_complex_t; + namespace Fortran::lower { using TypeBuilderFunc = mlir::Type (*)(mlir::MLIRContext *); @@ -164,20 +171,18 @@ constexpr TypeBuilderFunc getModel() { return fir::ReferenceType::get(f(context)); }; } - template <> -constexpr TypeBuilderFunc getModel() { +constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return fir::CplxType::get(context, sizeof(float)); }; } template <> -constexpr TypeBuilderFunc getModel() { +constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return fir::CplxType::get(context, sizeof(double)); }; } - template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index 6221bdc310cd7..8601ec1d76675 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -4,11 +4,6 @@ include(CheckCXXSourceCompiles) check_cxx_symbol_exists(strerror string.h HAVE_STRERROR) check_cxx_symbol_exists(strerror_r string.h HAVE_STRERROR_R) -check_cxx_compiler_flag("-Werror -Wc99-extensions" HAS_WC99_EXTENSIONS_FLAG) -if (HAS_WC99_EXTENSIONS_FLAG) - set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-c99-extensions") -endif() - # Can't use symbol exists here as the function is overloaded in C++ check_cxx_source_compiles( "#include diff --git a/flang/runtime/pgmath.h.inc b/flang/runtime/pgmath.h.inc index c7b60ac749224..36e1abe7a00ff 100644 --- a/flang/runtime/pgmath.h.inc +++ b/flang/runtime/pgmath.h.inc @@ -22,6 +22,7 @@ // Control Macros #ifdef PGMATH_DECLARE #undef PGMATH_DECLARE +#define DEFINE_C_COMPLEX_TYPES #define PGMATH_DECLARE(x) extern "C" x; #define PGMATH_FAST #define PGMATH_PRECISE @@ -58,6 +59,37 @@ #define PGMATH_USE_OTHER(name, x) #endif +// Handle the C99 _Complex vs C++ std::complex call interface issue. +// _Complex and std::complex are layout compatible (they are the same when +// in memory), but they are not guaranteed to be compatible in call interface +// (they may be passed/returned differently). For instance on X86 32 bits, +// float _complex is returned in a pair of register, but std::complex +// is returned in memory. +// Pgmath is defined in C using _Complex (and windows _Fcomplex/_DComplex +// equivalents). Since this file defines the call interface with the runtime +// for both folding and code generation (through template introspection), it +// is crucial to make a difference between std::complex and _Complex here. +// Unfortunately, _Complex support is not standard in C++. +// Reserve pgmath usage at compile time (folding) when _Complex is available +// (cmake is responsible to detect this). +// For code generation, define type c_float_complex_t that can be used in +// introspection to indicate that the C99 _Complex ABI has to be used for the +// related value. +#ifdef DEFINE_C_COMPLEX_TYPES +#ifdef PGMATH_LINKING +#ifdef _WIN32 +using c_float_complex_t = _Fcomplex; +using c_double_complex_t = _Dcomplex; +#else +using c_float_complex_t = float _Complex; +using c_double_complex_t = double _Complex; +#endif +#else +struct c_float_complex_t {}; +struct c_double_complex_t {}; +#endif +#endif + #define PGMATH_REAL_IMPL(impl, func) \ PGMATH_DECLARE(float __##impl##s_##func##_1(float)) \ PGMATH_DECLARE(double __##impl##d_##func##_1(double)) \ @@ -65,8 +97,9 @@ PGMATH_USE_D(func, __##impl##d_##func##_1) #define PGMATH_COMPLEX_IMPL(impl, func) \ - PGMATH_DECLARE(float _Complex __##impl##c_##func##_1(float _Complex)) \ - PGMATH_DECLARE(double _Complex __##impl##z_##func##_1(double _Complex)) \ + PGMATH_DECLARE(c_float_complex_t __##impl##c_##func##_1(c_float_complex_t)) \ + PGMATH_DECLARE( \ + c_double_complex_t __##impl##z_##func##_1(c_double_complex_t)) \ PGMATH_USE_C(func, __##impl##c_##func##_1) \ PGMATH_USE_Z(func, __##impl##z_##func##_1) @@ -81,10 +114,10 @@ PGMATH_USE_D(func, __##impl##d_##func##_1) #define PGMATH_COMPLEX2_IMPL(impl, func) \ - PGMATH_DECLARE( \ - float _Complex __##impl##c_##func##_1(float _Complex, float _Complex)) \ - PGMATH_DECLARE(double _Complex __##impl##z_##func##_1( \ - double _Complex, double _Complex)) \ + PGMATH_DECLARE(c_float_complex_t __##impl##c_##func##_1( \ + c_float_complex_t, c_float_complex_t)) \ + PGMATH_DECLARE(c_double_complex_t __##impl##z_##func##_1( \ + c_double_complex_t, c_double_complex_t)) \ PGMATH_USE_C(func, __##impl##c_##func##_1) \ PGMATH_USE_Z(func, __##impl##z_##func##_1) @@ -243,16 +276,19 @@ PGMATH_ALL2(pow) #define PGMATH_DELCARE_POW(impl) \ PGMATH_DECLARE(float __##impl##s_powi_1(float, int)) \ PGMATH_DECLARE(double __##impl##d_powi_1(double, int)) \ - PGMATH_DECLARE(float _Complex __##impl##c_powi_1(float _Complex, int)) \ - PGMATH_DECLARE(double _Complex __##impl##z_powi_1(double _Complex, int)) \ + PGMATH_DECLARE(c_float_complex_t __##impl##c_powi_1(c_float_complex_t, int)) \ + PGMATH_DECLARE( \ + c_double_complex_t __##impl##z_powi_1(c_double_complex_t, int)) \ PGMATH_USE_S(pow, __##impl##s_powi_1) \ PGMATH_USE_D(pow, __##impl##d_powi_1) \ PGMATH_USE_C(pow, __##impl##c_powi_1) \ PGMATH_USE_Z(pow, __##impl##z_powi_1) \ PGMATH_DECLARE(float __##impl##s_powk_1(float, int64_t)) \ PGMATH_DECLARE(double __##impl##d_powk_1(double, int64_t)) \ - PGMATH_DECLARE(float _Complex __##impl##c_powk_1(float _Complex, int64_t)) \ - PGMATH_DECLARE(double _Complex __##impl##z_powk_1(double _Complex, int64_t)) \ + PGMATH_DECLARE( \ + c_float_complex_t __##impl##c_powk_1(c_float_complex_t, int64_t)) \ + PGMATH_DECLARE( \ + c_double_complex_t __##impl##z_powk_1(c_double_complex_t, int64_t)) \ PGMATH_USE_S(pow, __##impl##s_powk_1) \ PGMATH_USE_D(pow, __##impl##d_powk_1) \ PGMATH_USE_C(pow, __##impl##c_powk_1) \ @@ -291,3 +327,5 @@ PGMATH_ALL(tanh) #undef PGMATH_USE_Z #undef PGMATH_USE_OTHER #undef PGMATH_USE_ALL_TYPES +#undef PGMATH_LINKING +#undef DEFINE_C_COMPLEX_TYPES diff --git a/flang/unittests/Lower/CMakeLists.txt b/flang/unittests/Lower/CMakeLists.txt new file mode 100644 index 0000000000000..9843eebf34433 --- /dev/null +++ b/flang/unittests/Lower/CMakeLists.txt @@ -0,0 +1,15 @@ +get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) + +set(LIBS + FIROptimizer + MLIRLLVMIR + ${dialect_libs} +) + +add_flang_unittest(FlangLoweringOpenMPTests + OpenMPLoweringTest.cpp + RTBuilder.cpp +) +target_link_libraries(FlangLoweringOpenMPTests + PRIVATE + ${LIBS}) diff --git a/flang/unittests/Lower/RTBuilder.cpp b/flang/unittests/Lower/RTBuilder.cpp new file mode 100644 index 0000000000000..b475b5e59ab0e --- /dev/null +++ b/flang/unittests/Lower/RTBuilder.cpp @@ -0,0 +1,35 @@ +//===- RTBuilder.cpp -- Runtime Interface unit tests ----------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "../../lib/Lower/RTBuilder.h" +#include "gtest/gtest.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include + +// Check that it is possible to make a difference between complex runtime +// function using C99 complex and C++ std::complex. This is important since +// they are layout compatible but not link time compatible (returned differently +// in X86 32 ABI for instance). At high level fir, we need to convey that the +// signature are different regardless of the target ABI. + +// Fake runtime header to be introspected. +c_float_complex_t c99_cacosf(c_float_complex_t); + +TEST(RTBuilderTest, ComplexRuntimeInterface) { + fir::registerFIR(); + mlir::MLIRContext ctx; + mlir::Type c99_cacosf_signature{ + Fortran::lower::RuntimeTableKey::getTypeModel()( + &ctx)}; + auto c99_cacosf_funcTy = c99_cacosf_signature.cast(); + EXPECT_EQ(c99_cacosf_funcTy.getNumInputs(), 1u); + EXPECT_EQ(c99_cacosf_funcTy.getNumResults(), 1u); + auto cplx_ty = fir::CplxType::get(&ctx, 4); + EXPECT_EQ(c99_cacosf_funcTy.getInput(0), cplx_ty); + EXPECT_EQ(c99_cacosf_funcTy.getResult(0), cplx_ty); +} From 5cb1c534b2d07d9dc05db015283d76c84bb83acf Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 27 Jul 2020 14:08:41 -0700 Subject: [PATCH 0209/1017] Implement INQUIRE per the new io-api.h interface. This completes the implementation of the inquire-spec handlers, threads error handling (for future support of derived types), cleans up a number of interfaces that changed, etc. This also includes the new changes to io-api.h for a target to build against. (The implementation is elsewhere.) fix fm252 fix format stmt condition test to be more robust, per review. fix for iostat and iomsg in inquire-stmt, where they are encoded in the parse tree uniquely. --- flang/include/flang/Lower/ConvertExpr.h | 1 - flang/include/flang/Lower/Support/BoxValue.h | 2 + flang/lib/Lower/ConvertExpr.cpp | 14 ++- flang/test/Lower/io-stmt01.f90 | 105 ++++++++++++------- 4 files changed, 83 insertions(+), 39 deletions(-) diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h index 23d1ed0fd2a7a..42f7f36316c24 100644 --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -102,7 +102,6 @@ createSomeExtendedAddress(mlir::Location loc, AbstractConverter &converter, fir::ExtendedValue createStringLiteral(mlir::Location loc, AbstractConverter &converter, llvm::StringRef str, std::uint64_t len); - } // namespace lower } // namespace Fortran diff --git a/flang/include/flang/Lower/Support/BoxValue.h b/flang/include/flang/Lower/Support/BoxValue.h index 36c20e7648469..c197401e08cfa 100644 --- a/flang/include/flang/Lower/Support/BoxValue.h +++ b/flang/include/flang/Lower/Support/BoxValue.h @@ -203,6 +203,7 @@ using RangeBoxValue = std::tuple; class ExtendedValue; mlir::Value getBase(const ExtendedValue &exv); +mlir::Value getLen(const ExtendedValue &exv); llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ExtendedValue &); ExtendedValue substBase(const ExtendedValue &exv, mlir::Value base); @@ -230,6 +231,7 @@ class ExtendedValue { friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ExtendedValue &); friend mlir::Value getBase(const ExtendedValue &exv); + friend mlir::Value getLen(const ExtendedValue &exv); friend ExtendedValue substBase(const ExtendedValue &exv, mlir::Value base); private: diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 606be35a68bab..82cfb02169a97 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1537,12 +1537,22 @@ fir::ExtendedValue Fortran::lower::createStringLiteral( // Support functions (implemented here for now) //===----------------------------------------------------------------------===// -mlir::Value fir::getBase(const fir::ExtendedValue &ex) { +mlir::Value fir::getBase(const fir::ExtendedValue &exv) { return std::visit(Fortran::common::visitors{ [](const fir::UnboxedValue &x) { return x; }, [](const auto &x) { return x.getAddr(); }, }, - ex.box); + exv.box); +} + +mlir::Value fir::getLen(const fir::ExtendedValue &exv) { + return std::visit( + Fortran::common::visitors{ + [](const fir::CharBoxValue &x) { return x.getLen(); }, + [](const fir::CharArrayBoxValue &x) { return x.getLen(); }, + [](const fir::BoxValue &x) { return x.getLen(); }, + [](const auto &) { return mlir::Value{}; }}, + exv.box); } fir::ExtendedValue fir::substBase(const fir::ExtendedValue &ex, diff --git a/flang/test/Lower/io-stmt01.f90 b/flang/test/Lower/io-stmt01.f90 index 2accde3bdfca2..2bb3e843112f4 100644 --- a/flang/test/Lower/io-stmt01.f90 +++ b/flang/test/Lower/io-stmt01.f90 @@ -4,65 +4,98 @@ integer :: length real :: a(100) -! CHECK-LABEL: _QQmain -! CHECK: call {{.*}}BeginOpenUnit -! CHECK-DAG: call {{.*}}SetFile -! CHECK-DAG: call {{.*}}SetAccess -! CHECK: call {{.*}}EndIoStatement - + ! CHECK-LABEL: _QQmain + ! CHECK: call {{.*}}BeginOpenUnit + ! CHECK-DAG: call {{.*}}SetFile + ! CHECK-DAG: call {{.*}}SetAccess + ! CHECK: call {{.*}}EndIoStatement open(8, file="foo", access="sequential") -! CHECK: call {{.*}}BeginBackspace -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginBackspace + ! CHECK: call {{.*}}EndIoStatement backspace(8) -! CHECK: call {{.*}}BeginFlush -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginFlush + ! CHECK: call {{.*}}EndIoStatement flush(8) -! CHECK: call {{.*}}BeginRewind -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginRewind + ! CHECK: call {{.*}}EndIoStatement rewind(8) -! CHECK: call {{.*}}BeginEndfile -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginEndfile + ! CHECK: call {{.*}}EndIoStatement endfile(8) -! CHECK: call {{.*}}BeginWaitAll -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginWaitAll + ! CHECK: call {{.*}}EndIoStatement wait(unit=8) -! CHECK: call {{.*}}BeginExternalListInput -! CHECK: call {{.*}}InputInteger -! CHECK: call {{.*}}InputReal32 -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginExternalListInput + ! CHECK: call {{.*}}InputInteger + ! CHECK: call {{.*}}InputReal32 + ! CHECK: call {{.*}}EndIoStatement read (8,*) i, f -! CHECK: call {{.*}}BeginExternalListOutput -! 32 bit integers are output as 64 bits in the runtime API -! CHECK: call {{.*}}OutputInteger64 -! CHECK: call {{.*}}OutputReal32 -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginExternalListOutput + ! Note that 32 bit integers are output as 64 bits in the runtime API + ! CHECK: call {{.*}}OutputInteger64 + ! CHECK: call {{.*}}OutputReal32 + ! CHECK: call {{.*}}EndIoStatement write (8,*) i, f -! CHECK: call {{.*}}BeginClose -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginClose + ! CHECK: call {{.*}}EndIoStatement close(8) -! CHECK: call {{.*}}BeginExternalListOutput -! CHECK: call {{.*}}OutputAscii -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginExternalListOutput + ! CHECK: call {{.*}}OutputAscii + ! CHECK: call {{.*}}EndIoStatement print *, "A literal string" -! CHECK: call {{.*}}BeginInquireUnit -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginInquireUnit + ! CHECK: call {{.*}}EndIoStatement inquire(4, EXIST=existsvar) -! CHECK: call {{.*}}BeginInquireFile -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginInquireFile + ! CHECK: call {{.*}}EndIoStatement inquire(FILE="fail.f90", EXIST=existsvar) -! CHECK: call {{.*}}BeginInquireIoLength -! CHECK: call {{.*}}EndIoStatement + ! CHECK: call {{.*}}BeginInquireIoLength + ! CHECK: call {{.*}}EndIoStatement inquire (iolength=length) a end + +! Tests the 4 basic inquire formats +! CHECK-LABEL: func @_QPinquire_test +subroutine inquire_test(ch, i, b) + character(80) :: ch + integer :: i + logical :: b + integer :: id_func + + ! CHARACTER + ! CHECK: %[[sugar:.*]] = fir.call {{.*}}BeginInquireUnit + ! CHECK: call {{.*}}InquireCharacter(%[[sugar]], %c{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref, i64, !fir.ref, i64) -> i1 + ! CHECK: call {{.*}}EndIoStatement + inquire(88, name=ch) + + ! INTEGER + ! CHECK: %[[oatmeal:.*]] = fir.call {{.*}}BeginInquireUnit + ! CHECK: call @_FortranAioInquireInteger64(%[[oatmeal]], %c{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref, i64, !fir.ref, i32) -> i1 + ! CHECK: call {{.*}}EndIoStatement + inquire(89, pos=i) + + ! LOGICAL + ! CHECK: %[[snicker:.*]] = fir.call {{.*}}BeginInquireUnit + ! CHECK: call @_FortranAioInquireLogical(%[[snicker]], %c{{.*}}, %[[b:.*]]) : (!fir.ref, i64, !fir.ref) -> i1 + ! CHECK: call {{.*}}EndIoStatement + inquire(90, opened=b) + + ! PENDING with ID + ! CHECK-DAG: %[[chip:.*]] = fir.call {{.*}}BeginInquireUnit + ! CHECK-DAG: fir.call @_QPid_func + ! CHECK: call @_FortranAioInquirePendingId(%[[chip]], %{{.*}}, %[[b]]) : (!fir.ref, i64, !fir.ref) -> i1 + ! CHECK: call {{.*}}EndIoStatement + inquire(91, id=id_func(), pending=b) +end subroutine inquire_test From ffe36d8705bd463b198019aac6f42b9dc0f26d03 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 30 Jul 2020 08:30:19 -0700 Subject: [PATCH 0210/1017] make alternate return label argument explicit in ActualArguments Add an alternative to ActualArgument variant to hold the label. It could have been possible to place it in the expr but: - label are unsigned, fortran expressions are not - It was not clear how many of the code base is relying on GetExpr() not expecting a label. - It allows to save the isAlternateReturn_ field and save a bit making ActualArguments smaller. Change the consumer of ActualArguments that deal with alternate returns (unparsing and a few other spots). With this change, the labels get unparsed correctly, and semantics and lowering are not failing cases where non label arguments are passed after an alternate return label. --- flang/lib/Lower/CallInterface.cpp | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index ebb01f078e236..4615d71473426 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -72,17 +72,23 @@ Fortran::lower::CallerInterface::characterize() const { // the ProcedureDesignator has no interface. if (!characteristic->HasExplicitInterface()) { for (const auto &arg : procRef.arguments()) { - // Argument cannot be optional with implicit interface - const auto *expr = arg.value().UnwrapExpr(); - assert(expr && - "argument in call with implicit interface cannot be assumed type"); - auto argCharacteristic = - Fortran::evaluate::characteristics::DummyArgument::FromActual( - "actual", *expr, foldingContext); - assert(argCharacteristic && - "failed to characterize argument in implicit call"); - characteristic->dummyArguments.emplace_back( - std::move(*argCharacteristic)); + if (arg.value().isAlternateReturn()) { + characteristic->dummyArguments.emplace_back( + Fortran::evaluate::characteristics::AlternateReturn{}); + } else { + // Argument cannot be optional with implicit interface + const auto *expr = arg.value().UnwrapExpr(); + assert( + expr && + "argument in call with implicit interface cannot be assumed type"); + auto argCharacteristic = + Fortran::evaluate::characteristics::DummyArgument::FromActual( + "actual", *expr, foldingContext); + assert(argCharacteristic && + "failed to characterize argument in implicit call"); + characteristic->dummyArguments.emplace_back( + std::move(*argCharacteristic)); + } } } return *characteristic; From d0492a41455958380114577ca049f22e8d2fba39 Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Fri, 31 Jul 2020 09:43:41 -0700 Subject: [PATCH 0211/1017] Problems with alternate entries and returns (#347) * Problem with alternate entries Compilation of this program with an alternate entry fails: call ee(17) end subroutine ss(nn) print*, nn return entry ee(nn) print*, nn end Compilation succeeds if the program is moved below the subroutine. The problem is that with the code as listed, the front end provides ProcEntityDetails for the definition of entry ee (from the call before the entry is visited), when it should provide more complete SubprogramDetails. The front end is generating the SubprogramDetails, but it doesn't retain them. The fix in resolve-names.cpp is to always retain the SubprogramDetails. With this fix, the "2 wrongs make a right" workaround for the function entry point instance of this problem in PFTBuilder.cpp is no longer needed. --- flang/lib/Lower/PFTBuilder.cpp | 3 --- flang/lib/Semantics/resolve-names.cpp | 2 +- flang/test/Lower/altret.f90 | 12 ++++++------ 3 files changed, 7 insertions(+), 10 deletions(-) diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 8e6474e3f5888..a590130f4d4ad 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -309,9 +309,6 @@ class PFTBuilder { entryPointList[entryIndex].second->lexicalSuccessor = p; } else if (const auto *entryStmt = p->getIf()) { const auto *sym = std::get(entryStmt->t).symbol; - if (sym->IsFuncResult()) - // Switch to the function sym. - sym = sym->owner().parent().FindSymbol(sym->name()); assert(sym->has() && "entry must be a subprogram"); entryPointList.push_back(std::pair{sym, p}); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index c8141d604952c..0b787b0c8152c 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3121,7 +3121,7 @@ void SubprogramVisitor::Post(const parser::EntryStmt &stmt) { entrySymbol.set_details(std::move(entryDetails)); SetBindNameOn(entrySymbol); entrySymbol.set(subpFlag); - Resolve(name, entrySymbol); + name.symbol = &entrySymbol; } // A subprogram declared with MODULE PROCEDURE diff --git a/flang/test/Lower/altret.f90 b/flang/test/Lower/altret.f90 index d7c396d0ba506..fa36bdd4e74be 100644 --- a/flang/test/Lower/altret.f90 +++ b/flang/test/Lower/altret.f90 @@ -1,5 +1,11 @@ ! RUN: bbc -emit-fir -o - %s | FileCheck %s +! CHECK-LABEL: func @_QQmain + print*, k(10,20) + print*, k(15,15) + print*, k(20,10) +end + ! CHECK-LABEL: func @_QPk function k(n1, n2) ! CHECK-NOT: ^bb @@ -24,9 +30,3 @@ subroutine s(n1, *, n2, *) ! CHECK-NEXT: return {{.*}} : index return end - -! CHECK-LABEL: func @_QQmain - print*, k(10,20) - print*, k(15,15) - print*, k(20,10) -end From f918ac447ceeb0227a234c7cf556083a1e8638a3 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Mon, 27 Jul 2020 23:09:33 +0530 Subject: [PATCH 0212/1017] [flang][OpenMP] Added initial support for lowering OpenMP parallel construct This is the very first patch in this direction, OpenMP `parallel` construct can have multiple clauses and parameters. This patch implements lowering of an empty(contains no code in body) parallel construct without any clauses or parameters. Patch also accompanying a unit-test, furthermore end-to-end testing can be performed on fir-dev branch. --- .../test/Lower/OpenMP/empty-omp-parallel.f90 | 33 +++++++++++++++++++ flang/test/Lower/{ => OpenMP}/omp-barrier.f90 | 0 .../test/Lower/{ => OpenMP}/omp-taskwait.f90 | 0 .../test/Lower/{ => OpenMP}/omp-taskyield.f90 | 0 4 files changed, 33 insertions(+) create mode 100644 flang/test/Lower/OpenMP/empty-omp-parallel.f90 rename flang/test/Lower/{ => OpenMP}/omp-barrier.f90 (100%) rename flang/test/Lower/{ => OpenMP}/omp-taskwait.f90 (100%) rename flang/test/Lower/{ => OpenMP}/omp-taskyield.f90 (100%) diff --git a/flang/test/Lower/OpenMP/empty-omp-parallel.f90 b/flang/test/Lower/OpenMP/empty-omp-parallel.f90 new file mode 100644 index 0000000000000..dd05c543669bb --- /dev/null +++ b/flang/test/Lower/OpenMP/empty-omp-parallel.f90 @@ -0,0 +1,33 @@ +! This test checks lowering of OpenMP parallel Directive. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: tco | FileCheck %s --check-prefix=LLVMIR + +program parallel + + integer :: a,b,c +! This and last statements are just for the sake ensuring that the +! operation is created/inserted correctly and does not break/interfere with +! other pieces which may be present before/after the operation. +! However this test does not verify operation corresponding to this +! statment. + c = a + b +!$OMP PARALLEL +!FIRDialect: omp.parallel { +!FIRDialect-NEXT: omp.terminator +!FIRDialect-NEXT: } + +!LLVMIRDialect: omp.parallel { +!LLVMIRDialect-NEXT: omp.terminator +!LLVMIRDialect-NEXT: } + +!LLVMIR: call void{{.*}}@__kmpc_fork_call{{.*}}@[[OMP_OUTLINED_FN:.*]] to {{.*}} +!LLVMIR: define internal void @[[OMP_OUTLINED_FN]] +!$OMP END PARALLEL + b = a + c + +end program diff --git a/flang/test/Lower/omp-barrier.f90 b/flang/test/Lower/OpenMP/omp-barrier.f90 similarity index 100% rename from flang/test/Lower/omp-barrier.f90 rename to flang/test/Lower/OpenMP/omp-barrier.f90 diff --git a/flang/test/Lower/omp-taskwait.f90 b/flang/test/Lower/OpenMP/omp-taskwait.f90 similarity index 100% rename from flang/test/Lower/omp-taskwait.f90 rename to flang/test/Lower/OpenMP/omp-taskwait.f90 diff --git a/flang/test/Lower/omp-taskyield.f90 b/flang/test/Lower/OpenMP/omp-taskyield.f90 similarity index 100% rename from flang/test/Lower/omp-taskyield.f90 rename to flang/test/Lower/OpenMP/omp-taskyield.f90 From 168a74ee27725dc65a05b5bbdb1e9e95ae82a06c Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Fri, 31 Jul 2020 05:52:02 -0700 Subject: [PATCH 0213/1017] Handle HostAssociated symbols better and fix undefined behavior --- flang/lib/Lower/Bridge.cpp | 3 ++- flang/lib/Lower/SymbolMap.h | 8 +++++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index dd6c3be93e17a..c883e38e03224 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2165,7 +2165,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } if (auto passedResult = callee.getPassedResult()) { mapPassedEntity(*passedResult); - if (*passedResult->entity != *funit.primaryResult) + if (funit.primaryResult && + passedResult->entity.get() != *funit.primaryResult) addSymbol(*funit.primaryResult, lookupSymbol(passedResult->entity)); } } diff --git a/flang/lib/Lower/SymbolMap.h b/flang/lib/Lower/SymbolMap.h index 3c99febc15178..30da502f9793f 100644 --- a/flang/lib/Lower/SymbolMap.h +++ b/flang/lib/Lower/SymbolMap.h @@ -229,7 +229,13 @@ class SymMap { /// Find `symbol` and return its value if it appears in the current mappings. SymbolBox lookupSymbol(semantics::SymbolRef sym) { auto iter = symbolMap.find(&*sym); - return (iter == symbolMap.end()) ? SymbolBox() : iter->second; + if (iter != symbolMap.end()) + return iter->second; + // Follow host association + if (const auto *details = + sym->detailsIf()) + return lookupSymbol(details->symbol()); + return SymbolBox::None{}; } /// Remove `sym` from the map. From 864f16d140f96cc90cfbf99a534313b896ee8010 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 31 Jul 2020 16:43:55 -0700 Subject: [PATCH 0214/1017] make the distinction between "long" and "long long" explicit. fixes compilation on MacOS. --- flang/lib/Lower/RTBuilder.h | 30 +++++++++++++++++++++++++----- 1 file changed, 25 insertions(+), 5 deletions(-) diff --git a/flang/lib/Lower/RTBuilder.h b/flang/lib/Lower/RTBuilder.h index b5b6eb104849e..32992f30dddbb 100644 --- a/flang/lib/Lower/RTBuilder.h +++ b/flang/lib/Lower/RTBuilder.h @@ -102,25 +102,45 @@ constexpr TypeBuilderFunc getModel() { }; } template <> -constexpr TypeBuilderFunc getModel() { +constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { - return mlir::IntegerType::get(context, 64); + return mlir::IntegerType::get(context, 8 * sizeof(long)); }; } template <> -constexpr TypeBuilderFunc getModel() { +constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { - TypeBuilderFunc f{getModel()}; + TypeBuilderFunc f{getModel()}; return fir::ReferenceType::get(f(context)); }; } template <> -constexpr TypeBuilderFunc getModel() { +constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { return mlir::IntegerType::get(context, 8 * sizeof(std::size_t)); }; } template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(unsigned long)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(unsigned long long)); +>>>>>>> f97c932814ff... make the distinction between "long" and "long long" explicit. fixes compilation on MacOS. + }; +} +template <> constexpr TypeBuilderFunc getModel() { return getModel(); } From 54d0aa3116ea07f93fb26d0ad92e7f7105f1bcbb Mon Sep 17 00:00:00 2001 From: V Donaldson Date: Fri, 31 Jul 2020 15:18:22 -0700 Subject: [PATCH 0215/1017] Alternate entries that have alternate returns Allow a subroutine with alternate entries to declare some, but not necessarily all entry points with alternate return arguments. Example: subroutine ss(n) print*, n return entry ee(n,*) return 1 end call ss(7) call ee(2, *11) print*, 'default' 11 print*, 11 end There are also some miscellaneous cleanup changes. --- flang/lib/Lower/Bridge.cpp | 41 +++++++++++++++++++--------------- flang/lib/Lower/PFTBuilder.cpp | 5 +---- flang/test/Lower/altalt.f90 | 19 ++++++++++++++++ flang/test/Lower/entry.f90 | 28 +++++++++++------------ 4 files changed, 57 insertions(+), 36 deletions(-) create mode 100644 flang/test/Lower/altalt.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index c883e38e03224..9d63c475a2dc2 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -322,7 +322,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { return fir::getBase(lookupSymbol(sym)); } - bool lookupLabelSet(Fortran::lower::SymbolRef sym, Fortran::lower::pft::LabelSet &labelSet) override final { + bool lookupLabelSet(Fortran::lower::SymbolRef sym, + Fortran::lower::pft::LabelSet &labelSet) override final { auto &owningProc = *getEval().getOwningProcedure(); auto iter = owningProc.assignSymbolLabelMap.find(sym); if (iter == owningProc.assignSymbolLabelMap.end()) { @@ -332,7 +333,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { return true; } - Fortran::lower::pft::Evaluation* lookupLabel(Fortran::lower::pft::Label label) override final { + Fortran::lower::pft::Evaluation * + lookupLabel(Fortran::lower::pft::Label label) override final { auto &owningProc = *getEval().getOwningProcedure(); auto iter = owningProc.labelEvaluationMap.find(label); if (iter == owningProc.labelEvaluationMap.end()) { @@ -570,11 +572,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->create(loc, resultVal); } - /// Argument \p funit is a subroutine that has alternate return specifiers. - /// Return the variable that contains the result value of a call to \p funit. + /// Get the return value of a call to \p symbol, which is a subroutine entry + /// point that has alternative return specifiers. const mlir::Value - getAltReturnResult(const Fortran::lower::pft::FunctionLikeUnit &funit) { - const auto &symbol = funit.getSubprogramSymbol(); + getAltReturnResult(const Fortran::semantics::Symbol &symbol) { assert(Fortran::semantics::HasAlternateReturns(symbol) && "subroutine does not have alternate returns"); const auto returnValue = lookupSymbol(symbol); @@ -594,8 +595,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (Fortran::semantics::IsFunction(symbol)) { genReturnSymbol(symbol); } else if (Fortran::semantics::HasAlternateReturns(symbol)) { - mlir::Value retval = - builder->create(toLocation(), getAltReturnResult(funit)); + mlir::Value retval = builder->create( + toLocation(), getAltReturnResult(symbol)); builder->create(toLocation(), retval); } else { genExitRoutine(); @@ -1581,10 +1582,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { genStopStatement(*this, stmt); } - // gen expression, if any; share code with END of procedure void genFIR(const Fortran::parser::ReturnStmt &stmt) { - auto &eval = getEval(); - auto *funit = eval.getOwningProcedure(); + auto *funit = getEval().getOwningProcedure(); assert(funit && "not inside main program, function or subroutine"); if (funit->isMainProgram()) { genExitRoutine(); @@ -1592,13 +1591,19 @@ class FirConverter : public Fortran::lower::AbstractConverter { } auto loc = toLocation(); if (stmt.v) { - // Alternate return statement -- assign alternate return index. - auto expr = Fortran::semantics::GetExpr(*stmt.v); - assert(expr && "missing alternate return expression"); - auto altReturnIndex = builder->createConvert(loc, builder->getIndexType(), - genExprValue(*expr)); - builder->create(loc, altReturnIndex, - getAltReturnResult(*funit)); + // Alternate return statement - If this is a subroutine where some + // alternate entries have alternate returns, but the active entry point + // does not, ignore the alternate return value. Otherwise, assign it + // to the compiler-generated result variable. + const auto &symbol = funit->getSubprogramSymbol(); + if (Fortran::semantics::HasAlternateReturns(symbol)) { + auto expr = Fortran::semantics::GetExpr(*stmt.v); + assert(expr && "missing alternate return expression"); + auto altReturnIndex = builder->createConvert( + loc, builder->getIndexType(), genExprValue(*expr)); + builder->create(loc, altReturnIndex, + getAltReturnResult(symbol)); + } } // Branch to the last block of the SUBROUTINE, which has the actual return. if (!funit->finalBlock) { diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index a590130f4d4ad..4c48de2c66e9b 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -787,9 +787,6 @@ class PFTBuilder { for (auto arg : dummyCountMap) if (arg.second < entryCount) unit->nonUniversalDummyArguments.push_back(arg.first); - // Sort to provide generated code order stability. - std::sort(unit->nonUniversalDummyArguments.begin(), - unit->nonUniversalDummyArguments.end(), std::greater<>()); } std::unique_ptr pgm; @@ -1300,7 +1297,7 @@ void Fortran::lower::pft::Variable::dump() const { << std::get<1>(*store) << "]:"; else llvm_unreachable("not a Variable"); - + llvm::errs() << " depth: " << depth; if (global) llvm::errs() << ", global"; diff --git a/flang/test/Lower/altalt.f90 b/flang/test/Lower/altalt.f90 new file mode 100644 index 0000000000000..229af5b716dd4 --- /dev/null +++ b/flang/test/Lower/altalt.f90 @@ -0,0 +1,19 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + + ! CHECK-LABEL: func @_QPss + subroutine ss(n) + print*, n + ! CHECK: return{{$}} + return + ! CHECK-LABEL: func @_QPee + entry ee(n,*) + ! CHECK: return %{{.}} : index + return 1 + end + + ! CHECK-LABEL: func @_QQmain + call ss(7) + call ee(2, *11) + print*, 'default' +11 print*, 11 + end diff --git a/flang/test/Lower/entry.f90 b/flang/test/Lower/entry.f90 index 8cee9374990b8..2a877708fc79a 100644 --- a/flang/test/Lower/entry.f90 +++ b/flang/test/Lower/entry.f90 @@ -1,5 +1,19 @@ ! RUN: bbc -emit-fir -o - %s | FileCheck %s +program entries + character(10) hh, qq, m + integer mm + call ss(mm); print*, mm + call e1(mm, 17); print*, mm + call e2(17, mm); print*, mm + call e3(mm); print*, mm + print*, jj(11) + print*, rr(22) + m = 'abcd efgh' + print*, hh(m) + print*, qq(m) +end + ! CHECK-LABEL: func @_QPss(%arg0: !fir.ref) subroutine ss(n1) ! CHECK: fir.alloca i32 {name = "nx"} @@ -43,20 +57,6 @@ function jj(n1) rr = rr + n2 end -program entries - character(10) hh, qq, m - integer mm - call ss(mm); print*, mm - call e1(mm, 17); print*, mm - call e2(17, mm); print*, mm - call e3(mm); print*, mm - print*, jj(11) - print*, rr(22) - m = 'abcd efgh' - print*, hh(m) - print*, qq(m) -end - ! CHECK-LABEL: func @_QPhh(%arg0: !fir.ref>, %arg1: index, %arg2: ! !fir.boxchar<1>) -> !fir.boxchar<1> function hh(c1) From 161828990d19390c89de1fea32c45a94628a485c Mon Sep 17 00:00:00 2001 From: V Donaldson Date: Tue, 4 Aug 2020 15:36:10 -0700 Subject: [PATCH 0216/1017] review update --- flang/test/Lower/altalt.f90 | 19 ------------------- flang/test/Lower/altret.f90 | 17 +++++++++++++++++ 2 files changed, 17 insertions(+), 19 deletions(-) delete mode 100644 flang/test/Lower/altalt.f90 diff --git a/flang/test/Lower/altalt.f90 b/flang/test/Lower/altalt.f90 deleted file mode 100644 index 229af5b716dd4..0000000000000 --- a/flang/test/Lower/altalt.f90 +++ /dev/null @@ -1,19 +0,0 @@ -! RUN: bbc -emit-fir -o - %s | FileCheck %s - - ! CHECK-LABEL: func @_QPss - subroutine ss(n) - print*, n - ! CHECK: return{{$}} - return - ! CHECK-LABEL: func @_QPee - entry ee(n,*) - ! CHECK: return %{{.}} : index - return 1 - end - - ! CHECK-LABEL: func @_QQmain - call ss(7) - call ee(2, *11) - print*, 'default' -11 print*, 11 - end diff --git a/flang/test/Lower/altret.f90 b/flang/test/Lower/altret.f90 index fa36bdd4e74be..48cb54d0ed625 100644 --- a/flang/test/Lower/altret.f90 +++ b/flang/test/Lower/altret.f90 @@ -1,6 +1,23 @@ ! RUN: bbc -emit-fir -o - %s | FileCheck %s +! CHECK-LABEL: func @_QPss +subroutine ss(n) + print*, n + ! CHECK: return{{$}} + return +! CHECK-LABEL: func @_QPee +entry ee(n,*) + print*, n + ! CHECK: return %{{.}} : index + return 1 +end + ! CHECK-LABEL: func @_QQmain + call ss(7) + call ee(2, *3) + print*, 'default' +3 print*, 3 + print*, k(10,20) print*, k(15,15) print*, k(20,10) From 3f0f4a734f1183a6866a28b5d42151a785a302f7 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 29 Jul 2020 17:13:56 -0700 Subject: [PATCH 0217/1017] refactor for equivalence - this cleans up some of the code in pft::Variable - fixes the issues from fm023 with equivalence lowering (#329) - improved dump utilities --- flang/include/flang/Lower/PFTBuilder.h | 163 +++++++++++++++++++----- flang/include/flang/Semantics/symbol.h | 2 +- flang/lib/Lower/Bridge.cpp | 101 +++++++++------ flang/lib/Lower/PFTBuilder.cpp | 166 +++++++++++++++++++------ 4 files changed, 323 insertions(+), 109 deletions(-) diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index b778250d311c3..7d4e3da3af47d 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -33,6 +33,11 @@ class SemanticsContext; class Scope; } // namespace semantics namespace lower { + +/// Disambiguate between variables that are declared inside a COMMON block and +/// variables that slide into a COMMON block by EQUIVALENCE. +bool declaredInCommonBlock(const semantics::Symbol &sym); + namespace pft { struct Evaluation; @@ -361,61 +366,155 @@ struct ProgramUnit : ProgramVariant { /// Fortran EQUIVALENCE statements are a mechanism that introduces aliasing /// between named variables. The set of overlapping aliases will materialize a /// generic store object with a designated offset and size. Participant -/// symbols will simply be pointers into the primary store. +/// symbols will simply be pointers into the aggregate store. +/// +/// EQUIVALENCE can also interact with COMMON and other global variables to +/// imply aliasing between (subparts of) a global and other local variable +/// names. /// /// Properties can be applied by lowering. For example, a local array that is /// known to be very large may be transformed into a heap allocated entity by /// lowering. That decision would be tracked in its Variable instance. struct Variable { - using StoreInterval = std::tuple; + /// Most variables are nominal and require the allocation of local/global + /// storage space. A nominal variable may also be an alias for some other + /// (subpart) of storage. + struct Nominal { + Nominal(const semantics::Symbol *symbol, int depth, bool global) + : symbol{symbol}, depth{depth}, global{global} {} + const semantics::Symbol *symbol{}; + int depth{}; + bool global{}; + bool heapAlloc{}; // variable needs deallocation on exit + bool pointer{}; + bool target{}; + bool aliaser{}; // participates in EQUIVALENCE union + std::size_t aliasOffset{}; + }; + + using Interval = std::tuple; + + /// An interval of storage is a contiguous block of memory to be allocated or + /// mapped onto another variable. Aliaser variables will be pointers into + /// interval stores and may overlap each other. + struct IntervalStore { + IntervalStore(Interval &&interval, bool global) + : interval{std::move(interval)}, global{global} {} + IntervalStore(Interval &&interval, bool global, + const semantics::Symbol *obj, std::size_t offset) + : interval{std::move(interval)}, global{global}, obj{obj}, + offset{offset} {} + Interval interval{}; + bool global{}; + const semantics::Symbol *obj{}; + std::size_t offset{}; // offset of obj relative to interval + }; + explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false, int depth = 0) - : u{&sym}, depth{depth}, global{global} {} - explicit Variable(StoreInterval &&store, bool global = false) - : u{std::move(store)}, depth{0}, global{global} {} + : var{Nominal(&sym, depth, global)} {} + explicit Variable(Interval &&interval, bool global = false) + : var{IntervalStore(std::move(interval), global)} {} + explicit Variable(IntervalStore &&istore) : var{std::move(istore)} {} + /// Return the front-end symbol for a nominal variable. const Fortran::semantics::Symbol &getSymbol() const { assert(hasSymbol()); - return *std::get(u); + return *std::get(var).symbol; } - const StoreInterval &getPrimaryStore() const { - assert(isPrimaryStore()); - return std::get(u); + /// Return the aggregate store. + const IntervalStore &getAggregateStore() const { + assert(isAggregateStore()); + return std::get(var); } - bool hasSymbol() const { - return std::holds_alternative(u); + /// Return the interval range of an aggregate store. + const Interval &getInterval() const { + assert(isAggregateStore()); + return std::get(var).interval; } - bool isPrimaryStore() const { return !hasSymbol(); } - bool isGlobal() const { return global; } - bool isHeapAlloc() const { return heapAlloc; } - bool isPointer() const { return pointer; } - bool isTarget() const { return target; } - int getDepth() const { return depth; } - bool isAlias() const { return aliasee; } - std::size_t getAlias() const { return aliasOffset; } + /// Only nominal variable have front-end symbols. + bool hasSymbol() const { return std::holds_alternative(var); } + + /// Is this an aggregate store? + bool isAggregateStore() const { + return std::holds_alternative(var); + } + + /// Is this variable a global? + bool isGlobal() const { + return std::visit([](const auto &x) { return x.global; }, var); + } + + bool isHeapAlloc() const { + if (auto *s = std::get_if(&var)) + return s->heapAlloc; + return false; + } + bool isPointer() const { + if (auto *s = std::get_if(&var)) + return s->pointer; + return false; + } + bool isTarget() const { + if (auto *s = std::get_if(&var)) + return s->target; + return false; + } + + /// An alias(er) is a variable that is part of a EQUIVALENCE that is allocated + /// locally on the stack. + bool isAlias() const { + if (auto *s = std::get_if(&var)) + return s->aliaser; + return false; + } + std::size_t getAlias() const { + if (auto *s = std::get_if(&var)) + return s->aliasOffset; + return 0; + } void setAlias(std::size_t offset) { - aliasee = true; - aliasOffset = offset; + if (auto *s = std::get_if(&var)) { + s->aliaser = true; + s->aliasOffset = offset; + } else { + llvm_unreachable("not a nominal var"); + } } - void setHeapAlloc(bool to = true) { heapAlloc = to; } - void setPointer(bool to = true) { pointer = to; } - void setTarget(bool to = true) { target = to; } + void setHeapAlloc(bool to = true) { + if (auto *s = std::get_if(&var)) + s->heapAlloc = to; + else + llvm_unreachable("not a nominal var"); + } + void setPointer(bool to = true) { + if (auto *s = std::get_if(&var)) + s->pointer = to; + else + llvm_unreachable("not a nominal var"); + } + void setTarget(bool to = true) { + if (auto *s = std::get_if(&var)) + s->target = to; + else + llvm_unreachable("not a nominal var"); + } + + /// The depth is recorded for nominal variables as a debugging aid. + int getDepth() const { + if (auto *s = std::get_if(&var)) + return s->depth; + return 0; + } LLVM_DUMP_METHOD void dump() const; private: - std::variant u; - int depth; - bool global; - bool heapAlloc{false}; // variable needs deallocation on exit - bool pointer{false}; - bool target{false}; - bool aliasee{false}; // participates in EQUIVALENCE union - std::size_t aliasOffset{}; + std::variant var; }; /// Function-like units may contain evaluations (executable statements) and diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index 600a10ec362b8..8072609209a04 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -653,7 +653,7 @@ class Symbol { const DerivedTypeSpec *GetParentTypeSpec(const Scope * = nullptr) const; SemanticsContext &GetSemanticsContext() const; - LLVM_DUMP_METHOD void dump() { llvm::errs() << *this << '\n'; } + LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this << '\n'; } private: const Scope *owner_; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 9d63c475a2dc2..172b52cd9c4bd 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1678,6 +1678,22 @@ class FirConverter : public Fortran::lower::AbstractConverter { } return; } + if (var.isAlias()) { + auto aliasOffset = var.getAlias(); + assert(storeMap.count(aliasOffset)); + auto store = storeMap.find(aliasOffset)->second; + auto i8Ty = builder->getIntegerType(8); + auto i8Ptr = builder->getRefType(i8Ty); + auto seqTy = builder->getRefType(builder->getVarLenSeqTy(i8Ty)); + auto base = builder->createConvert(loc, seqTy, store); + llvm::SmallVector offs{ + builder->createIntegerConstant(loc, idxTy, aliasOffset)}; + auto ptr = builder->create(loc, i8Ptr, base, offs); + auto addrOf = + builder->createConvert(loc, builder->getRefType(genType(sym)), ptr); + addSymbol(sym, addrOf); + return; + } if (const auto *details = sym.detailsIf()) { // FIXME: an exported module variable will have external linkage. @@ -1834,18 +1850,34 @@ class FirConverter : public Fortran::lower::AbstractConverter { return local; } - /// This is a primary store for a set of EQUIVALENCED variables. Create the + /// This is an aggregate store for a set of EQUIVALENCED variables. Create the /// store on the stack and add it to the map. - void - instantiatePrimaryStore(const Fortran::lower::pft::Variable &var, - llvm::DenseMap &storeMap) { - assert(var.isPrimaryStore()); - // Allocate an anonymous block of memory. - auto off = std::get<0>(var.getPrimaryStore()); - auto size = std::get<1>(var.getPrimaryStore()); + void instantiateAggregateStore( + const Fortran::lower::pft::Variable &var, + llvm::DenseMap &storeMap) { + assert(var.isAggregateStore()); + auto off = std::get<0>(var.getInterval()); auto i8Ty = builder->getIntegerType(8); auto loc = toLocation(); auto idxTy = builder->getIndexType(); + if (var.isGlobal()) { + auto &st = var.getAggregateStore(); + // global address must already be in the map + auto addr = lookupSymbol(*st.obj); + assert(addr && "global variable must already be in map"); + auto i8PtrTy = builder->getRefType(builder->getVarLenSeqTy(i8Ty)); + auto i8Addr = builder->createConvert(loc, i8PtrTy, addr); + // adjust for displacement of the global variable relative to the + // aggregate interval + llvm::SmallVector offs = { + builder->createIntegerConstant(loc, idxTy, off - st.offset)}; + auto stAddr = + builder->create(loc, i8PtrTy, i8Addr, offs); + storeMap[off] = stAddr; + return; + } + // Allocate an anonymous block of memory. + auto size = std::get<1>(var.getInterval()); llvm::SmallVector shape = { builder->createIntegerConstant(loc, idxTy, size)}; auto local = @@ -1858,34 +1890,26 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// which its properties depend will already have been visited. void instantiateLocal(const Fortran::lower::pft::Variable &var, llvm::DenseMap &storeMap) { - mlir::Value preAlloc; const auto &sym = var.getSymbol(); const auto loc = genLocation(sym.name()); auto idxTy = builder->getIndexType(); - if (var.isAlias()) { - // If var is an alias, then use the alias offset to lookup the - // corresponding primary storage for this alias set. The primary storage - // must have already been instantiated and added to the `storeMap`. Note - // that this does not handle EQUIVALENCED globals. Assumably those will be - // like COMMON blocks. - if (preAlloc) { - llvm::errs() << "TODO: EQUIVALENCE used on variable in COMMON\n"; - exit(1); - } - assert(!preAlloc && "cannot be in COMMON"); - auto aliasOffset = var.getAlias(); - assert(storeMap.count(aliasOffset)); - auto store = storeMap.find(aliasOffset)->second; - auto i8Ty = builder->getIntegerType(8); - auto i8Ptr = builder->getRefType(i8Ty); - auto seqTy = builder->getRefType(builder->getVarLenSeqTy(i8Ty)); - auto base = builder->createConvert(loc, seqTy, store); - llvm::SmallVector offs{builder->createIntegerConstant( - loc, idxTy, sym.offset() - aliasOffset)}; - auto ptr = builder->create(loc, i8Ptr, base, offs); - preAlloc = - builder->createConvert(loc, builder->getRefType(genType(sym)), ptr); + if (!var.isAlias()) { + mapSymbolAttributes(var, storeMap, mlir::Value{}); + return; } + auto aliasOffset = var.getAlias(); + assert(storeMap.count(aliasOffset)); + auto store = storeMap.find(aliasOffset)->second; + auto i8Ty = builder->getIntegerType(8); + auto i8Ptr = builder->getRefType(i8Ty); + auto seqTy = builder->getRefType(builder->getVarLenSeqTy(i8Ty)); + auto base = builder->createConvert(loc, seqTy, store); + llvm::SmallVector offs{ + builder->createIntegerConstant(loc, idxTy, sym.offset() - aliasOffset)}; + auto ptr = builder->create(loc, i8Ptr, base, offs); + auto preAlloc = + builder->createConvert(loc, builder->getRefType(genType(sym)), ptr); + mapSymbolAttributes(var, storeMap, preAlloc); } @@ -2129,11 +2153,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { void instantiateVar(const Fortran::lower::pft::Variable &var, llvm::DenseMap &storeMap) { - if (var.isPrimaryStore()) - instantiatePrimaryStore(var, storeMap); - else if (auto *common = - Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) - instantiateCommon(*common, var, storeMap); + if (var.isAggregateStore()) + instantiateAggregateStore(var, storeMap); + else if (Fortran::lower::declaredInCommonBlock(var.getSymbol())) + instantiateCommon( + *Fortran::semantics::FindCommonBlockContaining(var.getSymbol()), var, + storeMap); else if (var.isGlobal()) instantiateGlobal(var, storeMap); else @@ -2192,7 +2217,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { deferredFuncResultList; llvm::DenseMap storeMap; for (const auto &var : funit.getOrderedSymbolTable()) { - if (var.isPrimaryStore()) { + if (var.isAggregateStore()) { instantiateVar(var, storeMap); continue; } diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 4c48de2c66e9b..838fde744000a 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -12,6 +12,7 @@ #include "flang/Parser/parse-tree-visitor.h" #include "flang/Semantics/semantics.h" #include "flang/Semantics/tools.h" +#include "llvm/ADT/DenseSet.h" #include "llvm/ADT/IntervalMap.h" #include "llvm/Support/CommandLine.h" @@ -308,7 +309,10 @@ class PFTBuilder { // Link to the entry's first executable statement. entryPointList[entryIndex].second->lexicalSuccessor = p; } else if (const auto *entryStmt = p->getIf()) { - const auto *sym = std::get(entryStmt->t).symbol; + const auto *sym = std::get(entryStmt->t).symbol; + if (sym->IsFuncResult()) + // Switch to the function sym. + sym = sym->owner().parent().FindSymbol(sym->name()); assert(sym->has() && "entry must be a subprogram"); entryPointList.push_back(std::pair{sym, p}); @@ -761,11 +765,11 @@ class PFTBuilder { int entryCount = unit->entryPointList.size(); if (entryCount == 1) return; - llvm::DenseMap dummyCountMap; + llvm::DenseMap dummyCountMap; for (int entryIndex = 0; entryIndex < entryCount; ++entryIndex) { unit->setActiveEntry(entryIndex); - const auto &details = unit->getSubprogramSymbol() - .get(); + const auto &details = + unit->getSubprogramSymbol().get(); for (auto *arg : details.dummyArgs()) { if (!arg) continue; // alternate return specifier (no actual argument) @@ -1015,6 +1019,8 @@ Fortran::lower::pft::Evaluation::getOwningProcedure() const { } namespace { +/// Interval set to keep track of intervals, merging them when they overlap or +/// abut one another. Used to refine ranges of offsets. struct IntervalSet : public llvm::IntervalMap { using IntervalMap::IntervalMap; using Allocator = IntervalMap::Allocator; @@ -1037,6 +1043,28 @@ struct IntervalSet : public llvm::IntervalMap { }; } // namespace +// A variable with an offset relative to the subprogram stack but equivalence +// aliasing a variable in a common will also be marked as contained in a common +// block. We have to filter this out so that we can correctly map the offsets. +bool Fortran::lower::declaredInCommonBlock( + const semantics::Symbol &sym) { + if (auto *common = semantics::FindCommonBlockContaining(sym)) { + auto &details = common->get(); + for (auto &s : details.objects()) + if (&*s == &sym) + return true; + } + return false; +} + +/// Is the symbol `sym` a global? +static bool symbolIsGlobal(const semantics::Symbol &sym) { + if (const auto *details = sym.detailsIf()) + if (details->init()) + return true; + return semantics::IsSaved(sym) || lower::declaredInCommonBlock(sym); +} + namespace { /// This helper class is for sorting the symbols in the symbol table. We want /// the symbols in an order such that a symbol will be visited after those it @@ -1047,29 +1075,74 @@ struct SymbolDependenceDepth { std::vector> &vars) : vars{vars} {} + const semantics::Symbol *setHasGlobalParticipant( + const std::vector &set, + const llvm::DenseSet &globals) { + for (const auto &eqv : set) + if (globals.find(&eqv.symbol) != globals.end()) + return &eqv.symbol; + return nullptr; + } + + std::pair + getIntervalForSet(IntervalSet &intervals, + const std::vector &set, + const llvm::DenseSet &globals) { + for (const auto &eqv : set) + if (globals.find(&eqv.symbol) == globals.end()) { + auto off = eqv.symbol.offset(); + return {intervals.find(off), off}; + } + return {intervals.end(), 0}; + } + // Analyze the equivalence sets. This analysis need not be performed when the // scope has no equivalence sets. void analyzeAliases(const semantics::Scope &scope) { IntervalSet::Allocator allocator; IntervalSet intervals(allocator); + llvm::DenseSet globals; - // Collect the offset ranges which have aliasing. + // 1. Collect the offset ranges which have aliasing. for (const auto &set : scope.equivalenceSets()) for (const auto &eqv : set) { const auto &sym = eqv.symbol; + if (symbolIsGlobal(sym)) { + // This symbol's offset is into a COMMON block rather than the stack + // frame proxy, so do not add it to the interval map. Reprocess the + // sets in step 2. + globals.insert(&sym); + continue; + } aliasSyms.insert(&sym); intervals.merge(sym.offset(), sym.offset() + sym.size() - 1); } - // Create a primary store for each aliased interval. - adjustSize(1); - for (auto i = intervals.begin(), end = intervals.end(); i != end; ++i) { - vars[0].emplace_back( - lower::pft::Variable::StoreInterval{i.start(), - i.stop() - i.start() + 1}, - /*isGlobal=*/false); - stores.emplace_back(i.start(), i.stop() + 1); - } + // 2. If we saw a global in an equivalence set, we want to map the + // corresponding interval to a global alias, possibly with an offset + // internal to that global. We assume that the front-end has already handled + // all error cases, such as two distinct common blocks being equivalenced. + if (!globals.empty()) + for (const auto &set : scope.equivalenceSets()) + if (const auto *gsym = setHasGlobalParticipant(set, globals)) { + auto [iter, off] = getIntervalForSet(intervals, set, globals); + if (iter != intervals.end()) { + // record the global that's aliased (?) + stores.emplace_back( + lower::pft::Variable::Interval{iter.start(), + iter.stop() - iter.start() + 1}, + /*isGlobal=*/true, gsym, off); + // reset this interval and don't create an aggregate store on stack + iter.setValue(0); + } + } + + // 3. Create a aggregate store for each aliased interval. + for (auto i = intervals.begin(), end = intervals.end(); i != end; ++i) + if (i.value()) + stores.emplace_back( + lower::pft::Variable::Interval{i.start(), i.stop() - i.start() + 1}, + /*isGlobal=*/false); } // Recursively visit each symbol to determine the height of its dependence on @@ -1096,7 +1169,7 @@ struct SymbolDependenceDepth { const auto *symTy = sym.GetType(); assert(symTy && "symbol must have a type"); - // Make sure an aliasing variable appears after its primary storage. + // Make sure an aliasing variable appears after its aggregate storage. if (!aliasSyms.empty()) if (aliasSyms.find(&sym) != aliasSyms.end()) depth = std::max(1, depth); @@ -1143,7 +1216,7 @@ struct SymbolDependenceDepth { vars[depth].back().setTarget(); // If there are alias sets, then link the participating variables to their - // primary stores when constructing the new variable on the list. + // aggregate stores when constructing the new variable on the list. if (!aliasSyms.empty()) if (aliasSyms.find(&sym) != aliasSyms.end()) { if (global) @@ -1152,8 +1225,8 @@ struct SymbolDependenceDepth { // Fortran program. auto findStore = [&](std::size_t off) -> std::size_t { for (auto v : stores) { - auto bot = std::get<0>(v); - if (off >= bot && off < std::get<1>(v)) + auto bot = std::get<0>(v.interval); + if (off >= bot && off < bot + std::get<1>(v.interval)) return bot; } llvm_unreachable("the store must be present"); @@ -1163,7 +1236,19 @@ struct SymbolDependenceDepth { return depth; } - // Save the final list of symbols as a single vector and free the rest. + /// Process the stores built for overlapping nominal variables. + void prepareStores() { + for (auto st : stores) { + int depth = 0; + if (st.global) + depth = analyze(*st.obj); + adjustSize(depth + 1); + vars[depth].emplace_back(std::move(st)); + } + } + + /// Save the final list of variable allocations as a single vector and free + /// the rest. void finalize() { for (int i = 1, end = vars.size(); i < end; ++i) vars[0].insert(vars[0].end(), vars[i].begin(), vars[i].end()); @@ -1180,7 +1265,7 @@ struct SymbolDependenceDepth { llvm::SmallSet seen; std::vector> &vars; llvm::SmallSet aliasSyms; - std::vector> stores; + std::vector stores; }; } // namespace @@ -1189,6 +1274,7 @@ void Fortran::lower::pft::FunctionLikeUnit::processSymbolTable( SymbolDependenceDepth sdd{varList}; if (!scope.equivalenceSets().empty()) sdd.analyzeAliases(scope); + sdd.prepareStores(); for (const auto &iter : scope) sdd.analyze(iter.second.get()); sdd.finalize(); @@ -1290,25 +1376,29 @@ void Fortran::lower::pft::Evaluation::dump() const { } void Fortran::lower::pft::Variable::dump() const { - if (auto *sym = std::get_if(&u)) - llvm::errs() << "symbol: " << (*sym)->name(); - else if (auto *store = std::get_if(&u)) - llvm::errs() << "interval[" << std::get<0>(*store) << ", " - << std::get<1>(*store) << "]:"; - else + if (auto *s = std::get_if(&var)) { + llvm::errs() << "symbol: " << s->symbol->name(); + llvm::errs() << " (depth: " << s->depth << ')'; + if (s->global) + llvm::errs() << ", global"; + if (s->heapAlloc) + llvm::errs() << ", allocatable"; + if (s->pointer) + llvm::errs() << ", pointer"; + if (s->target) + llvm::errs() << ", target"; + if (s->aliaser) + llvm::errs() << ", equivalence(" << s->aliasOffset << ')'; + } else if (auto *s = std::get_if(&var)) { + llvm::errs() << "interval[" << std::get<0>(s->interval) << ", " + << std::get<1>(s->interval) << "]:"; + if (s->global) + llvm::errs() << ", global"; + if (s->obj) + llvm::errs() << ", object:(" << *s->obj << "), offset: " << s->offset; + } else { llvm_unreachable("not a Variable"); - - llvm::errs() << " depth: " << depth; - if (global) - llvm::errs() << ", global"; - if (heapAlloc) - llvm::errs() << ", allocatable"; - if (pointer) - llvm::errs() << ", pointer"; - if (target) - llvm::errs() << ", target"; - if (aliasee) - llvm::errs() << ", equivalence(" << aliasOffset << ")"; + } llvm::errs() << '\n'; } From c71ccfb437706c5910a98bccaf7960c25ff20771 Mon Sep 17 00:00:00 2001 From: rajan Date: Wed, 5 Aug 2020 10:49:55 -0400 Subject: [PATCH 0218/1017] Array coordinate changes for lowering (#355) * updating ArrayCoorOp to use optional arguments. * generating ArrayCoorOp with shape in ConvertExpr --- flang/lib/Lower/ConvertExpr.cpp | 73 +++++++++++++++++++ flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 10 +-- .../Optimizer/Transforms/AffinePromotion.cpp | 10 +-- 3 files changed, 83 insertions(+), 10 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 82cfb02169a97..9e6a0eed934ae 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -29,11 +29,17 @@ #include "mlir/Dialect/Affine/IR/AffineOps.h" #include "mlir/Dialect/StandardOps/IR/Ops.h" #include "llvm/ADT/APFloat.h" +#include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorHandling.h" #include "llvm/Support/raw_ostream.h" #define TODO() llvm_unreachable("not yet implemented") +static llvm::cl::opt generateArrayCoordinate( + "gen-array-coor", + llvm::cl::desc("in lowering create ArrayCoorOp instead of CoordinateOp"), + llvm::cl::init(false)); + namespace { /// Lowering of Fortran::evaluate::Expr expressions @@ -1101,11 +1107,78 @@ class ExprLowering { si.box); } + fir::ExtendedValue genArrayCoorOp(const Fortran::lower::SymbolBox &si, + const Fortran::evaluate::ArrayRef &aref) { + auto loc = getLoc(); + auto addr = si.getAddr(); + auto arrTy = fir::dyn_cast_ptrEleTy(addr.getType()); + auto eleTy = arrTy.cast().getEleTy(); + auto refTy = builder.getRefType(eleTy); + auto arrShape = [&](const auto &arr) -> mlir::Value { + if (arr.getLBounds().empty()) { + auto shapeType = + fir::ShapeType::get(builder.getContext(), arr.getExtents().size()); + return builder.create(loc, shapeType, arr.getExtents()); + } + auto shapeType = fir::ShapeShiftType::get(builder.getContext(), + arr.getExtents().size()); + SmallVector shapeArgs; + for (const auto &pair : llvm::zip(arr.getLBounds(), arr.getExtents())) { + shapeArgs.push_back(std::get<0>(pair)); + shapeArgs.push_back(std::get<1>(pair)); + } + return builder.create(loc, shapeType, shapeArgs); + }; + auto genWithShape = [&](const auto &arr) -> mlir::Value { + auto shape = arrShape(arr); + llvm::SmallVector arrayCoorArgs; + for (const auto &sub : aref.subscript()) { + auto subVal = genComponent(sub); + if (auto *ev = std::get_if(&subVal)) { + if (auto *sval = ev->getUnboxed()) { + arrayCoorArgs.push_back(*sval); + } else { + TODO(); + } + } else { + // RangedBoxValue + TODO(); + } + } + return builder.create( + loc, refTy, addr, shape, mlir::Value{}, arrayCoorArgs, ValueRange()); + }; + return std::visit( + Fortran::common::visitors{ + [&](const Fortran::lower::SymbolBox::FullDim &arr) { + if (!inArrayContext() && isSlice(aref)) { + TODO(); + return mlir::Value{}; + } + return genWithShape(arr); + }, + [&](const Fortran::lower::SymbolBox::CharFullDim &arr) { + TODO(); + return mlir::Value{}; + }, + [&](const Fortran::lower::SymbolBox::Derived &arr) { + TODO(); + return mlir::Value{}; + }, + [&](const auto &) { + TODO(); + return mlir::Value{}; + }}, + si.box); + } + // Return the coordinate of the array reference fir::ExtendedValue gen(const Fortran::evaluate::ArrayRef &aref) { if (aref.base().IsSymbol()) { auto &symbol = aref.base().GetFirstSymbol(); auto si = symMap.lookupSymbol(symbol); + if (generateArrayCoordinate) + return genArrayCoorOp(si, aref); if (!si.hasConstantShape()) return gen(si, aref); auto box = gen(symbol); diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index bcb8b346e2aea..c4a727daae139 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -141,7 +141,7 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { matchAndRewrite(ArrayCoorOp arrCoor, mlir::PatternRewriter &rewriter) const override { auto loc = arrCoor.getLoc(); - auto shapeVal = arrCoor.getShape(); + auto shapeVal = arrCoor.shape(); auto shapeOp = dyn_cast(shapeVal.getDefiningOp()); llvm::SmallVector shapeOpers; llvm::SmallVector shiftOpers; @@ -158,11 +158,11 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); attrs.push_back( rewriter.getNamedAttr(XArrayCoorOp::rankAttrName(), rankAttr)); - auto lenParamSize = arrCoor.getLenParams().size(); + auto lenParamSize = arrCoor.lenParams().size(); auto lenParamAttr = rewriter.getIntegerAttr(idxTy, lenParamSize); attrs.push_back( rewriter.getNamedAttr(XArrayCoorOp::lenParamAttrName(), lenParamAttr)); - auto indexSize = arrCoor.getIndices().size(); + auto indexSize = arrCoor.indices().size(); auto idxAttr = rewriter.getIntegerAttr(idxTy, indexSize); attrs.push_back( rewriter.getNamedAttr(XArrayCoorOp::indexAttrName(), idxAttr)); @@ -171,7 +171,7 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { attrs.push_back( rewriter.getNamedAttr(XArrayCoorOp::shapeAttrName(), dimAttr)); llvm::SmallVector sliceOpers; - if (auto s = arrCoor.getSlice()) + if (auto s = arrCoor.slice()) if (auto sliceOp = dyn_cast_or_null(s.getDefiningOp())) sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); auto sliceAttr = rewriter.getIntegerAttr(idxTy, sliceOpers.size()); @@ -179,7 +179,7 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { rewriter.getNamedAttr(XArrayCoorOp::sliceAttrName(), sliceAttr)); auto xArrCoor = rewriter.create( loc, arrCoor.getType(), arrCoor.memref(), shapeOpers, shiftOpers, - sliceOpers, arrCoor.getIndices(), arrCoor.getLenParams(), attrs); + sliceOpers, arrCoor.indices(), arrCoor.lenParams(), attrs); rewriter.replaceOp(arrCoor, xArrCoor.getOperation()->getResults()); return mlir::success(); } diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index f8ce346f9c063..3f84361c76ebd 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -236,7 +236,7 @@ bool analyzeCoordinate(mlir::Value coordinate) { bool AffineLoopAnalysis::analyzeArrayReference(mlir::Value arrayRef) { bool canPromote = true; if (auto acoOp = arrayRef.getDefiningOp()) { - for (auto coordinate : acoOp.getIndices()) + for (auto coordinate : acoOp.indices()) canPromote = canPromote && analyzeCoordinate(coordinate); } else { LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: cannot promote loop, " @@ -311,12 +311,12 @@ mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) { std::pair createAffineOps(mlir::Value arrayRef, mlir::PatternRewriter &rewriter) { auto acoOp = arrayRef.getDefiningOp(); - assert(acoOp.getShape() && isa(acoOp.getShape().getDefiningOp())); - auto genDim = acoOp.getShape().getDefiningOp(); + assert(acoOp.shape() && isa(acoOp.shape().getDefiningOp())); + auto genDim = acoOp.shape().getDefiningOp(); auto affineMap = - createArrayIndexAffineMap(acoOp.getIndices().size(), acoOp.getContext()); + createArrayIndexAffineMap(acoOp.indices().size(), acoOp.getContext()); SmallVector indexArgs; - indexArgs.append(acoOp.getIndices().begin(), acoOp.getIndices().end()); + indexArgs.append(acoOp.indices().begin(), acoOp.indices().end()); // FIXME: quick hack for now (assumes 1 for the shift and stride) auto iter = genDim.extents().begin(); From 6df3ea80f6950299d6b91e7c60dd6eb4bda85616 Mon Sep 17 00:00:00 2001 From: zacharyselk Date: Wed, 5 Aug 2020 10:07:36 -0600 Subject: [PATCH 0219/1017] Fix ICHAR lowering for issue #323 --- flang/lib/Lower/IntrinsicCall.cpp | 265 ++++++++++++++++++++++-------- flang/test/Lower/intrinsics.f90 | 6 + 2 files changed, 206 insertions(+), 65 deletions(-) diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp index cd77a5ad419b2..c952df9f8a7a1 100644 --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -22,12 +22,15 @@ #include "flang/Lower/FIRBuilder.h" #include "flang/Lower/Mangler.h" #include "flang/Lower/Runtime.h" +#include "flang/Lower/Todo.h" #include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorHandling.h" #include #include #include +#define DEBUG_TYPE "flang-lower-intrinsic" + #define PGMATH_DECLARE #include "../runtime/pgmath.h.inc" @@ -100,7 +103,7 @@ struct IntrinsicLibrary { /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg /// and expected result type \p resultType. fir::ExtendedValue genIntrinsicCall(llvm::StringRef name, - mlir::Type resultType, + llvm::Optional resultType, llvm::ArrayRef arg); /// Search a runtime function that is associated to the generic intrinsic name @@ -125,14 +128,16 @@ struct IntrinsicLibrary { mlir::Value genAint(mlir::Type, llvm::ArrayRef); mlir::Value genAnint(mlir::Type, llvm::ArrayRef); mlir::Value genCeiling(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef); mlir::Value genConjg(mlir::Type, llvm::ArrayRef); + void genDateAndTime(llvm::ArrayRef); mlir::Value genDim(mlir::Type, llvm::ArrayRef); mlir::Value genDprod(mlir::Type, llvm::ArrayRef); template mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); mlir::Value genFloor(mlir::Type, llvm::ArrayRef); mlir::Value genIAnd(mlir::Type, llvm::ArrayRef); - mlir::Value genIchar(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef); mlir::Value genIEOr(mlir::Type, llvm::ArrayRef); mlir::Value genIOr(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef); @@ -150,7 +155,9 @@ struct IntrinsicLibrary { /// generate the related code. using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs); using ExtendedGenerator = decltype(&IntrinsicLibrary::genLenTrim); - using Generator = std::variant; + using SubroutineGenerator = decltype(&IntrinsicLibrary::genDateAndTime); + using Generator = + std::variant; /// All generators can be outlined. This will build a function named /// "fir."+ + "." + and generate the @@ -162,9 +169,11 @@ struct IntrinsicLibrary { mlir::Value outlineInWrapper(GeneratorType, llvm::StringRef name, mlir::Type resultType, llvm::ArrayRef args); - fir::ExtendedValue outlineInWrapper(ExtendedGenerator, llvm::StringRef name, - mlir::Type resultType, - llvm::ArrayRef args); + template + fir::ExtendedValue + outlineInExtendedWrapper(GeneratorType, llvm::StringRef name, + llvm::Optional resultType, + llvm::ArrayRef args); template mlir::FuncOp getWrapper(GeneratorType, llvm::StringRef name, @@ -186,6 +195,8 @@ struct IntrinsicLibrary { mlir::Value invokeGenerator(ExtendedGenerator generator, mlir::Type resultType, llvm::ArrayRef args); + mlir::Value invokeGenerator(SubroutineGenerator generator, + llvm::ArrayRef args); /// Get pointer to unrestricted intrinsic. Generate the related unrestricted /// intrinsic if it is not defined yet. @@ -209,16 +220,18 @@ struct IntrinsicHandler { /// more readable. bool outline = false; }; + using I = IntrinsicLibrary; static constexpr IntrinsicHandler handlers[]{ {"abs", &I::genAbs}, - {"achar", &I::genConversion}, + {"achar", &I::genChar}, {"aimag", &I::genAimag}, {"aint", &I::genAint}, {"anint", &I::genAnint}, {"ceiling", &I::genCeiling}, - {"char", &I::genConversion}, + {"char", &I::genChar}, {"conjg", &I::genConjg}, + {"date_and_time", &I::genDateAndTime}, {"dim", &I::genDim}, {"dble", &I::genConversion}, {"dprod", &I::genDprod}, @@ -580,13 +593,17 @@ static mlir::FuncOp getRuntimeFunction(mlir::Location loc, /// Helpers to get function type from arguments and result type. static mlir::FunctionType -getFunctionType(mlir::Type resultType, llvm::ArrayRef arguments, +getFunctionType(llvm::Optional resultType, + llvm::ArrayRef arguments, Fortran::lower::FirOpBuilder &builder) { - llvm::SmallVector argumentTypes; + llvm::SmallVector argTypes; for (auto &arg : arguments) - argumentTypes.push_back(arg.getType()); - return mlir::FunctionType::get(builder.getModule().getContext(), - argumentTypes, resultType); + argTypes.push_back(arg.getType()); + llvm::SmallVector resTypes; + if (resultType) + resTypes.push_back(*resultType); + return mlir::FunctionType::get(builder.getModule().getContext(), argTypes, + resTypes); } /// fir::ExtendedValue to mlir::Value translation layer @@ -601,7 +618,8 @@ fir::ExtendedValue toExtendedValue(mlir::Value val, llvm::SmallVector extents; Fortran::lower::CharacterExprHelper charHelper{builder, loc}; - if (charHelper.isCharacter(type)) + // FIXME: we may want to allow non character scalar here. + if (charHelper.isCharacterScalar(type)) return charHelper.toExtendedValue(val); if (auto refType = type.dyn_cast()) @@ -683,28 +701,76 @@ IntrinsicLibrary::genElementalCall( exit(1); } if (outline) - return outlineInWrapper(generator, name, resultType, args); + return outlineInExtendedWrapper(generator, name, resultType, args); return std::invoke(generator, *this, resultType, args); } +static fir::ExtendedValue +invokeHandler(IntrinsicLibrary::ElementalGenerator generator, + const IntrinsicHandler &handler, + llvm::Optional resultType, + llvm::ArrayRef args, bool outline, + IntrinsicLibrary &lib) { + assert(resultType && "expect elemental intrinsic to be functions"); + return lib.genElementalCall(generator, handler.name, *resultType, args, + outline); +} + +static fir::ExtendedValue +invokeHandler(IntrinsicLibrary::ExtendedGenerator generator, + const IntrinsicHandler &handler, + llvm::Optional resultType, + llvm::ArrayRef args, bool outline, + IntrinsicLibrary &lib) { + assert(resultType && "expect intrinsic function"); + if (handler.isElemental) + return lib.genElementalCall(generator, handler.name, *resultType, args, + outline); + if (outline) + return lib.outlineInExtendedWrapper(generator, handler.name, *resultType, + args); + return std::invoke(generator, lib, *resultType, args); +} +static fir::ExtendedValue +invokeHandler(IntrinsicLibrary::SubroutineGenerator generator, + const IntrinsicHandler &handler, + llvm::Optional resultType, + llvm::ArrayRef args, bool outline, + IntrinsicLibrary &lib) { + if (outline) + return lib.outlineInExtendedWrapper(generator, handler.name, resultType, + args); + std::invoke(generator, lib, args); + return mlir::Value{}; +} + +/// Many intrinsics are not yet lowered, provide a clear error message to user +/// instead of hitting harder to understand asserts. +static void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name) { + mlir::emitError(loc, + "TODO: missing intrinsic lowering: " + llvm::Twine(name)); + exit(1); +} + fir::ExtendedValue -IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, mlir::Type resultType, +IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, + llvm::Optional resultType, llvm::ArrayRef args) { for (auto &handler : handlers) if (name == handler.name) { bool outline = handler.outline || outlineAllIntrinsics; - if (const auto *elementalGenerator = - std::get_if(&handler.generator)) - return genElementalCall(*elementalGenerator, name, resultType, args, - outline); - const auto &generator = std::get(handler.generator); - if (handler.isElemental) - return genElementalCall(generator, name, resultType, args, outline); - if (outline) - return outlineInWrapper(generator, name, resultType, args); - return std::invoke(generator, *this, resultType, args); + return std::visit( + [&](auto &generator) -> fir::ExtendedValue { + return invokeHandler(generator, handler, resultType, args, outline, + *this); + }, + handler.generator); } + if (!resultType) + // Subroutine should have a handler, they are likely missing for now. + crashOnMissingIntrinsic(loc, name); + // Try the runtime if no special handler was defined for the // intrinsic being called. Maths runtime only has numerical elemental. // No optional arguments are expected at this point, the code will @@ -714,20 +780,17 @@ IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, mlir::Type resultType, llvm::SmallVector mlirArgs; for (const auto &extendedVal : args) { auto val = toValue(extendedVal, builder, loc); - if (!val) { + if (!val) // If an absent optional gets there, most likely its handler has just // not yet been defined. - mlir::emitError(loc, - "TODO: missing intrinsic lowering: " + llvm::Twine(name)); - exit(1); - } + crashOnMissingIntrinsic(loc, name); mlirArgs.emplace_back(val); } mlir::FunctionType soughtFuncType = - getFunctionType(resultType, mlirArgs, builder); + getFunctionType(*resultType, mlirArgs, builder); auto runtimeCallGenerator = getRuntimeCallGenerator(name, soughtFuncType); - return genElementalCall(runtimeCallGenerator, name, resultType, args, + return genElementalCall(runtimeCallGenerator, name, *resultType, args, /* outline */ true); } @@ -756,14 +819,21 @@ IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator, return toValue(extendedResult, builder, loc); } +mlir::Value +IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator, + llvm::ArrayRef args) { + llvm::SmallVector extendedArgs; + for (auto arg : args) + extendedArgs.emplace_back(toExtendedValue(arg, builder, loc)); + std::invoke(generator, *this, extendedArgs); + return mlir::Value{}; +} + template mlir::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator, llvm::StringRef name, mlir::FunctionType funcType, bool loadRefArguments) { - assert(funcType.getNumResults() == 1 && - "expect one result for intrinsic functions"); - auto resultType = funcType.getResult(0); std::string wrapperName = fir::mangleIntrinsicProcedure(name, funcType); auto function = builder.getNamedFunction(wrapperName); if (!function) { @@ -794,9 +864,18 @@ mlir::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator, } IntrinsicLibrary localLib{*localBuilder, localLoc}; - auto result = - localLib.invokeGenerator(generator, resultType, localArguments); - localBuilder->create(localLoc, result); + + if constexpr (std::is_same_v) { + localLib.invokeGenerator(generator, localArguments); + localBuilder->create(localLoc); + } else { + assert(funcType.getNumResults() == 1 && + "expect one result for intrinsic function wrapper type"); + auto resultType = funcType.getResult(0); + auto result = + localLib.invokeGenerator(generator, resultType, localArguments); + localBuilder->create(localLoc, result); + } } else { // Wrapper was already built, ensure it has the sought type assert(function.getType() == funcType && @@ -837,13 +916,14 @@ IntrinsicLibrary::outlineInWrapper(GeneratorType generator, auto funcType = getFunctionType(resultType, args, builder); auto wrapper = getWrapper(generator, name, funcType); - return builder.create(loc, wrapper, args).getResult(0); + return builder.create(loc, wrapper, args).getResult(0); } -fir::ExtendedValue -IntrinsicLibrary::outlineInWrapper(ExtendedGenerator generator, - llvm::StringRef name, mlir::Type resultType, - llvm::ArrayRef args) { +template +fir::ExtendedValue IntrinsicLibrary::outlineInExtendedWrapper( + GeneratorType generator, llvm::StringRef name, + llvm::Optional resultType, + llvm::ArrayRef args) { if (hasAbsentOptional(args)) { // TODO mlir::emitError(loc, "todo: cannot outline call to intrinsic " + @@ -856,9 +936,11 @@ IntrinsicLibrary::outlineInWrapper(ExtendedGenerator generator, mlirArgs.emplace_back(toValue(extendedVal, builder, loc)); auto funcType = getFunctionType(resultType, mlirArgs, builder); auto wrapper = getWrapper(generator, name, funcType); - auto mlirResult = - builder.create(loc, wrapper, mlirArgs).getResult(0); - return toExtendedValue(mlirResult, builder, loc); + auto call = builder.create(loc, wrapper, mlirArgs); + if (resultType) + return toExtendedValue(call.getResult(0), builder, loc); + // Subroutine calls + return mlir::Value{}; } IntrinsicLibrary::RuntimeCallGenerator @@ -881,10 +963,9 @@ IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name, Fortran::lower::FirOpBuilder &builder, mlir::Location loc, llvm::ArrayRef args) { llvm::SmallVector convertedArguments; - for (const auto &pair : llvm::zip(actualFuncType.getInputs(), args)) - convertedArguments.push_back( - builder.createConvert(loc, std::get<0>(pair), std::get<1>(pair))); - auto call = builder.create(loc, funcOp, convertedArguments); + for (auto [fst, snd] : llvm::zip(actualFuncType.getInputs(), args)) + convertedArguments.push_back(builder.createConvert(loc, fst, snd)); + auto call = builder.create(loc, funcOp, convertedArguments); mlir::Type soughtType = soughtFuncType.getResult(0); return builder.createConvert(loc, soughtType, call.getResult(0)); }; @@ -1011,6 +1092,23 @@ mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType, return builder.createConvert(loc, resultType, ceil); } +fir::ExtendedValue +IntrinsicLibrary::genChar(mlir::Type type, + llvm::ArrayRef args) { + // Optional KIND argument. + assert(args.size() >= 1); + auto *arg = args[0].getUnboxed(); + // expect argument to be a scalar integer + if (!arg) + mlir::emitError(loc, "CHAR intrinsic argument not unboxed"); + Fortran::lower::CharacterExprHelper helper{builder, loc}; + auto kind = helper.getCharacterType(type).getFKind(); + auto cast = helper.createSingletonFromCode(*arg, kind); + auto len = + builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1); + return fir::CharBoxValue{cast, len}; +} + // CONJG mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType, llvm::ArrayRef args) { @@ -1027,6 +1125,22 @@ mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType, cplx, negImag, /*isImagPart=*/true); } +// DATE_AND_TIME +void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef args) { + assert(args.size() == 4 && "date_and_time has 4 args"); + llvm::SmallVector, 3> charArgs(3); + for (auto i = 0; i < 3; ++i) + if (auto *charBox = args[i].getCharBox()) + charArgs[i] = *charBox; + // TODO: build descriptor for VALUES (also update runtime) + if (fir::getBase(args[3])) + mlir::emitError(loc, "TODO: lowering of DATE_AND_TIME VALUES argument not " + "yet implemented\n"); + + Fortran::lower::genDateAndTime(builder, loc, charArgs[0], charArgs[1], + charArgs[2]); +} + // DIM mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType, llvm::ArrayRef args) { @@ -1072,25 +1186,43 @@ mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType, mlir::Value IntrinsicLibrary::genIAnd(mlir::Type resultType, llvm::ArrayRef args) { assert(args.size() == 2); - return builder.create(loc, args[0], args[1]); } // ICHAR -mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType, - llvm::ArrayRef args) { +fir::ExtendedValue +IntrinsicLibrary::genIchar(mlir::Type resultType, + llvm::ArrayRef args) { // There can be an optional kind in second argument. - assert(args.size() >= 1); + assert(args.size() == 2); + auto charBox = args[0].getCharBox(); + if (!charBox) + llvm::report_fatal_error("expected character scalar"); - auto arg = args[0]; Fortran::lower::CharacterExprHelper helper{builder, loc}; - auto dataAndLen = helper.createUnboxChar(arg); - auto charType = fir::CharacterType::get( - builder.getContext(), helper.getCharacterKind(arg.getType()), 1); - auto refType = builder.getRefType(charType); - auto charAddr = builder.createConvert(loc, refType, dataAndLen.first); - auto charVal = builder.create(loc, charType, charAddr); - return builder.createConvert(loc, resultType, charVal); + auto buffer = charBox->getBuffer(); + auto bufferTy = buffer.getType(); + mlir::Value charVal; + if (auto charTy = bufferTy.dyn_cast()) { + assert(charTy.singleton()); + charVal = buffer; + } else { + // Character is in memory, cast to fir.ref and load. + auto ty = fir::dyn_cast_ptrEleTy(bufferTy); + if (!ty) + llvm::report_fatal_error("expected memory type"); + // The length of in the character type may be unknown. Casting + // to a singleton ref is required before loading. + auto eleType = helper.getCharacterType(ty); + auto charType = + fir::CharacterType::get(builder.getContext(), eleType.getFKind(), 1); + auto toTy = builder.getRefType(charType); + auto cast = builder.createConvert(loc, toTy, buffer); + charVal = builder.create(loc, cast); + } + LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n"); + auto code = helper.extractCodeFromSingleton(charVal); + return builder.createConvert(loc, resultType, code); } // IEOR @@ -1136,7 +1268,10 @@ IntrinsicLibrary::genLenTrim(mlir::Type resultType, // Optional KIND argument reflected in result type. assert(args.size() >= 1); Fortran::lower::CharacterExprHelper helper{builder, loc}; - auto len = helper.createLenTrim(fir::getBase(args[0])); + auto *charBox = args[0].getCharBox(); + if (!charBox) + TODO("character array len_trim"); + auto len = helper.createLenTrim(*charBox); return builder.createConvert(loc, resultType, len); } @@ -1271,7 +1406,7 @@ mlir::Value IntrinsicLibrary::genExtremum(mlir::Type, fir::ExtendedValue Fortran::lower::genIntrinsicCall(Fortran::lower::FirOpBuilder &builder, mlir::Location loc, llvm::StringRef name, - mlir::Type resultType, + llvm::Optional resultType, llvm::ArrayRef args) { return IntrinsicLibrary{builder, loc}.genIntrinsicCall(name, resultType, args); diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index a6dd4062192f7..3c92a980c7da8 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -181,8 +181,14 @@ end subroutine iand_test ! CHECK-LABEL: ichar_test subroutine ichar_test(c) character(1) :: c + character :: str(10) + ! CHECK: fir.load {{.*}} : !fir.ref> ! CHECK: fir.convert {{.*}} : (!fir.char<1>) -> i32 print *, ichar(c) + + ! CHECK: fir.extract_value {{.*}} : (!fir.array<1x!fir.char<1>>, i32) -> !fir.char<1> + ! CHECK: fir.convert {{.*}} : (!fir.char<1>) -> i32 + print *, ichar(str(J)) end subroutine ! IEOR From 2dc36610f84f0e5b7dbf82123e633c237f85eb38 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 6 Aug 2020 08:55:06 -0700 Subject: [PATCH 0220/1017] Fixes a bug in IO lowering when an array is used in a scalar context. --- flang/include/flang/Lower/CharacterExpr.h | 7 ++++++ flang/lib/Lower/CharacterExpr.cpp | 26 ++++++++++++++++++++++- 2 files changed, 32 insertions(+), 1 deletion(-) diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index 8840ec39b6f94..e5b9a3204534f 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -89,6 +89,13 @@ class CharacterExprHelper { /// - fir.ref> if str has dynamic length. std::pair materializeCharacter(mlir::Value str); + /// Return the (buffer, length) pair of `str`. Returns the obvious pair if + /// `str` is a scalar. However if `str` is an array of CHARACTER, this will + /// perform an implicit concatenation of the entire array. This implements the + /// implied semantics of using an array of CHARACTER in a scalar context. + std::pair + materializeCharacterOrSequence(mlir::Value str); + /// Return true if \p type is a character literal type (is /// fir.array>).; static bool isCharacterLiteral(mlir::Type type); diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index 4465f041376e7..15a2304cf607f 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -68,7 +68,7 @@ fir::CharBoxValue Fortran::lower::CharacterExprHelper::materializeValue( fir::CharBoxValue Fortran::lower::CharacterExprHelper::toDataLengthPair(mlir::Value character) { // TODO: get rid of toDataLengthPair when adding support for arrays - auto charBox = toExtendedValue(character).getCharBox(); + auto *charBox = toExtendedValue(character).getCharBox(); assert(charBox && "Array unsupported in character lowering helper"); return *charBox; } @@ -440,6 +440,30 @@ Fortran::lower::CharacterExprHelper::materializeCharacter(mlir::Value str) { return {box.getBuffer(), box.getLen()}; } +std::pair +Fortran::lower::CharacterExprHelper::materializeCharacterOrSequence( + mlir::Value str) { + if (auto ptrToTy = fir::dyn_cast_ptrEleTy(str.getType())) + if (auto seqTy = ptrToTy.dyn_cast()) { + // Handle linearization of an array in a scalar context. + auto eleTy = seqTy.getEleTy(); + assert(eleTy.isa() && seqTy.hasConstantShape()); + // Linearize the shape. + fir::SequenceType::Extent size = 1; + for (auto e : seqTy.getShape()) + size *= e; + fir::SequenceType::Shape newShape = {size}; + auto newTy = builder.getRefType(fir::SequenceType::get(newShape, eleTy)); + // Recast the buffer ref to look like a scalar. + auto buffer = builder.createConvert(loc, newTy, str); + // Cons the new cumulative length. + auto length = + builder.createIntegerConstant(loc, builder.getIndexType(), size); + return {buffer, length}; + } + return materializeCharacter(str); +} + bool Fortran::lower::CharacterExprHelper::isCharacterLiteral(mlir::Type type) { if (auto seqType = type.dyn_cast()) return (seqType.getShape().size() == 1) && From d00cd91bac2175e8caf3901a121345440c774e8b Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 6 Aug 2020 13:04:06 -0700 Subject: [PATCH 0221/1017] add LLVM_DEBUG --- flang/lib/Lower/CharacterExpr.cpp | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index 15a2304cf607f..623b6bd01ba54 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -10,6 +10,8 @@ #include "flang/Lower/ConvertType.h" #include "flang/Lower/DoLoopHelper.h" #include "flang/Lower/IntrinsicCall.h" +#include "llvm/Support/Debug.h" +#define DEBUG_TYPE "flang-lower-character" //===----------------------------------------------------------------------===// // CharacterExprHelper implementation @@ -62,6 +64,8 @@ fir::CharBoxValue Fortran::lower::CharacterExprHelper::materializeValue( return str; auto variable = builder.create(loc, str.getBuffer().getType()); builder.create(loc, str.getBuffer(), variable); + LLVM_DEBUG(llvm::dbgs() << "materialized as local: " << str << " -> (" + << variable << ", " << str.getLen() << ")\n"); return {variable, str.getLen()}; } From e770112054225875ae65a6d9660f9d38c2a8a6a3 Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Thu, 6 Aug 2020 17:35:48 -0700 Subject: [PATCH 0222/1017] Move toward compilation of module data (#358) * Move toward compilation of module data Remove DataStmt from the PFT (it's not needed), and do some of the set up for eventually processing module symbols. * review update --- flang/include/flang/Lower/PFTBuilder.h | 7 +-- flang/lib/Lower/Bridge.cpp | 11 ++--- flang/lib/Lower/PFTBuilder.cpp | 63 ++++++++++++++++---------- 3 files changed, 48 insertions(+), 33 deletions(-) diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 7d4e3da3af47d..f0c80fb11fdea 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -118,7 +118,7 @@ using ActionStmts = std::tuple< parser::AssignStmt, parser::AssignedGotoStmt, parser::PauseStmt>; using OtherStmts = std::tuple; + parser::NamelistStmt>; using ConstructStmts = std::tuple< parser::AssociateStmt, parser::EndAssociateStmt, parser::BlockStmt, @@ -547,8 +547,6 @@ struct FunctionLikeUnit : public ProgramUnit { FunctionLikeUnit(FunctionLikeUnit &&) = default; FunctionLikeUnit(const FunctionLikeUnit &) = delete; - void processSymbolTable(const Fortran::semantics::Scope &); - std::vector getOrderedSymbolTable() { return varList[0]; } bool isMainProgram() const { @@ -633,9 +631,12 @@ struct ModuleLikeUnit : public ProgramUnit { LLVM_DUMP_METHOD void dump() const; + std::vector getOrderedSymbolTable() { return varList[0]; } + ModuleStatement beginStmt; ModuleStatement endStmt; std::list nestedFunctions; + std::vector> varList; }; /// Block data units contain the variables and data initializers for common diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 172b52cd9c4bd..8f59e350f51fe 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1566,10 +1566,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { genPauseStatement(*this, stmt); } - void genFIR(const Fortran::parser::DataStmt &) { - // do nothing. The front-end converts to data initializations. - } - void genFIR(const Fortran::parser::NamelistStmt &) { TODO(); } // call FAIL IMAGE in runtime @@ -1886,7 +1882,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } /// Instantiate a local variable. Precondition: Each variable will be visited - /// such that if it's properties depend on other variables, the variables upon + /// such that if its properties depend on other variables, the variables upon /// which its properties depend will already have been visited. void instantiateLocal(const Fortran::lower::pft::Variable &var, llvm::DenseMap &storeMap) { @@ -2366,7 +2362,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void lowerMod(Fortran::lower::pft::ModuleLikeUnit &mod) { - // FIXME: do we need to visit the module statements? + // TODO: Implement instantiation of module data. + // llvm::DenseMap storeMap; + // for (const auto &var : mod.getOrderedSymbolTable()) + // instantiateVar(var, storeMap); for (auto &f : mod.nestedFunctions) lowerFunc(f); } diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 838fde744000a..dd73c593fd28d 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -975,12 +975,9 @@ static lower::pft::ModuleLikeUnit::ModuleStatement getModuleStmt(const T &mod) { return result; } -static const semantics::Symbol *getSymbol( - std::optional &beginStmt) { - if (!beginStmt) - return nullptr; - - const auto *symbol = beginStmt->visit(common::visitors{ +template +static const semantics::Symbol *getSymbol(A &beginStmt) { + const auto *symbol = beginStmt.visit(common::visitors{ [](const parser::Statement &stmt) -> const semantics::Symbol * { return stmt.statement.v.symbol; }, [](const parser::Statement &stmt) @@ -993,8 +990,14 @@ static const semantics::Symbol *getSymbol( }, [](const parser::Statement &stmt) -> const semantics::Symbol * { return stmt.statement.v.symbol; }, + [](const parser::Statement &stmt) + -> const semantics::Symbol * { return stmt.statement.v.symbol; }, + [](const parser::Statement &stmt) + -> const semantics::Symbol * { + return std::get(stmt.statement.t).symbol; + }, [](const auto &) -> const semantics::Symbol * { - llvm_unreachable("unknown FunctionLike beginStmt"); + llvm_unreachable("unknown FunctionLike or ModuleLike beginStmt"); return nullptr; }}); assert(symbol && "parser::Name must have resolved symbol"); @@ -1046,8 +1049,7 @@ struct IntervalSet : public llvm::IntervalMap { // A variable with an offset relative to the subprogram stack but equivalence // aliasing a variable in a common will also be marked as contained in a common // block. We have to filter this out so that we can correctly map the offsets. -bool Fortran::lower::declaredInCommonBlock( - const semantics::Symbol &sym) { +bool Fortran::lower::declaredInCommonBlock(const semantics::Symbol &sym) { if (auto *common = semantics::FindCommonBlockContaining(sym)) { auto &details = common->get(); for (auto &s : details.objects()) @@ -1158,11 +1160,15 @@ struct SymbolDependenceDepth { if (sym.has() || sym.has() || sym.has() || + sym.has() || sym.has()) { - // FIXME: do we want to do anything with any of these? + // FIXME: do we want to do anything with any of these? Other syms? return 0; } + if (sym.has()) + llvm_unreachable("not yet implemented - derived type analysis"); + // Symbol must be something lowering will have to allocate. bool global = semantics::IsSaved(sym); int depth = 0; @@ -1269,8 +1275,9 @@ struct SymbolDependenceDepth { }; } // namespace -void Fortran::lower::pft::FunctionLikeUnit::processSymbolTable( - const semantics::Scope &scope) { +static void processSymbolTable( + const semantics::Scope &scope, + std::vector> &varList) { SymbolDependenceDepth sdd{varList}; if (!scope.equivalenceSets().empty()) sdd.analyzeAliases(scope); @@ -1290,12 +1297,14 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( std::get>>(func.t)}; if (programStmt.has_value()) { beginStmt = programStmt.value(); - auto symbol = getSymbol(beginStmt); + auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope()); + processSymbolTable(*symbol->scope(), varList); } else { - processSymbolTable(semanticsContext.FindScope( - std::get>(func.t).source)); + processSymbolTable( + semanticsContext.FindScope( + std::get>(func.t).source), + varList); } } @@ -1306,9 +1315,9 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, endStmt{getFunctionStmt(func)} { - auto symbol = getSymbol(beginStmt); + auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope()); + processSymbolTable(*symbol->scope(), varList); } Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( @@ -1318,9 +1327,9 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, endStmt{getFunctionStmt(func)} { - auto symbol = getSymbol(beginStmt); + auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope()); + processSymbolTable(*symbol->scope(), varList); } Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( @@ -1330,21 +1339,27 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, endStmt{getFunctionStmt(func)} { - auto symbol = getSymbol(beginStmt); + auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope()); + processSymbolTable(*symbol->scope(), varList); } Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit( const parser::Module &m, const lower::pft::ParentVariant &parent) : ProgramUnit{m, parent}, beginStmt{getModuleStmt(m)}, - endStmt{getModuleStmt(m)} {} + endStmt{getModuleStmt(m)} { + auto symbol = getSymbol(beginStmt); + processSymbolTable(*symbol->scope(), varList); +} Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit( const parser::Submodule &m, const lower::pft::ParentVariant &parent) : ProgramUnit{m, parent}, beginStmt{getModuleStmt( m)}, - endStmt{getModuleStmt(m)} {} + endStmt{getModuleStmt(m)} { + auto symbol = getSymbol(beginStmt); + processSymbolTable(*symbol->scope(), varList); +} Fortran::lower::pft::BlockDataUnit::BlockDataUnit( const parser::BlockData &bd, const lower::pft::ParentVariant &parent, From d67cc14c742cdbafcf0df2e3515595202a5842db Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 7 Aug 2020 11:46:27 -0700 Subject: [PATCH 0223/1017] fixes for a number of compilation failures in fcvs. these fixes are mostly to bugs relating the CHARACTER handling. --- flang/lib/Lower/Bridge.cpp | 23 ++++++++++++++--------- flang/lib/Lower/ConvertExpr.cpp | 2 +- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 8f59e350f51fe..5c2f54125664a 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1944,7 +1944,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // properties except they are never boxed arguments from the caller and // never having a missing column size. mlir::Value addr = lookupSymbol(sym); - mlir::Value len{}; + mlir::Value len; [[maybe_unused]] bool mustBeDummy = false; if (sba.isChar) { @@ -1968,17 +1968,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { // XXX: Subsequent lowering expects a CHARACTER variable to be in a // boxchar. We assert that here. We might want to reconsider this // precondition. - // Update: Skeleton entry point dummy char argument generation hits - // this assert. Suppress it pending further investigation. - // assert(addr.getType().isa()); + assert(addr.getType().isa() && + "dummy CHARACTER argument must be boxchar"); } else { // local CHARACTER variable if (auto c = sba.getCharLenConst()) { len = builder->createIntegerConstant(loc, idxTy, *c); - } else { - auto e = sba.getCharLenExpr(); - assert(e && "CHARACTER variable must have LEN parameter"); + } else if (auto e = sba.getCharLenExpr()) { len = genExprValue(*e); + } else { + len = builder->createIntegerConstant(loc, idxTy, sym.size()); } assert(!addr); } @@ -1993,8 +1992,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (sba.staticSize) { // object shape is constant auto castTy = builder->getRefType(genType(var)); - if (addr) - addr = builder->createConvert(loc, castTy, addr); + if (addr) { + // XXX: special handling for boxchar; see proviso above + if (auto box = + dyn_cast_or_null(addr.getDefiningOp())) + addr = builder->createConvert(loc, castTy, box.memref()); + else + addr = builder->createConvert(loc, castTy, addr); + } if (sba.lboundIsAllOnes()) { // if lower bounds are all ones, build simple shaped object llvm::SmallVector shape; diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 9e6a0eed934ae..bd6d2dc9d10cf 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1403,7 +1403,7 @@ class ExprLowering { auto boxChar = argRef; if (!boxChar.getType().isa()) { Fortran::lower::CharacterExprHelper helper{builder, getLoc()}; - auto ch = helper.materializeCharacter(boxChar); + auto ch = helper.materializeCharacterOrSequence(boxChar); boxChar = helper.createEmboxChar(ch.first, ch.second); } caller.placeInput(arg, boxChar); From 20f7bd37d2d0ab5e718f3107b089912e2d0ff54b Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 10 Aug 2020 11:10:07 -0700 Subject: [PATCH 0224/1017] Change bbc to only return 0 on exit when the tool runs successfully. bbc was returning 0 in some failure situatons. --- flang/tools/bbc/bbc.cpp | 56 ++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 29 deletions(-) diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 55510a4b84a4d..b9e82a578e09e 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -121,8 +121,6 @@ static llvm::cl::opt dumpModuleOnFailure("dump-module-on-failure", using ProgramName = std::string; -static int exitStatus{EXIT_SUCCESS}; - // Print the module without the "module { ... }" wrapper. static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) { for (auto &op : mlirModule.getBody()->without_terminator()) @@ -131,7 +129,7 @@ static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) { } // Convert Fortran input to MLIR (target is FIR dialect) -static void convertFortranSourceToMLIR( +static mlir::LogicalResult convertFortranSourceToMLIR( std::string path, Fortran::parser::Options options, const ProgramName &programPrefix, Fortran::semantics::SemanticsContext &semanticsContext, @@ -158,8 +156,7 @@ static void convertFortranSourceToMLIR( (warnIsError || parsing.messages().AnyFatalError())) { llvm::errs() << programPrefix << "could not scan " << path << '\n'; parsing.messages().Emit(llvm::errs(), parsing.cooked()); - exitStatus = EXIT_FAILURE; - return; + return mlir::failure(); } // parse the input Fortran @@ -168,15 +165,13 @@ static void convertFortranSourceToMLIR( if (!parsing.consumedWholeFile()) { parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(), "parser FAIL (final position)"); - exitStatus = EXIT_FAILURE; - return; + return mlir::failure(); } if ((!parsing.messages().empty() && (warnIsError || parsing.messages().AnyFatalError())) || !parsing.parseTree().has_value()) { llvm::errs() << programPrefix << "could not parse " << path << '\n'; - exitStatus = EXIT_FAILURE; - return; + return mlir::failure(); } // run semantics @@ -187,8 +182,7 @@ static void convertFortranSourceToMLIR( semantics.EmitMessages(llvm::errs()); if (semantics.AnyFatalError()) { llvm::errs() << programPrefix << "semantic errors in " << path << '\n'; - exitStatus = EXIT_FAILURE; - return; + return mlir::failure(); } if (dumpSymbols) semantics.DumpSymbols(llvm::outs()); @@ -196,11 +190,10 @@ static void convertFortranSourceToMLIR( if (pftDumpTest) { if (auto ast{Fortran::lower::createPFT(parseTree, semanticsContext)}) { Fortran::lower::dumpPFT(llvm::outs(), *ast); - } else { - llvm::errs() << "Pre FIR Tree is NULL.\n"; - exitStatus = EXIT_FAILURE; + return mlir::success(); } - return; + llvm::errs() << "Pre FIR Tree is NULL.\n"; + return mlir::failure(); } // MLIR+FIR @@ -217,22 +210,29 @@ static void convertFortranSourceToMLIR( llvm::raw_fd_ostream out(outputName, ec); if (ec) { llvm::errs() << "could not open output file " << outputName << '\n'; - return; + return mlir::failure(); } // Otherwise run the default passes. mlir::PassManager pm(mlirModule.getContext()); mlir::applyPassManagerCLOptions(pm); if (passPipeline.hasAnyOccurrences()) { + // run the command-line specified pipeline passPipeline.addToPipeline(pm); } else if (emitFIR) { - // --emit-fir: Build the IR, verify it, and dump the IR (unconditionally). + // --emit-fir: Build the IR, verify it, and dump the IR if the IR passes + // verification. Use --dump-module-on-failure to dump invalid IR. pm.addPass(std::make_unique()); - if (mlir::failed(pm.run(mlirModule))) + if (mlir::failed(pm.run(mlirModule))) { llvm::errs() << "FATAL: verification of lowering to FIR failed"; + if (dumpModuleOnFailure) + mlirModule.dump(); + return mlir::failure(); + } printModule(mlirModule, out); - return; + return mlir::success(); } else { + // run the default canned pipeline pm.addPass(std::make_unique()); pm.addPass(mlir::createCanonicalizerPass()); pm.addPass(fir::createCSEPass()); @@ -254,25 +254,24 @@ static void convertFortranSourceToMLIR( llvm::sys::fs::OF_None); if (ec) { llvm::errs() << "can't open output file " + outputName + ".ll"; - return; + return mlir::failure(); } pm.addPass(fir::createLLVMDialectToLLVMPass(outFile.os())); if (mlir::succeeded(pm.run(mlirModule))) { outFile.keep(); printModule(mlirModule, out); - return; + return mlir::success(); } - } else { + } else if (mlir::succeeded(pm.run(mlirModule))) { // Emit MLIR and do not lower to LLVM IR. - if (mlir::succeeded(pm.run(mlirModule))) { - printModule(mlirModule, out); - return; - } + printModule(mlirModule, out); + return mlir::success(); } // Something went wrong. Try to dump the MLIR module. llvm::errs() << "oops, pass manager reported failure\n"; if (dumpModuleOnFailure) mlirModule.dump(); + return mlir::failure(); } int main(int argc, char **argv) { @@ -316,7 +315,6 @@ int main(int argc, char **argv) { .set_warnOnNonstandardUsage(warnStdViolation) .set_warningsAreErrors(warnIsError); - convertFortranSourceToMLIR(inputFilename, options, programPrefix, - semanticsContext, passPipe); - return exitStatus; + return mlir::failed(convertFortranSourceToMLIR( + inputFilename, options, programPrefix, semanticsContext, passPipe)); } From e02c5e19ff6f20a5e068979a36beaaf0cf9b0840 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 10 Aug 2020 13:47:04 -0700 Subject: [PATCH 0225/1017] refactoring and bug fix --- flang/include/flang/Lower/CharacterExpr.h | 4 ++++ flang/lib/Lower/CharacterExpr.cpp | 6 ++++-- flang/lib/Lower/ConvertExpr.cpp | 2 +- flang/lib/Lower/FIRBuilder.cpp | 6 ++---- flang/test/Lower/intrinsics.f90 | 8 ++++---- 5 files changed, 15 insertions(+), 11 deletions(-) diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index e5b9a3204534f..58c9f5c57f153 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -109,6 +109,10 @@ class CharacterExprHelper { /// Extract the kind of a character type static int getCharacterKind(mlir::Type type); + /// Determine the base character type + static fir::CharacterType getCharacterType(mlir::Type type); + static fir::CharacterType getCharacterType(const fir::CharBoxValue &box); + /// Return the integer type that must be used to manipulate /// Character lengths. TODO: move this to FirOpBuilder? mlir::Type getLengthType() { return builder.getIndexType(); } diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index 623b6bd01ba54..144d2095c087e 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -18,7 +18,8 @@ //===----------------------------------------------------------------------===// /// Get fir.char type with the same kind as inside str. -static fir::CharacterType getCharacterType(mlir::Type type) { +fir::CharacterType +Fortran::lower::CharacterExprHelper::getCharacterType(mlir::Type type) { if (auto boxType = type.dyn_cast()) return boxType.getEleTy(); if (auto refType = type.dyn_cast()) @@ -32,7 +33,8 @@ static fir::CharacterType getCharacterType(mlir::Type type) { llvm_unreachable("Invalid character value type"); } -static fir::CharacterType getCharacterType(const fir::CharBoxValue &box) { +fir::CharacterType Fortran::lower::CharacterExprHelper::getCharacterType( + const fir::CharBoxValue &box) { return getCharacterType(box.getBuffer().getType()); } diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index bd6d2dc9d10cf..3713beb10788d 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1281,7 +1281,7 @@ class ExprLowering { } } // Let the intrinsic library lower the intrinsic procedure call - llvm::StringRef name{intrinsic.name}; + llvm::StringRef name = intrinsic.name; return Fortran::lower::genIntrinsicCall(builder, getLoc(), name, resultType[0], operands); } diff --git a/flang/lib/Lower/FIRBuilder.cpp b/flang/lib/Lower/FIRBuilder.cpp index 0a73461eae7d6..ec6e910377453 100644 --- a/flang/lib/Lower/FIRBuilder.cpp +++ b/flang/lib/Lower/FIRBuilder.cpp @@ -146,9 +146,8 @@ mlir::Value Fortran::lower::FirOpBuilder::convertWithSemantics( auto fromTy = val.getType(); if (fromTy == toTy) return val; - // FIXME: add a fir::is_integer() test ComplexExprHelper helper{*this, loc}; - if ((fir::isa_real(fromTy) || fromTy.isSignlessInteger()) && + if ((fir::isa_real(fromTy) || fir::isa_integer(fromTy)) && fir::isa_complex(toTy)) { // imaginary part is zero auto eleTy = helper.getComplexPartType(toTy); @@ -158,9 +157,8 @@ mlir::Value Fortran::lower::FirOpBuilder::convertWithSemantics( auto imag = createRealConstant(loc, eleTy, zero); return helper.createComplex(toTy, cast, imag); } - // FIXME: add a fir::is_integer() test if (fir::isa_complex(fromTy) && - (toTy.isSignlessInteger() || fir::isa_real(toTy))) { + (fir::isa_integer(toTy) || fir::isa_real(toTy))) { // drop the imaginary part auto rp = helper.extractComplexPart(val, /*isImagPart=*/false); return createConvert(loc, toTy, rp); diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index 3c92a980c7da8..e7c4b6cc5480e 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -182,12 +182,12 @@ end subroutine iand_test subroutine ichar_test(c) character(1) :: c character :: str(10) - ! CHECK: fir.load {{.*}} : !fir.ref> - ! CHECK: fir.convert {{.*}} : (!fir.char<1>) -> i32 + ! CHECK: %[[BOX:.*]] = fir.load %{{.*}} : !fir.ref> + ! CHECK: %{{.*}} = fir.convert %[[BOX]] : (!fir.char<1>) -> i32 print *, ichar(c) - ! CHECK: fir.extract_value {{.*}} : (!fir.array<1x!fir.char<1>>, i32) -> !fir.char<1> - ! CHECK: fir.convert {{.*}} : (!fir.char<1>) -> i32 + ! CHECK: %[[ARRV:.*]] = fir.extract_value %{{.*}}, %{{.*}} : (!fir.array<1x!fir.char<1>>, i32) -> !fir.char<1> + ! CHECK: %{{.*}} = fir.convert %[[ARRV]] : (!fir.char<1>) -> i32 print *, ichar(str(J)) end subroutine From 7043186111893c7cd24ab62e2e4c0995c194c453 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 11 Aug 2020 16:25:56 -0700 Subject: [PATCH 0226/1017] fix fallout of rebase --- flang/lib/Decimal/binary-to-decimal.cpp | 43 +------------------------ 1 file changed, 1 insertion(+), 42 deletions(-) diff --git a/flang/lib/Decimal/binary-to-decimal.cpp b/flang/lib/Decimal/binary-to-decimal.cpp index 0c6a4d1fa2b40..68ee345b89352 100644 --- a/flang/lib/Decimal/binary-to-decimal.cpp +++ b/flang/lib/Decimal/binary-to-decimal.cpp @@ -276,45 +276,7 @@ void BigRadixFloatingPointNumber::Minimize( Normalize(); } -template -void BigRadixFloatingPointNumber::LoseLeastSignificantDigit() { - Digit LSD{digit_[0]}; - for (int j{0}; j < digits_ - 1; ++j) { - digit_[j] = digit_[j + 1]; - } - digit_[digits_ - 1] = 0; - bool incr{false}; - switch (rounding_) { - case RoundNearest: - case RoundDefault: - incr = LSD > radix / 2 || (LSD == radix / 2 && digit_[0] % 2 != 0); - break; - case RoundUp: - incr = LSD > 0 && !isNegative_; - break; - case RoundDown: - incr = LSD > 0 && isNegative_; - break; - case RoundToZero: - break; - case RoundCompatible: - incr = LSD >= radix / 2; - break; - } - for (int j{0}; (digit_[j] += incr) == radix; ++j) { - digit_[j] = 0; - } -} - -template void BigRadixFloatingPointNumber<8,16>::LoseLeastSignificantDigit(); -template void BigRadixFloatingPointNumber<11,16>::LoseLeastSignificantDigit(); -template void BigRadixFloatingPointNumber<24,16>::LoseLeastSignificantDigit(); -template void BigRadixFloatingPointNumber<53,16>::LoseLeastSignificantDigit(); -template void BigRadixFloatingPointNumber<64,16>::LoseLeastSignificantDigit(); -template void BigRadixFloatingPointNumber<113,16>::LoseLeastSignificantDigit(); - -template +template ConversionToDecimalResult ConvertToDecimal(char *buffer, std::size_t size, enum DecimalConversionFlags flags, int digits, enum FortranRounding rounding, BinaryFloatingPointNumber x) { @@ -405,7 +367,6 @@ ConversionToDecimalResult ConvertLongDoubleToDecimal(char *buffer, #endif } -#if 0 template template STREAM &BigRadixFloatingPointNumber::Dump(STREAM &o) const { @@ -423,6 +384,4 @@ STREAM &BigRadixFloatingPointNumber::Dump(STREAM &o) const { } return o; } -#endif - } // namespace Fortran::decimal From 4164aaac4bee2fff0382e80d6b8921e09125cd85 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 10 Aug 2020 13:47:04 -0700 Subject: [PATCH 0227/1017] refactoring and bug fixes: a collection of fixes for fcvs. more to come... --- flang/include/flang/Lower/Support/BoxValue.h | 11 ++++++-- flang/lib/Lower/Bridge.cpp | 16 +++++++++--- flang/lib/Lower/CharacterExpr.cpp | 27 ++++++++++++++------ flang/lib/Lower/ConvertExpr.cpp | 2 +- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 5 +++- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 16 +++++++++--- 6 files changed, 57 insertions(+), 20 deletions(-) diff --git a/flang/include/flang/Lower/Support/BoxValue.h b/flang/include/flang/Lower/Support/BoxValue.h index c197401e08cfa..db109db196c26 100644 --- a/flang/include/flang/Lower/Support/BoxValue.h +++ b/flang/include/flang/Lower/Support/BoxValue.h @@ -13,6 +13,7 @@ #ifndef LOWER_SUPPORT_BOXVALUE_H #define LOWER_SUPPORT_BOXVALUE_H +#include "flang/Optimizer/Dialect/FIRType.h" #include "mlir/IR/Value.h" #include "llvm/ADT/SmallVector.h" #include "llvm/Support/Compiler.h" @@ -51,7 +52,12 @@ using UnboxedValue = mlir::Value; class AbstractBox { public: AbstractBox() = delete; - AbstractBox(mlir::Value addr) : addr{addr} {} + AbstractBox(mlir::Value addr) : addr{addr} { + // FIXME: enable the assert! + // assert(fir::isa_passbyref_type(addr.getType())); + } + + /// An abstract box always contains a memory reference to a value. mlir::Value getAddr() const { return addr; } protected: @@ -67,9 +73,10 @@ class CharBoxValue : public AbstractBox { CharBoxValue clone(mlir::Value newBase) const { return {newBase, len}; } - mlir::Value getLen() const { return len; } + /// Convenience alias to get the memory reference to the buffer. mlir::Value getBuffer() const { return getAddr(); } + mlir::Value getLen() const { return len; } friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const CharBoxValue &); LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; } diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 5c2f54125664a..95c52806d23bb 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -40,6 +40,7 @@ #include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorHandling.h" #include "llvm/Support/MD5.h" +#define DEBUG_TYPE "flang-lower-bridge" #undef TODO #define TODO() llvm_unreachable("not yet implemented"); @@ -1762,7 +1763,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // The target data layout is the better solution because it is selected // by the instance of flang's chosen target rather than by properties of // the build machine. - mlir::Type commonTy = [&]() { + mlir::TupleType commonTy = [&]() { llvm::SmallVector members; for (const auto &obj : details->objects()) { auto memTy = genType(*obj); @@ -1788,18 +1789,23 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Assume that the members of the COMMON block will appear in an order // that is sorted by offset. [[maybe_unused]] std::int64_t lastByteOff = -1; + LLVM_DEBUG(llvm::errs() << "block {\n"); for (const auto &obj : details->objects()) { assert(lastByteOff < static_cast(obj->offset())); lastByteOff = static_cast(obj->offset()); + LLVM_DEBUG(llvm::errs() << "offset: " << obj->offset() << '\n'); if (const auto *objDet = obj->detailsIf()) if (objDet->init()) { auto initVal = genInitializerExprValue(objDet->init().value()); - auto off = builder.createIntegerConstant(loc, idxTy, offset++); - cb = builder.create( - loc, commonTy, cb, fir::getBase(initVal), off); + auto off = builder.createIntegerConstant(loc, idxTy, offset); + auto castVal = builder.createConvert( + loc, commonTy.getType(offset++), fir::getBase(initVal)); + cb = builder.create(loc, commonTy, cb, + castVal, off); } } + LLVM_DEBUG(llvm::errs() << "}\n"); builder.create(loc, cb); }; global = builder->createGlobal(loc, commonTy, globalName, @@ -2346,6 +2352,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::lower::pft::Variable var(*sym, true); instantiateVar(var, fakeMap); } + if (auto *region = func.getCallableRegion()) + region->dropAllReferences(); func.erase(); delete builder; builder = nullptr; diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index 144d2095c087e..5c31ac2ce6a43 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -170,11 +170,15 @@ mlir::Value Fortran::lower::CharacterExprHelper::createLoadCharAt( const fir::CharBoxValue &str, mlir::Value index) { // In case this is addressing a length one character scalar simply return // the single character. - if (str.getBuffer().getType().isa()) - return str.getBuffer(); - auto buff = builder.createConvert(loc, getSeqTy(str), str.getBuffer()); + auto buff = str.getBuffer(); + if (auto charTy = buff.getType().dyn_cast()) { + assert(charTy.getLen() == 1 && "string not handled"); + return buff; + } + assert(fir::isa_ref_type(buff.getType())); + auto coor = builder.createConvert(loc, getSeqTy(str), buff); auto addr = builder.create(loc, getReferenceType(str), - buff, index); + coor, index); return builder.create(loc, addr); } @@ -190,9 +194,12 @@ void Fortran::lower::CharacterExprHelper::createStoreCharAt( void Fortran::lower::CharacterExprHelper::createCopy( const fir::CharBoxValue &dest, const fir::CharBoxValue &src, mlir::Value count) { + auto from = src; + if (needToMaterialize(src)) + from = materializeValue(src); Fortran::lower::DoLoopHelper{builder, loc}.createLoop( count, [&](Fortran::lower::FirOpBuilder &, mlir::Value index) { - auto charVal = createLoadCharAt(src, index); + auto charVal = createLoadCharAt(from, index); createStoreCharAt(dest, index, charVal); }); } @@ -228,7 +235,8 @@ void Fortran::lower::CharacterExprHelper::createLengthOneAssign( auto valTy = val.getType(); // Precondition is rhs is size 1, but it may be wrapped in a fir.array. if (auto seqTy = valTy.dyn_cast()) { - auto zero = builder.createIntegerConstant(loc, builder.getIndexType(), 0); + auto zero = + builder.createIntegerConstant(loc, builder.getIntegerType(32), 0); valTy = seqTy.getEleTy(); val = builder.create(loc, valTy, val, zero); } @@ -294,11 +302,14 @@ fir::CharBoxValue Fortran::lower::CharacterExprHelper::createConcatenate( auto upperBound = builder.create(loc, len, one); auto lhsLen = builder.createConvert(loc, builder.getIndexType(), lhs.getLen()); + auto from = rhs; + if (needToMaterialize(rhs)) + from = materializeValue(rhs); Fortran::lower::DoLoopHelper{builder, loc}.createLoop( lhs.getLen(), upperBound, one, [&](Fortran::lower::FirOpBuilder &bldr, mlir::Value index) { auto rhsIndex = bldr.create(loc, index, lhsLen); - auto charVal = createLoadCharAt(rhs, rhsIndex); + auto charVal = createLoadCharAt(from, rhsIndex); createStoreCharAt(temp, index, charVal); }); return temp; @@ -332,7 +343,7 @@ fir::CharBoxValue Fortran::lower::CharacterExprHelper::createSubstring( loc, getReferenceType(str), buff, offset); // Compute the length. - mlir::Value substringLen{}; + mlir::Value substringLen; if (nbounds < 2) { substringLen = builder.create(loc, str.getLen(), castBounds[0]); diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 3713beb10788d..0da85f5f8b242 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -775,7 +775,7 @@ class ExprLowering { auto chTy = converter.genType(Fortran::common::TypeCategory::Character, KIND); auto arrayTy = fir::SequenceType::get(shape, chTy); - auto idxTy = builder.getIndexType(); + auto idxTy = builder.getIntegerType(32); mlir::Value array = builder.create(getLoc(), arrayTy); Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); do { diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index c5a2403edf4db..1b10c4b608455 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -36,6 +36,7 @@ #include "llvm/Support/CommandLine.h" #include "llvm/Support/FileSystem.h" #include "llvm/Support/raw_ostream.h" +#define DEBUG_TYPE "flang-codegen" /// The Tilikum bridge performs the conversion of operations from both the FIR /// and standard dialects to the LLVM-IR dialect. @@ -45,7 +46,7 @@ /// necessary to preserve the semantics of the Fortran program. #undef TODO -#define TODO() llvm_unreachable("not yet implemented") +#define TODO() llvm::report_fatal_error("tilikum: not yet implemented") using namespace llvm; @@ -1279,6 +1280,8 @@ struct EmboxCommonConversion : public FIROpConversion { return this->lowerTy().getKindMap(); }; + if (auto eleTy = fir::dyn_cast_ptrEleTy(boxEleTy)) + boxEleTy = eleTy; if (fir::isa_integer(boxEleTy)) { if (auto ty = boxEleTy.dyn_cast()) return doInteger(ty.getWidth()); diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index c4a727daae139..9d3f4a1198f66 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #include "PassDetail.h" #include "flang/Optimizer/CodeGen/CodeGen.h" @@ -17,6 +21,8 @@ #include "llvm/Support/CommandLine.h" #include "llvm/Support/Debug.h" +#define DEBUG_TYPE "flang-codegen-rewrite" + using namespace fir; static void populateShape(llvm::SmallVectorImpl &vec, @@ -77,13 +83,12 @@ class EmboxConversion : public mlir::OpRewritePattern { auto shapeAttr = rewriter.getIntegerAttr(idxTy, shapeOpers.size()); attrs.push_back( rewriter.getNamedAttr(XEmboxOp::shapeAttrName(), shapeAttr)); - attrs.push_back( - rewriter.getNamedAttr(XEmboxOp::shiftAttrName(), zeroAttr)); - attrs.push_back( - rewriter.getNamedAttr(XEmboxOp::sliceAttrName(), zeroAttr)); + attrs.push_back(rewriter.getNamedAttr(XEmboxOp::shiftAttrName(), zeroAttr)); + attrs.push_back(rewriter.getNamedAttr(XEmboxOp::sliceAttrName(), zeroAttr)); auto xbox = rewriter.create(loc, embox.getType(), embox.memref(), shapeOpers, llvm::None, llvm::None, llvm::None, attrs); + LLVM_DEBUG(llvm::errs() << "rewriting " << embox << " to " << xbox << '\n'); rewriter.replaceOp(embox, xbox.getOperation()->getResults()); return mlir::success(); } @@ -127,6 +132,7 @@ class EmboxConversion : public mlir::OpRewritePattern { auto xbox = rewriter.create(loc, embox.getType(), embox.memref(), shapeOpers, shiftOpers, sliceOpers, embox.getLenParams(), attrs); + LLVM_DEBUG(llvm::errs() << "rewriting " << embox << " to " << xbox << '\n'); rewriter.replaceOp(embox, xbox.getOperation()->getResults()); return mlir::success(); } @@ -180,6 +186,8 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { auto xArrCoor = rewriter.create( loc, arrCoor.getType(), arrCoor.memref(), shapeOpers, shiftOpers, sliceOpers, arrCoor.indices(), arrCoor.lenParams(), attrs); + LLVM_DEBUG(llvm::errs() + << "rewriting " << arrCoor << " to " << xArrCoor << '\n'); rewriter.replaceOp(arrCoor, xArrCoor.getOperation()->getResults()); return mlir::success(); } From 55bd3a01fec0646d3cd3245fbb09482be4b34f9a Mon Sep 17 00:00:00 2001 From: rajan Date: Thu, 13 Aug 2020 20:24:43 -0400 Subject: [PATCH 0228/1017] optimizations for better promoting to affine dialect (#369) * optimizing removing unused loop iteration variables * load and store forwarding * three rewrite patterns for convert operations. --- .../flang/Optimizer/Transforms/CMakeLists.txt | 5 + .../flang/Optimizer/Transforms/Passes.h | 4 + .../flang/Optimizer/Transforms/Passes.td | 16 ++ .../Optimizer/Transforms/RewritePatterns.td | 34 +++++ flang/lib/Lower/ConvertExpr.cpp | 7 +- flang/lib/Optimizer/CMakeLists.txt | 8 +- .../Optimizer/Transforms/AffinePromotion.cpp | 53 +++++-- .../Optimizer/Transforms/FirLoopResultOpt.cpp | 104 +++++++++++++ .../Optimizer/Transforms/MemDataFlowOpt.cpp | 142 ++++++++++++++++++ 9 files changed, 356 insertions(+), 17 deletions(-) create mode 100644 flang/include/flang/Optimizer/Transforms/RewritePatterns.td create mode 100644 flang/lib/Optimizer/Transforms/FirLoopResultOpt.cpp create mode 100644 flang/lib/Optimizer/Transforms/MemDataFlowOpt.cpp diff --git a/flang/include/flang/Optimizer/Transforms/CMakeLists.txt b/flang/include/flang/Optimizer/Transforms/CMakeLists.txt index 37096bff40b69..6479330ed0d36 100644 --- a/flang/include/flang/Optimizer/Transforms/CMakeLists.txt +++ b/flang/include/flang/Optimizer/Transforms/CMakeLists.txt @@ -1,4 +1,9 @@ + +set(LLVM_TARGET_DEFINITIONS RewritePatterns.td) +mlir_tablegen(RewritePatterns.inc -gen-rewriters) +add_public_tablegen_target(RewritePatternsIncGen) + set(LLVM_TARGET_DEFINITIONS Passes.td) mlir_tablegen(Passes.h.inc -gen-pass-decls -name OptTransform) add_public_tablegen_target(FIROptTransformsPassIncGen) diff --git a/flang/include/flang/Optimizer/Transforms/Passes.h b/flang/include/flang/Optimizer/Transforms/Passes.h index 069dfdc1c54f0..c8fa189611a14 100644 --- a/flang/include/flang/Optimizer/Transforms/Passes.h +++ b/flang/include/flang/Optimizer/Transforms/Passes.h @@ -34,6 +34,10 @@ std::unique_ptr createPromoteToAffinePass(); /// Convert Affine operations back to FIR std::unique_ptr createAffineDemotionPass(); +std::unique_ptr createFirLoopResultOptPass(); + +std::unique_ptr createMemDataFlowOptPass(); + /// Convert `fir.do_loop` and `fir.if` to a CFG. This /// conversion enables the `createLowerToCFGPass` to transform these to CFG /// form. diff --git a/flang/include/flang/Optimizer/Transforms/Passes.td b/flang/include/flang/Optimizer/Transforms/Passes.td index 8e21fc971ebb3..5f6e09ba6a778 100644 --- a/flang/include/flang/Optimizer/Transforms/Passes.td +++ b/flang/include/flang/Optimizer/Transforms/Passes.td @@ -66,6 +66,22 @@ def MemRefDataFlowOpt : FunctionPass<"fir-memref-dataflow-opt"> { let constructor = "::fir::createMemDataFlowOptPass()"; } +def FirLoopResultOpt : FunctionPass<"fir-loop-result-opt"> { + let summary = "Optimizes fir do_loop by removing unused final iteration values."; + let constructor = "fir::createFirLoopResultOptPass()"; + +} + +def MemRefDataFlowOpt : FunctionPass<"flang-memref-dataflow-opt"> { + let summary = "Perform store/load forwarding and potentially removing dead stores"; + let description = [{ + This pass performs store to load forwarding to eliminate memory + accesses and potentially the entire allocation if all the accesses are + forwarded. + }]; + let constructor = "fir::createMemDataFlowOptPass()"; +} + def BasicCSE : FunctionPass<"basic-cse"> { let summary = "Basic common sub-expression elimination."; let description = [{ diff --git a/flang/include/flang/Optimizer/Transforms/RewritePatterns.td b/flang/include/flang/Optimizer/Transforms/RewritePatterns.td new file mode 100644 index 0000000000000..4b5d1140f8f75 --- /dev/null +++ b/flang/include/flang/Optimizer/Transforms/RewritePatterns.td @@ -0,0 +1,34 @@ +//===-- RewritePatterns.td - FIR Rewrite Patterns -----------*- tablegen -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +/// +/// \file +/// Defines pattern rewrites for fir optimizations +/// +//===----------------------------------------------------------------------===// + +#ifndef FIR_REWRITE_PATTERNS +#define FIR_REWRITE_PATTERNS + +include "mlir/IR/OpBase.td" +include "flang/Optimizer/Dialect/FIROps.td" + +def TypesAreIdentical : Constraint>; + +def ConvertConvertOptPattern : Pat<(fir_ConvertOp (fir_ConvertOp $arg)), + (fir_ConvertOp $arg)>; + + +def RedundantConvertOptPattern : Pat<(fir_ConvertOp:$res $arg), + (replaceWithValue $arg), + [(TypesAreIdentical $res, $arg)]>; + +def CombineConvertOptPattern : Pat<(fir_ConvertOp:$res (fir_ConvertOp $arg)), + (replaceWithValue $arg), + [(TypesAreIdentical $res, $arg)]>; + +#endif // FIR_REWRITE_PATTERNS diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 0da85f5f8b242..46acee5f8360e 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1114,6 +1114,7 @@ class ExprLowering { auto arrTy = fir::dyn_cast_ptrEleTy(addr.getType()); auto eleTy = arrTy.cast().getEleTy(); auto refTy = builder.getRefType(eleTy); + auto idxTy = builder.getIndexType(); auto arrShape = [&](const auto &arr) -> mlir::Value { if (arr.getLBounds().empty()) { auto shapeType = @@ -1124,7 +1125,8 @@ class ExprLowering { arr.getExtents().size()); SmallVector shapeArgs; for (const auto &pair : llvm::zip(arr.getLBounds(), arr.getExtents())) { - shapeArgs.push_back(std::get<0>(pair)); + auto lb = builder.createConvert(loc, idxTy, std::get<0>(pair)); + shapeArgs.push_back(lb); shapeArgs.push_back(std::get<1>(pair)); } return builder.create(loc, shapeType, shapeArgs); @@ -1136,7 +1138,8 @@ class ExprLowering { auto subVal = genComponent(sub); if (auto *ev = std::get_if(&subVal)) { if (auto *sval = ev->getUnboxed()) { - arrayCoorArgs.push_back(*sval); + auto val = builder.createConvert(loc, idxTy, *sval); + arrayCoorArgs.push_back(val); } else { TODO(); } diff --git a/flang/lib/Optimizer/CMakeLists.txt b/flang/lib/Optimizer/CMakeLists.txt index 8fec6d1e6ac0b..69f0496cfab67 100644 --- a/flang/lib/Optimizer/CMakeLists.txt +++ b/flang/lib/Optimizer/CMakeLists.txt @@ -23,18 +23,20 @@ add_flang_library(FIROptimizer Transforms/AffinePromotion.cpp Transforms/AffineDemotion.cpp Transforms/RewriteLoop.cpp + Transforms/MemDataFlowOpt.cpp + Transforms/FirLoopResultOpt.cpp DEPENDS FIROpsIncGen FIROptCodeGenPassIncGen FIROptTransformsPassIncGen - CGOpsIncGen + RewritePatternsIncGen ${dialect_libs} LINK_LIBS ${dialect_libs} - MLIRLLVMToLLVMIRTranslation - MLIRTargetLLVMIRExport + MLIRTargetLLVMIR + MLIRTargetLLVMIRModuleTranslation LINK_COMPONENTS AsmParser diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index 3f84361c76ebd..b2a3d37726944 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -21,6 +21,7 @@ #include "llvm/ADT/DenseMap.h" #include "llvm/ADT/Optional.h" #include "llvm/Support/CommandLine.h" + #define DEBUG_TYPE "flang-affine-promotion" /// disable FIR to affine dialect conversion @@ -307,27 +308,54 @@ mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) { return mlir::Type(); } +void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeOp shape, + SmallVectorImpl &indexArgs, + mlir::PatternRewriter &rewriter) { + auto iter = shape.extents().begin(); + auto one = rewriter.create( + acoOp.getLoc(), rewriter.getIndexType(), rewriter.getIndexAttr(1)); + auto end = shape.extents().size(); + for (decltype(end) i = 0; i < end; ++(++i)) { + indexArgs.push_back(one); + indexArgs.push_back(*iter++); + indexArgs.push_back(one); + } +} +void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeShiftOp shape, + SmallVectorImpl &indexArgs, + mlir::PatternRewriter &rewriter) { + auto iter = shape.pairs().begin(); + auto one = rewriter.create( + acoOp.getLoc(), rewriter.getIndexType(), rewriter.getIndexAttr(1)); + auto end = shape.pairs().size(); + for (decltype(end) i = 0; i < end; ++(++i)) { + indexArgs.push_back(*iter++); + indexArgs.push_back(*iter++); + indexArgs.push_back(one); + } +} +void populateIndexArgs(fir::ArrayCoorOp acoOp, + SmallVectorImpl &indexArgs, + mlir::PatternRewriter &rewriter) { + if (auto shape = acoOp.shape().getDefiningOp()) { + return populateIndexArgs(acoOp, shape, indexArgs, rewriter); + } + if (auto shapeShift = acoOp.shape().getDefiningOp()) + return populateIndexArgs(acoOp, shapeShift, indexArgs, rewriter); + llvm::dbgs() << "AffinePromotion: need to populateIndexArgs for slice\n"; + return; +} + /// Returns affine.apply and fir.convert from array_coor and gendims std::pair createAffineOps(mlir::Value arrayRef, mlir::PatternRewriter &rewriter) { auto acoOp = arrayRef.getDefiningOp(); - assert(acoOp.shape() && isa(acoOp.shape().getDefiningOp())); - auto genDim = acoOp.shape().getDefiningOp(); auto affineMap = createArrayIndexAffineMap(acoOp.indices().size(), acoOp.getContext()); SmallVector indexArgs; indexArgs.append(acoOp.indices().begin(), acoOp.indices().end()); - // FIXME: quick hack for now (assumes 1 for the shift and stride) - auto iter = genDim.extents().begin(); - auto one = rewriter.create( - acoOp.getLoc(), rewriter.getIndexType(), rewriter.getIndexAttr(1)); - auto end = genDim.extents().size(); - for (decltype(end) i = 0; i < end; ++i) { - indexArgs.push_back(one); - indexArgs.push_back(*iter++); - indexArgs.push_back(one); - } + populateIndexArgs(acoOp, indexArgs, rewriter); auto affineApply = rewriter.create(acoOp.getLoc(), affineMap, indexArgs); @@ -504,6 +532,7 @@ class AffineDialectPromotion auto *context = &getContext(); auto function = getFunction(); + markAllAnalysesPreserved(); auto functionAnalysis = AffineFunctionAnalysis(function); mlir::OwningRewritePatternList patterns; patterns.insert(context, functionAnalysis); diff --git a/flang/lib/Optimizer/Transforms/FirLoopResultOpt.cpp b/flang/lib/Optimizer/Transforms/FirLoopResultOpt.cpp new file mode 100644 index 0000000000000..16e99b1a7ed92 --- /dev/null +++ b/flang/lib/Optimizer/Transforms/FirLoopResultOpt.cpp @@ -0,0 +1,104 @@ +//===- FirLoopResultOpt.cpp - Optimization pass for fir loops ------ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "PassDetail.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/IR/Diagnostics.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Transforms/DialectConversion.h" +#include "mlir/Transforms/Passes.h" + +#define DEBUG_TYPE "flang-fir-result-opt" + +namespace { + +class LoopResultRemoval : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + LoopResultRemoval(mlir::MLIRContext *c) : OpRewritePattern(c) {} + mlir::LogicalResult + matchAndRewrite(fir::DoLoopOp loop, + mlir::PatternRewriter &rewriter) const override { + for (auto r : loop.getResults()) { + if (valueUseful(r)) + return mlir::failure(); + } + auto &loopOps = loop.getBody()->getOperations(); + auto newLoop = rewriter.create( + loop.getLoc(), loop.lowerBound(), loop.upperBound(), loop.step()); + rewriter.startRootUpdate(newLoop.getOperation()); + rewriter.startRootUpdate(loop.getOperation()); + newLoop.getBody()->getOperations().splice( + --newLoop.getBody()->end(), loopOps, loopOps.begin(), --loopOps.end()); + loop.getInductionVar().replaceAllUsesWith(newLoop.getInductionVar()); + rewriter.finalizeRootUpdate(loop.getOperation()); + rewriter.finalizeRootUpdate(newLoop.getOperation()); + for (auto r : loop.getResults()) { + eraseAllUses(r, rewriter); + } + rewriter.eraseBlock(loop.getBody()); + rewriter.eraseOp(loop); + return mlir::success(); + } + +private: + void eraseAllUses(mlir::Value v, mlir::PatternRewriter &rewriter) const { + for (auto &use : v.getUses()) { + if (auto convert = dyn_cast(use.getOwner())) { + eraseAllUses(convert.getResult(), rewriter); + } + rewriter.eraseOp(use.getOwner()); + } + } + bool valueUseful(mlir::Value v) const { + for (auto &use : v.getUses()) { + if (auto convert = dyn_cast(use.getOwner())) + return valueUseful(convert.getResult()); + if (auto store = dyn_cast(use.getOwner())) { + bool anyLoad = false; + for (auto &su : store.memref().getUses()) { + if (auto load = dyn_cast(su.getOwner())) + anyLoad = true; + } + return anyLoad; + } + return true; + } + return false; + } +}; + +class FirLoopResultOptPass + : public fir::FirLoopResultOptBase { +public: + void runOnFunction() override { + auto *context = &getContext(); + auto function = getFunction(); + mlir::OwningRewritePatternList patterns; + patterns.insert(context); + mlir::ConversionTarget target = *context; + target.addLegalDialect(); + target.addDynamicallyLegalOp( + [&](fir::DoLoopOp op) { return op.getNumResults() == 0; }); + if (mlir::failed(mlir::applyPartialConversion(function, target, + std::move(patterns)))) { + mlir::emitWarning(mlir::UnknownLoc::get(context), + "fir loop result optimization failed\n"); + } + } +}; + +} // end anonymous namespace + +std::unique_ptr fir::createFirLoopResultOptPass() { + return std::make_unique(); +} diff --git a/flang/lib/Optimizer/Transforms/MemDataFlowOpt.cpp b/flang/lib/Optimizer/Transforms/MemDataFlowOpt.cpp new file mode 100644 index 0000000000000..136ada8fbc409 --- /dev/null +++ b/flang/lib/Optimizer/Transforms/MemDataFlowOpt.cpp @@ -0,0 +1,142 @@ +//===- MemRefDataFlowOpt.cpp - Memory DataFlow Optimization pass ------ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "PassDetail.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/IR/Dominance.h" +#include "mlir/IR/Operation.h" +#include "mlir/Transforms/Passes.h" +#include "llvm/ADT/Optional.h" +#include "llvm/ADT/STLExtras.h" +#include "llvm/ADT/SmallVector.h" + +#define DEBUG_TYPE "flang-memref-dataflow-opt" + +namespace { + +template +llvm::SmallVector +getParentOpsWithTrait(mlir::Operation *op) { + llvm::SmallVector parentLoops; + while ((op = op->getParentOp())) { + if (op->hasTrait()) + parentLoops.push_back(op); + } + return parentLoops; +} + +unsigned getNumCommonSurroundingOps( + const llvm::SmallVectorImpl OpsA, + const llvm::SmallVectorImpl OpsB) { + unsigned numCommonOps = 0; + unsigned minNumOps = std::min(OpsA.size(), OpsB.size()); + for (unsigned i = 0; i < minNumOps; ++i) { + if (OpsA[i] != OpsB[i]) + break; + numCommonOps++; + } + return numCommonOps; +} + +/// This is based on MLIR's MemRefDataFlowOpt which is specialized on AffineRead +/// and AffineWrite interface +template +class LoadStoreForwarding { +public: + LoadStoreForwarding(mlir::DominanceInfo *di, mlir::PostDominanceInfo *pdi) + : domInfo(di), postDomInfo(pdi) {} + llvm::Optional + findStoreToForward(ReadOp loadOp, llvm::SmallVectorImpl &&storeOps) { + llvm::SmallVector forwadingCandidates; + llvm::SmallVector storesWithDependence; + + for (auto &storeOp : storeOps) { + if (accessDependence(loadOp, storeOp)) + storesWithDependence.push_back(storeOp.getOperation()); + if (equivalentAccess(loadOp, storeOp) && + domInfo->dominates(storeOp.getOperation(), loadOp.getOperation())) + forwadingCandidates.push_back(storeOp.getOperation()); + } + + llvm::Optional lastWriteStoreOp; + for (auto *storeOp : forwadingCandidates) { + if (llvm::all_of(storesWithDependence, [&](mlir::Operation *depStore) { + return postDomInfo->postDominates(storeOp, depStore); + })) { + lastWriteStoreOp = cast(storeOp); + break; + } + } + return lastWriteStoreOp; + } + llvm::Optional + findReadForWrite(WriteOp storeOp, llvm::SmallVectorImpl &&loadOps) { + llvm::SmallVector useCandidates; + llvm::SmallVector dependences; + for (auto &loadOp : loadOps) { + if (equivalentAccess(loadOp, storeOp) && + postDomInfo->postDominates(loadOp, storeOp)) + return {loadOp}; + } + return {}; + } + bool equivalentAccess(ReadOp loadOp, WriteOp storeOp) { return true; } + bool accessDependence(ReadOp loadOp, WriteOp storeOp) { return true; } + +private: + mlir::DominanceInfo *domInfo; + mlir::PostDominanceInfo *postDomInfo; +}; + +template +llvm::SmallVector getSpecificUsers(mlir::Value v) { + llvm::SmallVector ops; + for (auto *user : v.getUsers()) { + if (auto op = dyn_cast(user)) + ops.push_back(op); + } + return ops; +} + +class MemDataFlowOpt : public fir::MemRefDataFlowOptBase { +public: + void runOnFunction() override { + mlir::FuncOp f = getFunction(); + + auto domInfo = &getAnalysis(); + auto postDomInfo = &getAnalysis(); + LoadStoreForwarding lsf(domInfo, postDomInfo); + f.walk([&](fir::LoadOp loadOp) { + auto maybeStore = lsf.findStoreToForward( + loadOp, getSpecificUsers(loadOp.memref())); + if (maybeStore) { + LLVM_DEBUG(llvm::dbgs() << "FlangMemDataFlowOpt: erasing loadOp with " + "value from store\n"; + loadOp.dump(); maybeStore.getValue().dump();); + loadOp.getResult().replaceAllUsesWith(maybeStore.getValue().value()); + loadOp.erase(); + } + }); + f.walk([&](fir::AllocaOp alloca) { + for (auto &storeOp : getSpecificUsers(alloca.getResult())) { + if (!lsf.findReadForWrite( + storeOp, getSpecificUsers(storeOp.memref()))) + storeOp.erase(); + } + }); + } +}; +} // namespace + +std::unique_ptr fir::createMemDataFlowOptPass() { + return std::make_unique(); +} From 82d9588b56f0bb1297f72b4d1920c62aa4a20e80 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 17 Aug 2020 09:34:09 -0700 Subject: [PATCH 0229/1017] rebase fallout fixes remove unsupported OpenACC test --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 234 +++++++++--------- flang/lib/Optimizer/CodeGen/DescriptorModel.h | 40 +-- flang/test/lit.site.cfg.py.in | 1 + 3 files changed, 144 insertions(+), 131 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 1b10c4b608455..4342bb545f69a 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -99,12 +99,12 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { addConversion( [&](fir::RecordType derived) { return convertRecordType(derived); }); addConversion([&](fir::FieldType field) { - return mlir::LLVM::LLVMType::getInt32Ty(llvmDialect); + return mlir::LLVM::LLVMType::getInt32Ty(field.getContext()); }); addConversion([&](fir::HeapType heap) { return convertPointerLike(heap); }); addConversion([&](fir::IntType intr) { return convertIntegerType(intr); }); addConversion([&](fir::LenType field) { - return mlir::LLVM::LLVMType::getInt32Ty(llvmDialect); + return mlir::LLVM::LLVMType::getInt32Ty(field.getContext()); }); addConversion( [&](fir::LogicalType logical) { return convertLogicalType(logical); }); @@ -125,7 +125,8 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { addConversion( [&](mlir::ComplexType cmplx) { return convertComplexType(cmplx); }); addConversion([&](mlir::NoneType none) { - return mlir::LLVM::LLVMType::getStructTy(llvmDialect, {}); + return mlir::LLVM::LLVMStructType::getLiteral(none.getContext(), + llvm::None); }); // FIXME: https://reviews.llvm.org/D82831 introduced an automatic @@ -156,19 +157,19 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { // This returns the type of a single column. Rows are added by the caller. // fir.dims --> llvm<"[r x [3 x i64]]"> mlir::LLVM::LLVMType dimsType() { - auto i64Ty{mlir::LLVM::LLVMType::getInt64Ty(llvmDialect)}; + auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(&getContext()); return mlir::LLVM::LLVMType::getArrayTy(i64Ty, 3); } // i32 is used here because LLVM wants i32 constants when indexing into struct // types. Indexing into other aggregate types is more flexible. mlir::LLVM::LLVMType offsetType() { - return mlir::LLVM::LLVMType::getInt32Ty(llvmDialect); + return mlir::LLVM::LLVMType::getInt32Ty(&getContext()); } // i64 can be used to index into aggregates like arrays mlir::LLVM::LLVMType indexType() { - return mlir::LLVM::LLVMType::getInt64Ty(llvmDialect); + return mlir::LLVM::LLVMType::getInt64Ty(&getContext()); } // TODO @@ -186,42 +187,43 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { parts.push_back(eleTy); else parts.push_back(eleTy.getPointerTo()); - parts.push_back(fir::getDescFieldTypeModel<1>()(llvmDialect)); - parts.push_back(fir::getDescFieldTypeModel<2>()(llvmDialect)); - parts.push_back(fir::getDescFieldTypeModel<3>()(llvmDialect)); - parts.push_back(fir::getDescFieldTypeModel<4>()(llvmDialect)); - parts.push_back(fir::getDescFieldTypeModel<5>()(llvmDialect)); - parts.push_back(fir::getDescFieldTypeModel<6>()(llvmDialect)); + parts.push_back(fir::getDescFieldTypeModel<1>()(&getContext())); + parts.push_back(fir::getDescFieldTypeModel<2>()(&getContext())); + parts.push_back(fir::getDescFieldTypeModel<3>()(&getContext())); + parts.push_back(fir::getDescFieldTypeModel<4>()(&getContext())); + parts.push_back(fir::getDescFieldTypeModel<5>()(&getContext())); + parts.push_back(fir::getDescFieldTypeModel<6>()(&getContext())); if (rank > 0) { - auto rowTy = fir::getDescFieldTypeModel<7>()(llvmDialect); + auto rowTy = fir::getDescFieldTypeModel<7>()(&getContext()); parts.push_back(mlir::LLVM::LLVMType::getArrayTy(rowTy, rank)); } // opt-type-ptr: i8* (see fir.tdesc) if (requiresExtendedDesc()) { - parts.push_back(fir::getExtendedDescFieldTypeModel<8>()(llvmDialect)); - parts.push_back(fir::getExtendedDescFieldTypeModel<9>()(llvmDialect)); - auto rowTy = fir::getExtendedDescFieldTypeModel<10>()(llvmDialect); + parts.push_back(fir::getExtendedDescFieldTypeModel<8>()(&getContext())); + parts.push_back(fir::getExtendedDescFieldTypeModel<9>()(&getContext())); + auto rowTy = fir::getExtendedDescFieldTypeModel<10>()(&getContext()); unsigned numLenParams = 0; // FIXME parts.push_back(mlir::LLVM::LLVMType::getArrayTy(rowTy, numLenParams)); } - return mlir::LLVM::LLVMType::getStructTy(llvmDialect, parts).getPointerTo(); + return mlir::LLVM::LLVMType::getStructTy(&getContext(), parts) + .getPointerTo(); } // fir.boxchar --> llvm<"{ ix*, i64 }"> where ix is kind mapping mlir::LLVM::LLVMType convertBoxCharType(fir::BoxCharType boxchar) { auto ptrTy = convertCharType(boxchar.getEleTy()).getPointerTo(); - auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(llvmDialect); + auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(&getContext()); SmallVector tuple{ptrTy, i64Ty}; - return mlir::LLVM::LLVMType::getStructTy(llvmDialect, tuple); + return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); } // fir.boxproc --> llvm<"{ any*, i8* }"> mlir::LLVM::LLVMType convertBoxProcType(fir::BoxProcType boxproc) { auto funcTy = convertType(boxproc.getEleTy()); auto ptrTy = unwrap(funcTy).getPointerTo(); - auto i8Ty = mlir::LLVM::LLVMType::getInt8Ty(llvmDialect); + auto i8Ty = mlir::LLVM::LLVMType::getInt8Ty(&getContext()); SmallVector tuple{ptrTy, i8Ty}; - return mlir::LLVM::LLVMType::getStructTy(llvmDialect, tuple); + return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); } unsigned characterBitsize(fir::CharacterType charTy) { @@ -230,7 +232,7 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { // fir.char --> llvm<"ix*"> where ix is scaled by kind mapping mlir::LLVM::LLVMType convertCharType(fir::CharacterType charTy) { - return mlir::LLVM::LLVMType::getIntNTy(llvmDialect, + return mlir::LLVM::LLVMType::getIntNTy(&getContext(), characterBitsize(charTy)); } @@ -243,24 +245,24 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { mlir::LLVM::LLVMType convertComplexType(fir::KindTy kind) { auto realTy = convertComplexPartType(kind); SmallVector tuple{realTy, realTy}; - return mlir::LLVM::LLVMType::getStructTy(llvmDialect, tuple); + return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); } mlir::LLVM::LLVMType getDefaultInt() { // FIXME: this should be tied to the front-end default - return mlir::LLVM::LLVMType::getInt64Ty(llvmDialect); + return mlir::LLVM::LLVMType::getInt64Ty(&getContext()); } // fir.int --> llvm.ix where ix is a kind mapping mlir::LLVM::LLVMType convertIntegerType(fir::IntType intTy) { return mlir::LLVM::LLVMType::getIntNTy( - llvmDialect, kindMapping.getIntegerBitsize(intTy.getFKind())); + &getContext(), kindMapping.getIntegerBitsize(intTy.getFKind())); } // fir.logical --> llvm.ix where ix is a kind mapping mlir::LLVM::LLVMType convertLogicalType(fir::LogicalType boolTy) { return mlir::LLVM::LLVMType::getIntNTy( - llvmDialect, kindMapping.getLogicalBitsize(boolTy.getFKind())); + &getContext(), kindMapping.getLogicalBitsize(boolTy.getFKind())); } template @@ -288,12 +290,12 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { // fir.type --> llvm<"%name = { ty... }"> mlir::LLVM::LLVMType convertRecordType(fir::RecordType derived) { - auto name{derived.getName()}; + auto name = derived.getName(); // The cache is needed to keep a unique mapping from name -> StructType - auto iter{identStructCache.find(name)}; + auto iter = identStructCache.find(name); if (iter != identStructCache.end()) return iter->second; - auto st{mlir::LLVM::LLVMType::createStructTy(llvmDialect, name)}; + auto st = mlir::LLVM::LLVMStructType::getIdentified(&getContext(), name); identStructCache[name] = st; SmallVector members; for (auto mem : derived.getTypeList()) @@ -328,21 +330,21 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { SmallVector members; for (auto mem : inMembers) members.push_back(convertType(mem).cast()); - return mlir::LLVM::LLVMType::getStructTy(llvmDialect, members); + return mlir::LLVM::LLVMType::getStructTy(&getContext(), members); } // complex --> llvm<"{t,t}"> mlir::LLVM::LLVMType convertComplexType(mlir::ComplexType complex) { auto eleTy = unwrap(convertType(complex.getElementType())); SmallVector tuple{eleTy, eleTy}; - return mlir::LLVM::LLVMType::getStructTy(llvmDialect, tuple); + return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); } // fir.tdesc --> llvm<"i8*"> // FIXME: for now use a void*, however pointer identity is not sufficient for // the f18 object v. class distinction mlir::LLVM::LLVMType convertTypeDescType(mlir::MLIRContext *ctx) { - return mlir::LLVM::LLVMType::getInt8PtrTy(llvmDialect); + return mlir::LLVM::LLVMType::getInt8PtrTy(&getContext()); } /// Convert llvm::Type::TypeID to mlir::LLVM::LLVMType @@ -350,17 +352,17 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { fir::KindTy kind) { switch (typeID) { case llvm::Type::TypeID::HalfTyID: - return mlir::LLVM::LLVMType::getHalfTy(llvmDialect); + return mlir::LLVM::LLVMType::getHalfTy(&getContext()); case llvm::Type::TypeID::FloatTyID: - return mlir::LLVM::LLVMType::getFloatTy(llvmDialect); + return mlir::LLVM::LLVMType::getFloatTy(&getContext()); case llvm::Type::TypeID::DoubleTyID: - return mlir::LLVM::LLVMType::getDoubleTy(llvmDialect); + return mlir::LLVM::LLVMType::getDoubleTy(&getContext()); case llvm::Type::TypeID::X86_FP80TyID: - return mlir::LLVM::LLVMType::getX86_FP80Ty(llvmDialect); + return mlir::LLVM::LLVMType::getX86_FP80Ty(&getContext()); case llvm::Type::TypeID::FP128TyID: - return mlir::LLVM::LLVMType::getFP128Ty(llvmDialect); + return mlir::LLVM::LLVMType::getFP128Ty(&getContext()); default: - emitError(UnknownLoc::get(llvmDialect->getContext())) + emitError(UnknownLoc::get(&getContext())) << "unsupported type: !fir.real<" << kind << ">"; return {}; } @@ -445,8 +447,8 @@ pruneNamedAttrDict(AttributeTy attrs, ArrayRef omitNames) { return result; } -inline mlir::LLVM::LLVMType getVoidPtrType(mlir::LLVM::LLVMDialect *dialect) { - return mlir::LLVM::LLVMType::getInt8PtrTy(dialect); +inline mlir::LLVM::LLVMType getVoidPtrType(mlir::MLIRContext *context) { + return mlir::LLVM::LLVMType::getInt8PtrTy(context); } namespace { @@ -459,8 +461,6 @@ class FIROpConversion : public mlir::OpConversionPattern { : mlir::OpConversionPattern(lowering, ctx, 1) {} protected: - LLVMContext &getLLVMContext() const { return lowerTy().getLLVMContext(); } - mlir::LLVM::LLVMDialect *getDialect() const { return lowerTy().getDialect(); } mlir::Type convertType(mlir::Type ty) const { return lowerTy().convertType(ty); } @@ -468,7 +468,7 @@ class FIROpConversion : public mlir::OpConversionPattern { return lowerTy().unwrap(ty); } mlir::LLVM::LLVMType voidPtrTy() const { - return getVoidPtrType(getDialect()); + return getVoidPtrType(&lowerTy().getContext()); } mlir::LLVM::ConstantOp @@ -616,17 +616,17 @@ struct AllocaOpConversion : public FIROpConversion { } // namespace static mlir::LLVM::LLVMFuncOp -getMalloc(fir::AllocMemOp op, mlir::ConversionPatternRewriter &rewriter, - mlir::LLVM::LLVMDialect *dialect) { +getMalloc(fir::AllocMemOp op, mlir::ConversionPatternRewriter &rewriter) { auto module = op.getParentOfType(); if (auto mallocFunc = module.lookupSymbol("malloc")) return mallocFunc; mlir::OpBuilder moduleBuilder( op.getParentOfType().getBodyRegion()); - auto indexType = mlir::LLVM::LLVMType::getInt64Ty(dialect); + auto indexType = mlir::LLVM::LLVMType::getInt64Ty(op.getContext()); return moduleBuilder.create( rewriter.getUnknownLoc(), "malloc", - mlir::LLVM::LLVMType::getFunctionTy(getVoidPtrType(dialect), indexType, + mlir::LLVM::LLVMType::getFunctionTy(getVoidPtrType(op.getContext()), + indexType, /*isVarArg=*/false)); } @@ -639,8 +639,7 @@ struct AllocMemOpConversion : public FIROpConversion { matchAndRewrite(fir::AllocMemOp heap, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { auto ty = convertType(heap.getType()); - auto dialect = getDialect(); - auto mallocFunc = getMalloc(heap, rewriter, dialect); + auto mallocFunc = getMalloc(heap, rewriter); auto loc = heap.getLoc(); auto ity = lowerTy().indexType(); auto c1 = genConstantIndex(loc, ity, rewriter, 1); @@ -657,17 +656,17 @@ struct AllocMemOpConversion : public FIROpConversion { } // namespace /// obtain the free() function -static mlir::LLVM::LLVMFuncOp getFree(fir::FreeMemOp op, - mlir::ConversionPatternRewriter &rewriter, - mlir::LLVM::LLVMDialect *dialect) { +static mlir::LLVM::LLVMFuncOp +getFree(fir::FreeMemOp op, mlir::ConversionPatternRewriter &rewriter) { auto module = op.getParentOfType(); if (auto freeFunc = module.lookupSymbol("free")) return freeFunc; mlir::OpBuilder moduleBuilder(module.getBodyRegion()); - auto voidType = mlir::LLVM::LLVMType::getVoidTy(dialect); + auto voidType = mlir::LLVM::LLVMType::getVoidTy(op.getContext()); return moduleBuilder.create( rewriter.getUnknownLoc(), "free", - mlir::LLVM::LLVMType::getFunctionTy(voidType, getVoidPtrType(dialect), + mlir::LLVM::LLVMType::getFunctionTy(voidType, + getVoidPtrType(op.getContext()), /*isVarArg=*/false)); } @@ -679,13 +678,12 @@ struct FreeMemOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::FreeMemOp freemem, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - auto dialect = getDialect(); - auto freeFunc = getFree(freemem, rewriter, dialect); + auto freeFunc = getFree(freemem, rewriter); auto bitcast = rewriter.create( freemem.getLoc(), voidPtrTy(), operands[0]); freemem.setAttr("callee", rewriter.getSymbolRefAttr(freeFunc)); rewriter.replaceOpWithNewOp( - freemem, mlir::LLVM::LLVMType::getVoidTy(dialect), + freemem, mlir::LLVM::LLVMType::getVoidTy(freemem.getContext()), SmallVector{bitcast}, freemem.getAttrs()); return success(); } @@ -879,7 +877,7 @@ struct BoxTypeDescOpConversion : public FIROpConversion { auto pty = unwrap(ty).getPointerTo(); auto p = rewriter.create(loc, pty, args); auto ld = rewriter.create(loc, ty, p); - auto i8ptr = mlir::LLVM::LLVMType::getInt8PtrTy(getDialect()); + auto i8ptr = mlir::LLVM::LLVMType::getInt8PtrTy(boxtypedesc.getContext()); rewriter.replaceOpWithNewOp(boxtypedesc, i8ptr, ld); return success(); } @@ -1034,6 +1032,17 @@ struct ConstfOpConversion : public FIROpConversion { struct ConvertOpConversion : public FIROpConversion { using FIROpConversion::FIROpConversion; + static bool isFloatingPointTy(mlir::LLVM::LLVMType ty) { + return ty.isa() || + ty.isa() || + ty.isa() || + ty.isa() || + ty.isa() || + ty.isa() || + ty.isa() || + ty.isa(); + } + mlir::LogicalResult matchAndRewrite(fir::ConvertOp convert, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { @@ -1041,18 +1050,22 @@ struct ConvertOpConversion : public FIROpConversion { auto fromTy = unwrap(fromTy_); auto toTy_ = convertType(convert.res().getType()); auto toTy = unwrap(toTy_); - auto *fromLLVMTy = fromTy.getUnderlyingType(); - auto *toLLVMTy = toTy.getUnderlyingType(); auto &op0 = operands[0]; - if (fromLLVMTy == toLLVMTy) { + if (fromTy == toTy) { rewriter.replaceOp(convert, op0); return success(); } auto loc = convert.getLoc(); auto convertFpToFp = [&](mlir::Value val, unsigned fromBits, unsigned toBits, mlir::Type toTy) -> mlir::Value { - // FIXME: what if different reps (F16, BF16) are the same size? - assert(fromBits != toBits); + if (fromBits == toBits) { + // TODO: Converting between two floating-point representations with the + // same bitwidth is not allowed for now. + mlir::emitError(loc, + "cannot implicitly convert between two floating-point " + "representations of the same bitwidth"); + return {}; + } if (fromBits > toBits) return rewriter.create(loc, toTy, val); return rewriter.create(loc, toTy, val); @@ -1071,8 +1084,8 @@ struct ConvertOpConversion : public FIROpConversion { rewriter.create(loc, fromTy_, op0, one); auto ty = convertType(getComplexEleTy(convert.value().getType())); auto nt = convertType(getComplexEleTy(convert.res().getType())); - auto fromBits = unwrap(ty).getUnderlyingType()->getPrimitiveSizeInBits(); - auto toBits = unwrap(nt).getUnderlyingType()->getPrimitiveSizeInBits(); + auto fromBits = unwrap(ty).getPrimitiveSizeInBits(); + auto toBits = unwrap(nt).getPrimitiveSizeInBits(); auto rc = convertFpToFp(rp, fromBits, toBits, nt); auto ic = convertFpToFp(ip, fromBits, toBits, nt); auto un = rewriter.create(loc, toTy_); @@ -1082,22 +1095,22 @@ struct ConvertOpConversion : public FIROpConversion { ic, one); return mlir::success(); } - if (fromLLVMTy->isFloatingPointTy()) { - if (toLLVMTy->isFloatingPointTy()) { - auto fromBits = fromLLVMTy->getPrimitiveSizeInBits(); - auto toBits = toLLVMTy->getPrimitiveSizeInBits(); + if (isFloatingPointTy(fromTy)) { + if (isFloatingPointTy(toTy)) { + auto fromBits = fromTy.getPrimitiveSizeInBits(); + auto toBits = toTy.getPrimitiveSizeInBits(); auto v = convertFpToFp(op0, fromBits, toBits, toTy); rewriter.replaceOp(convert, v); return mlir::success(); } - if (toLLVMTy->isIntegerTy()) { + if (toTy.isIntegerTy()) { rewriter.replaceOpWithNewOp(convert, toTy, op0); return mlir::success(); } - } else if (fromLLVMTy->isIntegerTy()) { - if (toLLVMTy->isIntegerTy()) { - std::size_t fromBits{fromLLVMTy->getIntegerBitWidth()}; - std::size_t toBits{toLLVMTy->getIntegerBitWidth()}; + } else if (fromTy.isIntegerTy()) { + if (toTy.isIntegerTy()) { + std::size_t fromBits{fromTy.getIntegerBitWidth()}; + std::size_t toBits{toTy.getIntegerBitWidth()}; assert(fromBits != toBits); if (fromBits > toBits) { rewriter.replaceOpWithNewOp(convert, toTy, op0); @@ -1106,20 +1119,20 @@ struct ConvertOpConversion : public FIROpConversion { rewriter.replaceOpWithNewOp(convert, toTy, op0); return mlir::success(); } - if (toLLVMTy->isFloatingPointTy()) { + if (isFloatingPointTy(toTy)) { rewriter.replaceOpWithNewOp(convert, toTy, op0); return mlir::success(); } - if (toLLVMTy->isPointerTy()) { + if (toTy.isPointerTy()) { rewriter.replaceOpWithNewOp(convert, toTy, op0); return mlir::success(); } - } else if (fromLLVMTy->isPointerTy()) { - if (toLLVMTy->isIntegerTy()) { + } else if (fromTy.isPointerTy()) { + if (toTy.isIntegerTy()) { rewriter.replaceOpWithNewOp(convert, toTy, op0); return mlir::success(); } - if (toLLVMTy->isPointerTy()) { + if (toTy.isPointerTy()) { rewriter.replaceOpWithNewOp(convert, toTy, op0); return mlir::success(); } @@ -1205,7 +1218,7 @@ struct EmboxCommonConversion : public FIROpConversion { /// Generate an alloca of size `size` and cast it to type `toTy` mlir::LLVM::AllocaOp genAllocaWithType(mlir::Location loc, mlir::LLVM::LLVMType toTy, - unsigned alignment, mlir::LLVM::LLVMDialect *dialect, + unsigned alignment, mlir::ConversionPatternRewriter &rewriter) const { auto thisPt = rewriter.saveInsertionPoint(); auto *thisBlock = rewriter.getInsertionBlock(); @@ -1235,11 +1248,9 @@ struct EmboxCommonConversion : public FIROpConversion { mlir::Value integerCast(mlir::Location loc, mlir::ConversionPatternRewriter &rewriter, mlir::LLVM::LLVMType ty, mlir::Value val) const { - auto toSize = ty.getUnderlyingType()->getPrimitiveSizeInBits(); - auto fromSize = val.getType() - .cast() - .getUnderlyingType() - ->getPrimitiveSizeInBits(); + auto toSize = ty.getPrimitiveSizeInBits(); + auto fromSize = + val.getType().cast().getPrimitiveSizeInBits(); if (toSize < fromSize) return rewriter.create(loc, ty, val); if (toSize > fromSize) @@ -1346,11 +1357,10 @@ struct EmboxOpConversion : public EmboxCommonConversion { assert(!embox.getShape()); auto loc = embox.getLoc(); - auto *dialect = getDialect(); auto boxTy = embox.getType().dyn_cast(); assert(boxTy); auto ty = unwrap(lowerTy().convertBoxType(boxTy, 0)); - auto alloca = genAllocaWithType(loc, ty, defaultAlign, dialect, rewriter); + auto alloca = genAllocaWithType(loc, ty, defaultAlign, rewriter); auto c0 = genConstantOffset(loc, rewriter, 0); // Basic pattern to write a field in the descriptor @@ -1396,12 +1406,11 @@ struct XEmboxOpConversion : public EmboxCommonConversion { matchAndRewrite(fir::XEmboxOp xbox, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { auto loc = xbox.getLoc(); - auto *dialect = getDialect(); auto rank = xbox.getRank(); auto boxTy = xbox.getType().dyn_cast(); assert(boxTy); auto ty = unwrap(lowerTy().convertBoxType(boxTy, rank)); - auto alloca = genAllocaWithType(loc, ty, defaultAlign, dialect, rewriter); + auto alloca = genAllocaWithType(loc, ty, defaultAlign, rewriter); auto c0 = genConstantOffset(loc, rewriter, 0); // Basic pattern to write a field in the descriptor @@ -1436,7 +1445,7 @@ struct XEmboxOpConversion : public EmboxCommonConversion { storeField(6, /*addend*/ c0, intCast); // Generate the triples in the dims field of the descriptor - auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(dialect); + auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(xbox.getContext()); auto i64PtrTy = i64Ty.getPointerTo(); assert(xbox.shapeOperands().size()); unsigned shapeOff = 1; @@ -1540,18 +1549,17 @@ struct ValueOpCommon { static void toRowMajor(llvm::SmallVectorImpl &attrs, mlir::LLVM::LLVMType ty) { assert(ty && "type is null"); - auto *llTy = ty.getUnderlyingType(); const auto end = attrs.size(); for (std::remove_const_t i = 0; i < end; ++i) { - if (auto *seq = dyn_cast(llTy)) { + if (auto seq = ty.dyn_cast()) { const auto dim = getDimension(seq); if (dim > 1) { std::reverse(attrs.begin() + i, attrs.begin() + i + dim); i += dim - 1; } - llTy = getArrayElementType(seq); - } else if (auto *st = dyn_cast(llTy)) { - llTy = st->getElementType(attrs[i].cast().getInt()); + ty = getArrayElementType(seq); + } else if (auto st = ty.dyn_cast()) { + ty = st.getBody()[attrs[i].cast().getInt()]; } else { llvm_unreachable("index into invalid type"); } @@ -1559,18 +1567,20 @@ struct ValueOpCommon { } private: - static unsigned getDimension(llvm::ArrayType *ty) { + static unsigned getDimension(mlir::LLVM::LLVMArrayType ty) { unsigned result = 1; - for (auto *eleTy = dyn_cast(ty->getElementType()); eleTy; - eleTy = dyn_cast(eleTy->getElementType())) + for (auto eleTy = ty.getElementType().dyn_cast(); + eleTy; + eleTy = eleTy.getElementType().dyn_cast()) ++result; return result; } - static llvm::Type *getArrayElementType(llvm::ArrayType *ty) { - auto *eleTy = ty->getElementType(); - while (auto *arrTy = dyn_cast(eleTy)) - eleTy = arrTy->getElementType(); + static mlir::LLVM::LLVMType + getArrayElementType(mlir::LLVM::LLVMArrayType ty) { + auto eleTy = ty.getElementType(); + while (auto arrTy = eleTy.dyn_cast()) + eleTy = arrTy.getElementType(); return eleTy; } }; @@ -1697,12 +1707,11 @@ struct XArrayCoorOpConversion mlir::Value asType(mlir::Location loc, mlir::ConversionPatternRewriter &rewriter, mlir::LLVM::LLVMType toTy, mlir::Value val) const { - auto *fromLLVMTy = unwrap(convertType(val.getType())).getUnderlyingType(); - auto *toLLVMTy = toTy.getUnderlyingType(); - assert(fromLLVMTy->isIntegerTy() && toLLVMTy->isIntegerTy()); - if (fromLLVMTy->getIntegerBitWidth() < toLLVMTy->getIntegerBitWidth()) + auto fromTy = unwrap(convertType(val.getType())); + assert(fromTy.isIntegerTy() && toTy.isIntegerTy()); + if (fromTy.getIntegerBitWidth() < toTy.getIntegerBitWidth()) return rewriter.create(loc, toTy, val); - if (fromLLVMTy->getIntegerBitWidth() > toLLVMTy->getIntegerBitWidth()) + if (fromTy.getIntegerBitWidth() > toTy.getIntegerBitWidth()) return rewriter.create(loc, toTy, val); return val; } @@ -2734,7 +2743,7 @@ struct FIRToLLVMLoweringPass if (disableFirToLLVMIR) return; - auto *context{&getContext()}; + auto *context = getModule().getContext(); FIRToLLVMTypeConverter typeConverter{context, uniquer}; auto loc = mlir::UnknownLoc::get(context); mlir::OwningRewritePatternList pattern; @@ -2792,13 +2801,16 @@ struct LLVMIRLoweringPass if (disableLLVM) return; - if (auto llvmModule = mlir::translateModuleToLLVMIR(getModule())) { + auto optName = getModule().getName(); + llvm::LLVMContext llvmCtx; + if (auto llvmModule = mlir::translateModuleToLLVMIR( + getModule(), llvmCtx, optName ? *optName : "FIRModule")) { llvmModule->print(output, nullptr); return; } - auto *ctxt = getModule().getContext(); - mlir::emitError(mlir::UnknownLoc::get(ctxt), "could not emit LLVM-IR\n"); + auto *ctx = getModule().getContext(); + mlir::emitError(mlir::UnknownLoc::get(ctx), "could not emit LLVM-IR\n"); signalPassFailure(); } diff --git a/flang/lib/Optimizer/CodeGen/DescriptorModel.h b/flang/lib/Optimizer/CodeGen/DescriptorModel.h index 0c797694b352f..65e3c61b566c0 100644 --- a/flang/lib/Optimizer/CodeGen/DescriptorModel.h +++ b/flang/lib/Optimizer/CodeGen/DescriptorModel.h @@ -11,7 +11,7 @@ #include "../runtime/descriptor.h" #include "flang/ISO_Fortran_binding.h" -#include "mlir/Dialect/LLVMIR/LLVMDialect.h" +#include "mlir/Dialect/LLVMIR/LLVMTypes.h" #include "llvm/Support/ErrorHandling.h" #include @@ -32,7 +32,7 @@ namespace fir { // //===----------------------------------------------------------------------===// -using TypeBuilderFunc = mlir::LLVM::LLVMType (*)(mlir::LLVM::LLVMDialect *); +using TypeBuilderFunc = mlir::LLVM::LLVMType (*)(mlir::MLIRContext *); /// Get the LLVM IR dialect model for building a particular C++ type, `T`. template @@ -40,60 +40,60 @@ TypeBuilderFunc getModel(); template <> TypeBuilderFunc getModel() { - return [](mlir::LLVM::LLVMDialect *dialect) { - return mlir::LLVM::LLVMType::getInt8PtrTy(dialect); + return [](mlir::MLIRContext *context) { + return mlir::LLVM::LLVMType::getInt8PtrTy(context); }; } template <> TypeBuilderFunc getModel() { - return [](mlir::LLVM::LLVMDialect *dialect) { - return mlir::LLVM::LLVMType::getIntNTy(dialect, sizeof(unsigned) * 8); + return [](mlir::MLIRContext *context) { + return mlir::LLVM::LLVMType::getIntNTy(context, sizeof(unsigned) * 8); }; } template <> TypeBuilderFunc getModel() { - return [](mlir::LLVM::LLVMDialect *dialect) { - return mlir::LLVM::LLVMType::getIntNTy(dialect, sizeof(int) * 8); + return [](mlir::MLIRContext *context) { + return mlir::LLVM::LLVMType::getIntNTy(context, sizeof(int) * 8); }; } template <> TypeBuilderFunc getModel() { - return [](mlir::LLVM::LLVMDialect *dialect) { - return mlir::LLVM::LLVMType::getIntNTy(dialect, sizeof(unsigned long) * 8); + return [](mlir::MLIRContext *context) { + return mlir::LLVM::LLVMType::getIntNTy(context, sizeof(unsigned long) * 8); }; } template <> TypeBuilderFunc getModel() { - return [](mlir::LLVM::LLVMDialect *dialect) { - return mlir::LLVM::LLVMType::getIntNTy(dialect, + return [](mlir::MLIRContext *context) { + return mlir::LLVM::LLVMType::getIntNTy(context, sizeof(unsigned long long) * 8); }; } template <> TypeBuilderFunc getModel() { - return [](mlir::LLVM::LLVMDialect *dialect) { + return [](mlir::MLIRContext *context) { return mlir::LLVM::LLVMType::getIntNTy( - dialect, sizeof(Fortran::ISO::CFI_rank_t) * 8); + context, sizeof(Fortran::ISO::CFI_rank_t) * 8); }; } template <> TypeBuilderFunc getModel() { - return [](mlir::LLVM::LLVMDialect *dialect) { + return [](mlir::MLIRContext *context) { return mlir::LLVM::LLVMType::getIntNTy( - dialect, sizeof(Fortran::ISO::CFI_type_t) * 8); + context, sizeof(Fortran::ISO::CFI_type_t) * 8); }; } template <> TypeBuilderFunc getModel() { - return [](mlir::LLVM::LLVMDialect *dialect) { + return [](mlir::MLIRContext *context) { return mlir::LLVM::LLVMType::getIntNTy( - dialect, sizeof(Fortran::ISO::CFI_index_t) * 8); + context, sizeof(Fortran::ISO::CFI_index_t) * 8); }; } template <> TypeBuilderFunc getModel() { - return [](mlir::LLVM::LLVMDialect *dialect) { - auto indexTy = getModel()(dialect); + return [](mlir::MLIRContext *context) { + auto indexTy = getModel()(context); return mlir::LLVM::LLVMType::getArrayTy(indexTy, 3); }; } diff --git a/flang/test/lit.site.cfg.py.in b/flang/test/lit.site.cfg.py.in index 8f13c3013e024..f4568b57cb235 100644 --- a/flang/test/lit.site.cfg.py.in +++ b/flang/test/lit.site.cfg.py.in @@ -13,6 +13,7 @@ config.python_executable = "@PYTHON_EXECUTABLE@" config.c_executable = "@CMAKE_C_COMPILER@" config.cplusplus_executable = "@CMAKE_CXX_COMPILER@" config.macos_sysroot = "@CMAKE_OSX_SYSROOT@" +config.flang_standalone_build = "@FLANG_STANDALONE_BUILD@" # Control the regression test for flang-new driver import lit.util From a4fdfbec044e022a06c49815e67d0d3e5360e537 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 13 Aug 2020 16:30:03 -0700 Subject: [PATCH 0230/1017] add --target option to tools add FIRContext files --- flang/tools/bbc/CMakeLists.txt | 15 +++++++++------ flang/tools/bbc/bbc.cpp | 6 ++++++ flang/tools/tco/CMakeLists.txt | 14 +++++++++----- 3 files changed, 24 insertions(+), 11 deletions(-) diff --git a/flang/tools/bbc/CMakeLists.txt b/flang/tools/bbc/CMakeLists.txt index d3e3b69527041..98f2fe95b009b 100644 --- a/flang/tools/bbc/CMakeLists.txt +++ b/flang/tools/bbc/CMakeLists.txt @@ -1,7 +1,14 @@ +set(LLVM_LINK_COMPONENTS + AllTargetsAsmParsers + AllTargetsCodeGens + AllTargetsDescs + AllTargetsInfos +) +add_llvm_tool(bbc bbc.cpp) +llvm_update_compile_flags(bbc) get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) - -set(LIBS +target_link_libraries(bbc PRIVATE FIROptimizer ${dialect_libs} MLIRLLVMIR @@ -12,7 +19,3 @@ set(LIBS FortranSemantics FortranLower ) - -add_flang_tool(bbc bbc.cpp) -llvm_update_compile_flags(bbc) -target_link_libraries(bbc PRIVATE ${LIBS}) diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index b9e82a578e09e..6f4a569047212 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -41,11 +41,13 @@ #include "mlir/Pass/PassManager.h" #include "mlir/Pass/PassRegistry.h" #include "mlir/Transforms/Passes.h" +#include "llvm/ADT/Triple.h" #include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorOr.h" #include "llvm/Support/InitLLVM.h" #include "llvm/Support/MemoryBuffer.h" #include "llvm/Support/SourceMgr.h" +#include "llvm/Support/TargetSelect.h" #include "llvm/Support/ToolOutputFile.h" #include "llvm/Support/raw_ostream.h" @@ -117,6 +119,9 @@ static llvm::cl::opt enableOpenMP("fopenmp", static llvm::cl::opt dumpModuleOnFailure("dump-module-on-failure", llvm::cl::init(false)); +static llvm::cl::opt + targetTriple("target", llvm::cl::desc("specify a target triple")); + //===----------------------------------------------------------------------===// using ProgramName = std::string; @@ -280,6 +285,7 @@ int main(int argc, char **argv) { fir::registerOptPasses(); [[maybe_unused]] llvm::InitLLVM y(argc, argv); + llvm::InitializeAllTargets(); mlir::registerAsmPrinterCLOptions(); mlir::registerMLIRContextCLOptions(); mlir::registerPassManagerCLOptions(); diff --git a/flang/tools/tco/CMakeLists.txt b/flang/tools/tco/CMakeLists.txt index 9f3d0528e6bd7..64701c4726cef 100644 --- a/flang/tools/tco/CMakeLists.txt +++ b/flang/tools/tco/CMakeLists.txt @@ -1,7 +1,14 @@ +set(LLVM_LINK_COMPONENTS + AllTargetsAsmParsers + AllTargetsCodeGens + AllTargetsDescs + AllTargetsInfos +) +add_llvm_tool(tco tco.cpp) +llvm_update_compile_flags(tco) get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) - -set(LIBS +target_link_libraries(tco PRIVATE FIROptimizer ${dialect_libs} MLIRIR @@ -17,6 +24,3 @@ set(LIBS MLIRSupport MLIRVectorToLLVM ) - -add_flang_tool(tco tco.cpp) -target_link_libraries(tco PRIVATE ${LIBS}) From b0b32739267d2dba023b52bdbb3e86aef9d6f4ba Mon Sep 17 00:00:00 2001 From: rajan Date: Tue, 18 Aug 2020 13:02:03 -0400 Subject: [PATCH 0231/1017] adding integer constraints for convert rewrite optimizations (#405) --- .../Optimizer/Transforms/RewritePatterns.td | 37 ++++++++++++------- 1 file changed, 24 insertions(+), 13 deletions(-) diff --git a/flang/include/flang/Optimizer/Transforms/RewritePatterns.td b/flang/include/flang/Optimizer/Transforms/RewritePatterns.td index 4b5d1140f8f75..76adaf70c653e 100644 --- a/flang/include/flang/Optimizer/Transforms/RewritePatterns.td +++ b/flang/include/flang/Optimizer/Transforms/RewritePatterns.td @@ -17,18 +17,29 @@ include "mlir/IR/OpBase.td" include "flang/Optimizer/Dialect/FIROps.td" -def TypesAreIdentical : Constraint>; - -def ConvertConvertOptPattern : Pat<(fir_ConvertOp (fir_ConvertOp $arg)), - (fir_ConvertOp $arg)>; - - -def RedundantConvertOptPattern : Pat<(fir_ConvertOp:$res $arg), - (replaceWithValue $arg), - [(TypesAreIdentical $res, $arg)]>; - -def CombineConvertOptPattern : Pat<(fir_ConvertOp:$res (fir_ConvertOp $arg)), - (replaceWithValue $arg), - [(TypesAreIdentical $res, $arg)]>; +def IdenticalTypePred : Constraint>; +def IntegerTypePred : Constraint>; + +def SmallerWidthPred + : Constraint>; + +def ConvertConvertOptPattern + : Pat<(fir_ConvertOp (fir_ConvertOp $arg)), + (fir_ConvertOp $arg), + [(IntegerTypePred $arg)]>; + +def RedundantConvertOptPattern + : Pat<(fir_ConvertOp:$res $arg), + (replaceWithValue $arg), + [(IdenticalTypePred $res, $arg) + ,(IntegerTypePred $arg)]>; + +def CombineConvertOptPattern + : Pat<(fir_ConvertOp:$res(fir_ConvertOp:$irm $arg)), + (replaceWithValue $arg), + [(IdenticalTypePred $res, $arg) + ,(IntegerTypePred $arg) + ,(IntegerTypePred $irm) + ,(SmallerWidthPred $arg, $irm)]>; #endif // FIR_REWRITE_PATTERNS From d91c2a917086b1fe94b211c80b4aa08f77be2c10 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 19 Aug 2020 18:26:17 -0700 Subject: [PATCH 0232/1017] change back to using the less capable add_flang_tool function --- flang/tools/bbc/CMakeLists.txt | 4 +++- flang/tools/tco/CMakeLists.txt | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/flang/tools/bbc/CMakeLists.txt b/flang/tools/bbc/CMakeLists.txt index 98f2fe95b009b..ccd0c78daf784 100644 --- a/flang/tools/bbc/CMakeLists.txt +++ b/flang/tools/bbc/CMakeLists.txt @@ -4,8 +4,9 @@ set(LLVM_LINK_COMPONENTS AllTargetsDescs AllTargetsInfos ) +llvm_map_components_to_libnames(llvm_libs ${LLVM_LINK_COMPONENTS}) -add_llvm_tool(bbc bbc.cpp) +add_flang_tool(bbc bbc.cpp) llvm_update_compile_flags(bbc) get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) target_link_libraries(bbc PRIVATE @@ -18,4 +19,5 @@ target_link_libraries(bbc PRIVATE FortranEvaluate FortranSemantics FortranLower + ${llvm_libs} ) diff --git a/flang/tools/tco/CMakeLists.txt b/flang/tools/tco/CMakeLists.txt index 64701c4726cef..1e3c031186723 100644 --- a/flang/tools/tco/CMakeLists.txt +++ b/flang/tools/tco/CMakeLists.txt @@ -4,8 +4,9 @@ set(LLVM_LINK_COMPONENTS AllTargetsDescs AllTargetsInfos ) +llvm_map_components_to_libnames(llvm_libs ${LLVM_LINK_COMPONENTS}) -add_llvm_tool(tco tco.cpp) +add_flang_tool(tco tco.cpp) llvm_update_compile_flags(tco) get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) target_link_libraries(tco PRIVATE @@ -23,4 +24,5 @@ target_link_libraries(tco PRIVATE MLIRStandardToLLVM MLIRSupport MLIRVectorToLLVM + ${llvm_libs} ) From e1ec28be3fd885409bc314679c7c42a86bd0cad5 Mon Sep 17 00:00:00 2001 From: rajan Date: Thu, 20 Aug 2020 19:14:46 -0400 Subject: [PATCH 0233/1017] fixing affine demotion for multi dimensions, adding tests for full affine pipeline (#406) * fix for shapes and multi dimension arrays * removing affine promotion from tco, tests for affine --- .../Optimizer/Transforms/AffineDemotion.cpp | 8 ++ .../Optimizer/Transforms/AffinePromotion.cpp | 36 +++-- flang/test/Fir/affine-loop-fusion.fir | 2 +- flang/test/Fir/affine-loop-unswitch.fir | 2 +- flang/test/Fir/arr-driver.c | 127 ++++++++++++++++++ flang/test/Fir/arr-end-end.f90 | 117 ++++++++++++++++ 6 files changed, 271 insertions(+), 21 deletions(-) create mode 100644 flang/test/Fir/arr-driver.c create mode 100644 flang/test/Fir/arr-end-end.f90 diff --git a/flang/lib/Optimizer/Transforms/AffineDemotion.cpp b/flang/lib/Optimizer/Transforms/AffineDemotion.cpp index 77e356a0911a9..ee0458503bd7d 100644 --- a/flang/lib/Optimizer/Transforms/AffineDemotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffineDemotion.cpp @@ -77,6 +77,14 @@ class ConvertConversion : public mlir::OpRewritePattern { matchAndRewrite(fir::ConvertOp op, mlir::PatternRewriter &rewriter) const override { if (op.res().getType().isa()) { + if (auto refTy = op.value().getType().dyn_cast()) + if (auto arrTy = refTy.getEleTy().dyn_cast()) { + fir::SequenceType::Shape flatShape = {fir::SequenceType::getUnknownExtent()}; + auto flatArrTy = fir::SequenceType::get(flatShape, arrTy.getEleTy()); + auto flatTy = fir::ReferenceType::get(flatArrTy); + rewriter.replaceOpWithNewOp(op, flatTy, op.value()); + return success(); + } rewriter.startRootUpdate(op.getParentOp()); op.getResult().replaceAllUsesWith(op.value()); rewriter.finalizeRootUpdate(op.getParentOp()); diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index b2a3d37726944..40a44731609fc 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -24,12 +24,6 @@ #define DEBUG_TYPE "flang-affine-promotion" -/// disable FIR to affine dialect conversion -static llvm::cl::opt - disableAffinePromo("disable-affine-promotion", - llvm::cl::desc("disable FIR to Affine pass"), - llvm::cl::init(true)); - using namespace fir; namespace { @@ -57,13 +51,13 @@ class AffineLoopAnalysis { return analyzeMemoryAccess(loopOperation) && analyzeBody(loopOperation, functionAnalysis); } - bool analyzeArrayReference(mlir::Value); + bool analyzeReference(mlir::Value); bool analyzeMemoryAccess(fir::DoLoopOp loopOperation) { for (auto loadOp : loopOperation.getOps()) - if (!analyzeArrayReference(loadOp.memref())) + if (!analyzeReference(loadOp.memref())) return false; for (auto storeOp : loopOperation.getOps()) - if (!analyzeArrayReference(storeOp.memref())) + if (!analyzeReference(storeOp.memref())) return false; return true; } @@ -234,17 +228,23 @@ bool analyzeCoordinate(mlir::Value coordinate) { return false; } } -bool AffineLoopAnalysis::analyzeArrayReference(mlir::Value arrayRef) { - bool canPromote = true; - if (auto acoOp = arrayRef.getDefiningOp()) { +bool AffineLoopAnalysis::analyzeReference(mlir::Value memref) { + if (auto acoOp = memref.getDefiningOp()) { + bool canPromote = true; for (auto coordinate : acoOp.indices()) canPromote = canPromote && analyzeCoordinate(coordinate); - } else { + return canPromote; + } + if (auto coOp = memref.getDefiningOp()) { LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: cannot promote loop, " - "array reference uses non ArrayCoorOp\n";); - canPromote = false; + "array uses non ArrayCoorOp\n"; + coOp.dump();); + + return false; } - return canPromote; + LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: unknown type of memory " + "reference for array load\n";); + return false; } bool AffineLoopAnalysis::analyzeBody(fir::DoLoopOp loopOperation, @@ -315,7 +315,7 @@ void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeOp shape, auto one = rewriter.create( acoOp.getLoc(), rewriter.getIndexType(), rewriter.getIndexAttr(1)); auto end = shape.extents().size(); - for (decltype(end) i = 0; i < end; ++(++i)) { + for (decltype(end) i = 0; i < end; ++i) { indexArgs.push_back(one); indexArgs.push_back(*iter++); indexArgs.push_back(one); @@ -527,8 +527,6 @@ class AffineDialectPromotion : public AffineDialectPromotionBase { public: void runOnFunction() override { - if (disableAffinePromo) - return; auto *context = &getContext(); auto function = getFunction(); diff --git a/flang/test/Fir/affine-loop-fusion.fir b/flang/test/Fir/affine-loop-fusion.fir index 637c6e95febf7..8ee4da431f7ae 100644 --- a/flang/test/Fir/affine-loop-fusion.fir +++ b/flang/test/Fir/affine-loop-fusion.fir @@ -1,6 +1,6 @@ // Test loop fusion after affine promotion -// RUN: tco --promote-to-affine --disable-affine-promotion=false --affine-loop-invariant-code-motion --cse --affine-loop-fusion --simplify-affine-structures --cse --memref-dataflow-opt %s | FileCheck %s +// RUN: tco --promote-to-affine --affine-loop-invariant-code-motion --cse --affine-loop-fusion --simplify-affine-structures --cse --memref-dataflow-opt %s | FileCheck %s !arr_d1 = type !fir.ref> #arr_len = affine_map<()[j1,k1] -> (k1 - j1 + 1)> diff --git a/flang/test/Fir/affine-loop-unswitch.fir b/flang/test/Fir/affine-loop-unswitch.fir index ac7532cfc56ef..e43a7fd563d3a 100644 --- a/flang/test/Fir/affine-loop-unswitch.fir +++ b/flang/test/Fir/affine-loop-unswitch.fir @@ -1,6 +1,6 @@ // Test code motion for affine if -// RUN: tco --promote-to-affine --disable-affine-promotion=false --affine-loop-invariant-code-motion --cse %s | FileCheck %s +// RUN: tco --promote-to-affine --affine-loop-invariant-code-motion --cse %s | FileCheck %s !arr_d1 = type !fir.ref> #arr_len = affine_map<()[j1,k1] -> (k1 - j1 + 1)> diff --git a/flang/test/Fir/arr-driver.c b/flang/test/Fir/arr-driver.c new file mode 100644 index 0000000000000..7d2538de8cd03 --- /dev/null +++ b/flang/test/Fir/arr-driver.c @@ -0,0 +1,127 @@ +#include +#include +#include + +/* #define DEBUG */ + +typedef struct { + int *a1,*a2,*re,*ex,len; +} data; + + +void print_arr(int *a, int len) { + printf("[%d", a[0]); + for (int i=1; i Date: Fri, 21 Aug 2020 10:45:32 -0400 Subject: [PATCH 0234/1017] rewrite for forwarding index constants through convert (#407) --- .../flang/Optimizer/Transforms/RewritePatterns.td | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/flang/include/flang/Optimizer/Transforms/RewritePatterns.td b/flang/include/flang/Optimizer/Transforms/RewritePatterns.td index 76adaf70c653e..97bc1a4ae4638 100644 --- a/flang/include/flang/Optimizer/Transforms/RewritePatterns.td +++ b/flang/include/flang/Optimizer/Transforms/RewritePatterns.td @@ -15,13 +15,16 @@ #define FIR_REWRITE_PATTERNS include "mlir/IR/OpBase.td" +include "mlir/Dialect/StandardOps/IR/Ops.td" include "flang/Optimizer/Dialect/FIROps.td" def IdenticalTypePred : Constraint>; def IntegerTypePred : Constraint>; +def IndexTypePred : Constraint()">>; def SmallerWidthPred - : Constraint>; + : Constraint>; def ConvertConvertOptPattern : Pat<(fir_ConvertOp (fir_ConvertOp $arg)), @@ -42,4 +45,14 @@ def CombineConvertOptPattern ,(IntegerTypePred $irm) ,(SmallerWidthPred $arg, $irm)]>; +def createConstantOp + : NativeCodeCall<"$_builder.create" + "($_loc, $_builder.getIndexType(), " + "rewriter.getIndexAttr($1.dyn_cast().getInt()))">; + +def ForwardConstantConvertPattern + : Pat<(fir_ConvertOp:$res (ConstantOp $attr)), + (createConstantOp $res, $attr), + [(IndexTypePred $res)]>; + #endif // FIR_REWRITE_PATTERNS From cadc91b65abb83f313ea55fdce1cc34c59991841 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 21 Aug 2020 08:42:14 -0700 Subject: [PATCH 0235/1017] Fix for issue #403 (and duplicates). Generalize string literal creation to handle data with NUL characters and to properly support CHARACTER of KIND=2 and KIND=4. This allows the creation of ASCIIZ strings (needed for Fortran runtime support functions requiring C style strings). --- flang/lib/Lower/ConvertExpr.cpp | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 46acee5f8360e..593c5f8fb3460 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -710,8 +710,19 @@ class ExprLowering { {len}, fir::CharacterType::get(builder.getContext(), KIND)); auto consLit = [&]() -> fir::StringLitOp { auto context = builder.getContext(); - auto strAttr = - mlir::StringAttr::get((const char *)value.c_str(), context); + mlir::Attribute strAttr; + if constexpr (std::is_same_v, + std::string>) { + strAttr = mlir::StringAttr::get(value, context); + } else { + using ET = typename std::decay_t::value_type; + std::int64_t size = static_cast(value.size()); + auto shape = mlir::VectorType::get( + llvm::ArrayRef{size}, + mlir::IntegerType::get(sizeof(ET) * 8, builder.getContext())); + strAttr = mlir::DenseElementsAttr::get( + shape, llvm::ArrayRef{value.data(), value.size()}); + } auto valTag = mlir::Identifier::get(fir::StringLitOp::value(), context); mlir::NamedAttribute dataAttr(valTag, strAttr); auto sizeTag = mlir::Identifier::get(fir::StringLitOp::size(), context); @@ -1604,6 +1615,7 @@ fir::ExtendedValue Fortran::lower::createSomeExtendedAddress( fir::ExtendedValue Fortran::lower::createStringLiteral( mlir::Location loc, Fortran::lower::AbstractConverter &converter, llvm::StringRef str, uint64_t len) { + assert(str.size() == len); Fortran::lower::SymMap unused1; Fortran::lower::ExpressionContext unused2; return ExprLowering{loc, converter, unused1, unused2}.genStringLit(str, len); From 3f348cead103773247364dea81b8d58a7e37fbca Mon Sep 17 00:00:00 2001 From: rajan Date: Fri, 21 Aug 2020 13:25:30 -0400 Subject: [PATCH 0236/1017] improving debug information and adding slice to populate index in affine promotion (#409) --- .../Optimizer/Transforms/AffineDemotion.cpp | 4 ++ .../Optimizer/Transforms/AffinePromotion.cpp | 68 ++++++++++++------- flang/test/Fir/arr-end-end.f90 | 2 +- 3 files changed, 47 insertions(+), 27 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/AffineDemotion.cpp b/flang/lib/Optimizer/Transforms/AffineDemotion.cpp index ee0458503bd7d..34e9fb4ee9de3 100644 --- a/flang/lib/Optimizer/Transforms/AffineDemotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffineDemotion.cpp @@ -77,6 +77,10 @@ class ConvertConversion : public mlir::OpRewritePattern { matchAndRewrite(fir::ConvertOp op, mlir::PatternRewriter &rewriter) const override { if (op.res().getType().isa()) { + // due to index calculation moving to affine maps we still need to + // add converts for sequence types this has a side effect of losing + // some information about arrays with known dimensions by creating: + // fir.convert %arg0 : (!fir.ref>) -> !fir.ref> if (auto refTy = op.value().getType().dyn_cast()) if (auto arrTy = refTy.getEleTy().dyn_cast()) { fir::SequenceType::Shape flatShape = {fir::SequenceType::getUnknownExtent()}; diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index 40a44731609fc..21c02e37b3721 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -51,20 +51,20 @@ class AffineLoopAnalysis { return analyzeMemoryAccess(loopOperation) && analyzeBody(loopOperation, functionAnalysis); } - bool analyzeReference(mlir::Value); + bool analyzeReference(mlir::Value, mlir::Operation *); bool analyzeMemoryAccess(fir::DoLoopOp loopOperation) { for (auto loadOp : loopOperation.getOps()) - if (!analyzeReference(loadOp.memref())) + if (!analyzeReference(loadOp.memref(), loadOp)) return false; for (auto storeOp : loopOperation.getOps()) - if (!analyzeReference(storeOp.memref())) + if (!analyzeReference(storeOp.memref(), storeOp)) return false; return true; } }; /// Calculates arguments for creating an IntegerSet symCount, dimCount are the -/// final number of symbols and dimensions of the affine map. If integer set if +/// final number of symbols and dimensions of the affine map. Integer set if /// possible is in Optional IntegerSet class AffineIfCondition { public: @@ -213,37 +213,43 @@ class AffineFunctionAnalysis { llvm::DenseMap ifAnalysisMap; }; -bool analyzeCoordinate(mlir::Value coordinate) { +bool analyzeCoordinate(mlir::Value coordinate, mlir::Operation *op) { if (auto blockArg = coordinate.dyn_cast()) { if (isa(blockArg.getOwner()->getParentOp())) { return true; } else { - llvm::dbgs() << "AffineLoopAnalysis: array coordinate is not a " - "loop induction variable (owner not loopOp)\n"; + LLVM_DEBUG(llvm::dbgs() + << "AffineLoopAnalysis: array coordinate is not a " + "loop induction variable (owner not loopOp)\n"; + op->dump();); return false; } } else { - llvm::dbgs() << "AffineLoopAnalysis: array coordinate is not a loop " - "induction variable (not a block argument)\n"; + LLVM_DEBUG(llvm::dbgs() + << "AffineLoopAnalysis: array coordinate is not a loop " + "induction variable (not a block argument)\n"; + op->dump(); coordinate.getDefiningOp()->dump();); return false; } } -bool AffineLoopAnalysis::analyzeReference(mlir::Value memref) { +bool AffineLoopAnalysis::analyzeReference(mlir::Value memref, + mlir::Operation *op) { if (auto acoOp = memref.getDefiningOp()) { bool canPromote = true; for (auto coordinate : acoOp.indices()) - canPromote = canPromote && analyzeCoordinate(coordinate); + canPromote = canPromote && analyzeCoordinate(coordinate, op); return canPromote; } if (auto coOp = memref.getDefiningOp()) { LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: cannot promote loop, " - "array uses non ArrayCoorOp\n"; - coOp.dump();); + "array memory operation uses non ArrayCoorOp\n"; + op->dump(); coOp.dump();); return false; } LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: unknown type of memory " - "reference for array load\n";); + "reference for array load\n"; + op->dump();); return false; } @@ -311,38 +317,48 @@ mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) { void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeOp shape, SmallVectorImpl &indexArgs, mlir::PatternRewriter &rewriter) { - auto iter = shape.extents().begin(); auto one = rewriter.create( acoOp.getLoc(), rewriter.getIndexType(), rewriter.getIndexAttr(1)); - auto end = shape.extents().size(); - for (decltype(end) i = 0; i < end; ++i) { + auto extents = shape.extents(); + for (auto i = extents.begin(); i < extents.end(); i++) { indexArgs.push_back(one); - indexArgs.push_back(*iter++); + indexArgs.push_back(*i); indexArgs.push_back(one); } } + void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeShiftOp shape, SmallVectorImpl &indexArgs, mlir::PatternRewriter &rewriter) { - auto iter = shape.pairs().begin(); auto one = rewriter.create( acoOp.getLoc(), rewriter.getIndexType(), rewriter.getIndexAttr(1)); - auto end = shape.pairs().size(); - for (decltype(end) i = 0; i < end; ++(++i)) { - indexArgs.push_back(*iter++); - indexArgs.push_back(*iter++); + auto extents = shape.pairs(); + for (auto i = extents.begin(); i < extents.end();) { + indexArgs.push_back(*i++); + indexArgs.push_back(*i++); indexArgs.push_back(one); } } +void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::SliceOp slice, + SmallVectorImpl &indexArgs, + mlir::PatternRewriter &rewriter) { + auto extents = slice.triples(); + for (auto i = extents.begin(); i < extents.end();) { + indexArgs.push_back(*i++); + indexArgs.push_back(*i++); + indexArgs.push_back(*i++); + } +} + void populateIndexArgs(fir::ArrayCoorOp acoOp, SmallVectorImpl &indexArgs, mlir::PatternRewriter &rewriter) { - if (auto shape = acoOp.shape().getDefiningOp()) { + if (auto shape = acoOp.shape().getDefiningOp()) return populateIndexArgs(acoOp, shape, indexArgs, rewriter); - } if (auto shapeShift = acoOp.shape().getDefiningOp()) return populateIndexArgs(acoOp, shapeShift, indexArgs, rewriter); - llvm::dbgs() << "AffinePromotion: need to populateIndexArgs for slice\n"; + if (auto slice = acoOp.shape().getDefiningOp()) + return populateIndexArgs(acoOp, slice, indexArgs, rewriter); return; } diff --git a/flang/test/Fir/arr-end-end.f90 b/flang/test/Fir/arr-end-end.f90 index b7d20e616a4d3..54785e6c041a5 100644 --- a/flang/test/Fir/arr-end-end.f90 +++ b/flang/test/Fir/arr-end-end.f90 @@ -1,6 +1,6 @@ ! Test affine pipeline ! RUN: bbc --emit-fir --gen-array-coor=true %s -o - | tco --flang-memref-dataflow-opt --fir-loop-result-opt --canonicalize --loop-invariant-code-motion --promote-to-affine --affine-loop-invariant-code-motion --simplify-affine-structures --memref-dataflow-opt --cse --demote-affine --lower-affine | tco | llc | as -o %t -! RUN: cc %t %S/arr-driver.c +! RUN: %CC -std=c99 %t %S/arr-driver.c ! RUN: ./a.out | FileCheck %s ! CHECK: f1dc: success From 490a3be985431c1675faf0a204549aa685a80ea3 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Fri, 21 Aug 2020 15:45:56 -0400 Subject: [PATCH 0237/1017] [flang][openacc] Lower loop with collapse clause --- flang/lib/Lower/Bridge.cpp | 9 ++++- flang/test/Lower/OpenACC/acc-loop.f90 | 54 +++++++++++++++++++++++++++ flang/tools/bbc/bbc.cpp | 10 +++++ 3 files changed, 72 insertions(+), 1 deletion(-) create mode 100644 flang/test/Lower/OpenACC/acc-loop.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 95c52806d23bb..864e18a4fde3d 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -21,6 +21,7 @@ #include "flang/Lower/FIRBuilder.h" #include "flang/Lower/IO.h" #include "flang/Lower/Mangler.h" +#include "flang/Lower/OpenACC.h" #include "flang/Lower/OpenMP.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" @@ -1057,7 +1058,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::emitWarning(toLocation(), "ignoring all compiler directives"); } - void genFIR(const Fortran::parser::OpenACCConstruct &) { TODO(); } + void genFIR(const Fortran::parser::OpenACCConstruct &acc) { + auto insertPt = builder->saveInsertionPoint(); + genOpenACCConstruct(*this, getEval(), acc); + for (auto &e : getEval().getNestedEvaluations()) + genFIR(e); + builder->restoreInsertionPoint(insertPt); + } void genFIR(const Fortran::parser::OpenMPConstruct &omp) { genOpenMPConstruct(*this, getEval(), omp); diff --git a/flang/test/Lower/OpenACC/acc-loop.f90 b/flang/test/Lower/OpenACC/acc-loop.f90 new file mode 100644 index 0000000000000..9038454032967 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-loop.f90 @@ -0,0 +1,54 @@ +! This test checks lowering of OpenACC loop directive. + +! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s + +program acc_loop + + integer :: i, j + integer, parameter :: n = 10 + real, dimension(n) :: a, b + real, dimension(n, n) :: c, d + + + !$acc loop + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: } + + !$acc loop collapse(2) + DO i = 1, n + DO j = 1, n + c(i, j) = d(i, j) + END DO + END DO + +!CHECK: acc.loop { +!CHECK: fir.do_loop +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: } attributes {collapse = 2 : i64} + + !$acc loop + DO i = 1, n + !$acc loop + DO j = 1, n + c(i, j) = d(i, j) + END DO + END DO + +!CHECK: acc.loop { +!CHECK: fir.do_loop +!CHECK: acc.loop { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: } +!CHECK: acc.yield +!CHECK-NEXT: } + +end program + diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 6f4a569047212..bf8b7f9c859cc 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -116,6 +116,10 @@ static llvm::cl::opt enableOpenMP("fopenmp", llvm::cl::desc("enable openmp"), llvm::cl::init(false)); +static llvm::cl::opt enableOpenACC("fopenacc", + llvm::cl::desc("enable openacc"), + llvm::cl::init(false)); + static llvm::cl::opt dumpModuleOnFailure("dump-module-on-failure", llvm::cl::init(false)); @@ -153,6 +157,12 @@ static mlir::LogicalResult convertFortranSourceToMLIR( options.predefinitions.emplace_back("_OPENMP", "201511"); } + // enable parsing of OpenACC + if (enableOpenACC) { + options.features.Enable(Fortran::common::LanguageFeature::OpenACC); + options.predefinitions.emplace_back("_OPENACC", "201911"); + } + // prep for prescan and parse options.searchDirectories = includeDirs; Fortran::parser::Parsing parsing{semanticsContext.allSources()}; From fad951da0476bea8b4fab5bc86dc5b25cc5b4d4a Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 18 Aug 2020 14:38:09 -0700 Subject: [PATCH 0238/1017] Support for target specific lowering in the Tilikum bridge. To generate correct code for a chosen target, the Tilikum bridge must know what the selected target is and the conventions used for the specific target ABI. The properties of the target influence the calling conventions and LLVM IR that must be generated. Tilikum is the last point before any high-level abstractions must be considered and correctly translated to LLVM IR. These changed rework the Tilikum bridge to use a target specifier and convert the calling conventions and memory layouts appropriate for the selected target. Two target specifications are implemented. i386-unknown-linux-gnu and x86_64-unknown-linux-gnu. Others can be added as needed. Two high-level type abstractions are considered: COMPLEX and CHARACTER. Moving these target specific lowerings to a common place in code gen eliminates the need to perform heroics with custom code in lowering and/or reliance on assuming the target is known by implication at compiler compile-time. --- .../flang/Optimizer/CodeGen/CGPasses.td | 25 +- .../include/flang/Optimizer/CodeGen/CodeGen.h | 17 +- flang/lib/Lower/ConvertExpr.cpp | 17 +- flang/lib/Lower/RTBuilder.h | 4 +- flang/lib/Optimizer/CMakeLists.txt | 1 + flang/lib/Optimizer/CodeGen/CodeGen.cpp | 217 +++--- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 699 +++++++++++++++++- flang/lib/Optimizer/CodeGen/Target.cpp | 189 +++++ flang/lib/Optimizer/CodeGen/Target.h | 108 +++ flang/test/Fir/boxchar.fir | 5 +- flang/test/Fir/compare.fir | 11 +- flang/test/Fir/complex.fir | 10 +- flang/test/Fir/convert.fir | 4 +- flang/test/Fir/target.fir | 117 +++ flang/test/Lower/bbcnull.f90 | 4 + flang/test/Lower/dummy-procedure.f90 | 26 +- flang/test/Lower/intrinsics.f90 | 24 +- flang/test/Lower/procedure-declarations.f90 | 14 +- flang/test/Lower/stmt-function.f90 | 6 +- flang/tools/bbc/bbc.cpp | 20 +- flang/unittests/Lower/RTBuilder.cpp | 2 +- 21 files changed, 1331 insertions(+), 189 deletions(-) create mode 100644 flang/lib/Optimizer/CodeGen/Target.cpp create mode 100644 flang/lib/Optimizer/CodeGen/Target.h create mode 100644 flang/test/Fir/target.fir create mode 100644 flang/test/Lower/bbcnull.f90 diff --git a/flang/include/flang/Optimizer/CodeGen/CGPasses.td b/flang/include/flang/Optimizer/CodeGen/CGPasses.td index ffe829644d1aa..e10213242a36a 100644 --- a/flang/include/flang/Optimizer/CodeGen/CGPasses.td +++ b/flang/include/flang/Optimizer/CodeGen/CGPasses.td @@ -16,18 +16,29 @@ include "mlir/Pass/PassBase.td" -def CodeGenRewrite : Pass<"cg-rewrite"> { +def CodeGenRewrite : Pass<"cg-rewrite", "mlir::ModuleOp"> { let summary = "Rewrite some FIR ops into their code-gen forms."; let description = [{ Fuse specific subgraphs into single Ops for code generation. }]; let constructor = "fir::createFirCodeGenRewritePass()"; - let dependentDialects = [ - "fir::FIROpsDialect", "fir::FIRCodeGenDialect", "mlir::BuiltinDialect", - "mlir::LLVM::LLVMDialect", "mlir::omp::OpenMPDialect" - ]; - let statistics = [ - Statistic<"numDCE", "num-dce'd", "Number of operations eliminated"> + let dependentDialects = ["fir::FIROpsDialect"]; +} + +def TargetRewrite : Pass<"target-rewrite", "mlir::ModuleOp"> { + let summary = "Rewrite some FIR dialect into target specific forms. " + "Certain abstractions in the FIR dialect need to be rewritten " + "to reflect representations that may differ based on the " + "target machine."; + let constructor = "fir::createFirTargetRewritePass()"; + let dependentDialects = ["fir::FIROpsDialect"]; + let options = [ + Option<"noCharacterConversion", "no-character-conversion", + "bool", /*default=*/"false", + "Disable target-specific conversion of CHARACTER.">, + Option<"noComplexConversion", "no-complex-conversion", + "bool", /*default=*/"false", + "Disable target-specific conversion of COMPLEX."> ]; } diff --git a/flang/include/flang/Optimizer/CodeGen/CodeGen.h b/flang/include/flang/Optimizer/CodeGen/CodeGen.h index d863545882838..ecfa83ff0e2d8 100644 --- a/flang/include/flang/Optimizer/CodeGen/CodeGen.h +++ b/flang/include/flang/Optimizer/CodeGen/CodeGen.h @@ -6,8 +6,8 @@ // //===----------------------------------------------------------------------===// -#ifndef OPTIMIZER_CODEGEN_CODEGEN_H -#define OPTIMIZER_CODEGEN_CODEGEN_H +#ifndef FORTRAN_OPTIMIZER_CODEGEN_CODEGEN_H +#define FORTRAN_OPTIMIZER_CODEGEN_CODEGEN_H #include "mlir/IR/BuiltinOps.h" #include "mlir/Pass/Pass.h" @@ -22,6 +22,17 @@ struct NameUniquer; /// the code gen (to LLVM-IR dialect) conversion. std::unique_ptr createFirCodeGenRewritePass(); +/// FirTargetRewritePass options. +struct TargetRewriteOptions { + bool noCharacterConversion{}; + bool noComplexConversion{}; +}; + +/// Prerequiste pass for code gen. Perform intermediate rewrites to tailor the +/// IR for the chosen target. +std::unique_ptr> createFirTargetRewritePass( + const TargetRewriteOptions &options = TargetRewriteOptions()); + /// Convert FIR to the LLVM IR dialect std::unique_ptr createFIRToLLVMPass(); @@ -35,4 +46,4 @@ createLLVMDialectToLLVMPass(llvm::raw_ostream &output); } // namespace fir -#endif // OPTIMIZER_CODEGEN_CODEGEN_H +#endif // FORTRAN_OPTIMIZER_CODEGEN_CODEGEN_H diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 593c5f8fb3460..9c0de546492fe 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -32,6 +32,7 @@ #include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorHandling.h" #include "llvm/Support/raw_ostream.h" +#define DEBUG_TYPE "flang-lower-expr" #define TODO() llvm_unreachable("not yet implemented") @@ -362,7 +363,7 @@ class ExprLowering { Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr( builder, getLoc(), genericName, signature); mlir::Value funcPtr = - builder.create(getLoc(), signature, symbolRefAttr); + builder.create(getLoc(), signature, symbolRefAttr); return funcPtr; } const auto *symbol = proc.GetSymbol(); @@ -374,7 +375,7 @@ class ExprLowering { } auto name = converter.mangleName(*symbol); auto func = Fortran::lower::getOrDeclareFunction(name, proc, converter); - mlir::Value funcPtr = builder.create( + mlir::Value funcPtr = builder.create( getLoc(), func.getType(), builder.getSymbolRefAttr(name)); return funcPtr; } @@ -1350,6 +1351,7 @@ class ExprLowering { } } auto result = genval(details.stmtFunction().value()); + LLVM_DEBUG(llvm::errs() << "stmt-function: " << result << '\n'); // Remove dummy local arguments from the map. for (const auto *dummySymbol : details.dummyArgs()) symMap.erase(*dummySymbol); @@ -1469,7 +1471,7 @@ class ExprLowering { if (callSiteType.getNumResults() != funcOpType.getNumResults() || callSiteType.getNumInputs() != funcOpType.getNumInputs()) funcPointer = - builder.create(getLoc(), funcOpType, symbolAttr); + builder.create(getLoc(), funcOpType, symbolAttr); else funcSymbolAttr = symbolAttr; } @@ -1585,6 +1587,8 @@ mlir::Value Fortran::lower::createSomeExpression( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap) { Fortran::lower::ExpressionContext unused; + LLVM_DEBUG(llvm::errs() << "expr: "; expr.AsFortran(llvm::errs()); + llvm::errs() << '\n'); return ExprLowering{loc, converter, symMap, unused}.genValue(expr); } @@ -1593,6 +1597,8 @@ fir::ExtendedValue Fortran::lower::createSomeExtendedExpression( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap, const Fortran::lower::ExpressionContext &context) { + LLVM_DEBUG(llvm::errs() << "expr: "; expr.AsFortran(llvm::errs()); + llvm::errs() << '\n'); return ExprLowering{loc, converter, symMap, context}.genExtValue(expr); } @@ -1601,6 +1607,8 @@ mlir::Value Fortran::lower::createSomeAddress( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap) { Fortran::lower::ExpressionContext unused; + LLVM_DEBUG(llvm::errs() << "address: "; expr.AsFortran(llvm::errs()); + llvm::errs() << '\n'); return ExprLowering{loc, converter, symMap, unused}.genAddr(expr); } @@ -1609,6 +1617,8 @@ fir::ExtendedValue Fortran::lower::createSomeExtendedAddress( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap, const Fortran::lower::ExpressionContext &context) { + LLVM_DEBUG(llvm::errs() << "address: "; expr.AsFortran(llvm::errs()); + llvm::errs() << '\n'); return ExprLowering{loc, converter, symMap, context}.genExtAddr(expr); } @@ -1618,6 +1628,7 @@ fir::ExtendedValue Fortran::lower::createStringLiteral( assert(str.size() == len); Fortran::lower::SymMap unused1; Fortran::lower::ExpressionContext unused2; + LLVM_DEBUG(llvm::errs() << "string-lit: \"" << str << "\"\n"); return ExprLowering{loc, converter, unused1, unused2}.genStringLit(str, len); } diff --git a/flang/lib/Lower/RTBuilder.h b/flang/lib/Lower/RTBuilder.h index 32992f30dddbb..18482b0a53203 100644 --- a/flang/lib/Lower/RTBuilder.h +++ b/flang/lib/Lower/RTBuilder.h @@ -194,13 +194,13 @@ constexpr TypeBuilderFunc getModel() { template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { - return fir::CplxType::get(context, sizeof(float)); + return fir::ComplexType::get(context, sizeof(float)); }; } template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { - return fir::CplxType::get(context, sizeof(double)); + return fir::ComplexType::get(context, sizeof(double)); }; } template <> diff --git a/flang/lib/Optimizer/CMakeLists.txt b/flang/lib/Optimizer/CMakeLists.txt index 69f0496cfab67..e71a177c76abf 100644 --- a/flang/lib/Optimizer/CMakeLists.txt +++ b/flang/lib/Optimizer/CMakeLists.txt @@ -15,6 +15,7 @@ add_flang_library(FIROptimizer CodeGen/CodeGen.cpp CodeGen/PreCGRewrite.cpp + CodeGen/Target.cpp Transforms/ControlFlowConverter.cpp Transforms/CSE.cpp diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 4342bb545f69a..fb82365b907c9 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -12,11 +12,13 @@ #include "flang/Optimizer/CodeGen/CodeGen.h" #include "DescriptorModel.h" +#include "Target.h" #include "flang/Lower/Support/TypeCode.h" #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Optimizer/Support/KindMapping.h" #include "mlir/Conversion/StandardToLLVM/ConvertStandardToLLVM.h" @@ -36,14 +38,19 @@ #include "llvm/Support/CommandLine.h" #include "llvm/Support/FileSystem.h" #include "llvm/Support/raw_ostream.h" + #define DEBUG_TYPE "flang-codegen" +//===----------------------------------------------------------------------===// +/// \file +/// /// The Tilikum bridge performs the conversion of operations from both the FIR /// and standard dialects to the LLVM-IR dialect. /// /// Some FIR operations may be lowered to other dialects, such as standard, but /// some FIR operations will pass through to the Tilikum bridge. This may be /// necessary to preserve the semantics of the Fortran program. +//===----------------------------------------------------------------------===// #undef TODO #define TODO() llvm::report_fatal_error("tilikum: not yet implemented") @@ -84,30 +91,47 @@ namespace { /// This converts FIR types to LLVM types (for now) class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { public: - FIRToLLVMTypeConverter(mlir::MLIRContext *context, fir::NameUniquer &uniquer) - : LLVMTypeConverter(context), kindMapping(context), uniquer(uniquer) { + FIRToLLVMTypeConverter(mlir::ModuleOp module) + : LLVMTypeConverter(module.getContext()), + kindMapping(*fir::getKindMapping(module)), + uniquer(*fir::getNameUniquer(module)), + specifics(fir::CodeGenSpecifics::get(module.getContext(), + *fir::getTargetTriple(module), + *fir::getKindMapping(module))) { + LLVM_DEBUG(llvm::errs() << "FIR type converter\n"); + + // Each conversion should return a value of type mlir::LLVM::LLVMType. addConversion([&](fir::BoxType box) { return convertBoxType(box); }); - addConversion( - [&](fir::BoxCharType boxchar) { return convertBoxCharType(boxchar); }); + addConversion([&](fir::BoxCharType boxchar) { + LLVM_DEBUG(llvm::errs() << "type convert: " << boxchar << '\n'); + return unwrap( + convertType(specifics->boxcharMemoryType(boxchar.getEleTy()))); + }); addConversion( [&](fir::BoxProcType boxproc) { return convertBoxProcType(boxproc); }); addConversion( [&](fir::CharacterType charTy) { return convertCharType(charTy); }); - addConversion([&](fir::CplxType cplx) { - return convertComplexType(cplx.getFKind()); - }); + addConversion( + [&](mlir::ComplexType cmplx) { return convertComplexType(cmplx); }); + addConversion( + [&](fir::ComplexType cmplx) { return convertComplexType(cmplx); }); addConversion( [&](fir::RecordType derived) { return convertRecordType(derived); }); addConversion([&](fir::FieldType field) { return mlir::LLVM::LLVMType::getInt32Ty(field.getContext()); }); addConversion([&](fir::HeapType heap) { return convertPointerLike(heap); }); - addConversion([&](fir::IntType intr) { return convertIntegerType(intr); }); + addConversion([&](fir::IntegerType intTy) { + return mlir::LLVM::LLVMType::getIntNTy( + &getContext(), kindMapping.getIntegerBitsize(intTy.getFKind())); + }); addConversion([&](fir::LenType field) { return mlir::LLVM::LLVMType::getInt32Ty(field.getContext()); }); - addConversion( - [&](fir::LogicalType logical) { return convertLogicalType(logical); }); + addConversion([&](fir::LogicalType boolTy) { + return mlir::LLVM::LLVMType::getIntNTy( + &getContext(), kindMapping.getLogicalBitsize(boolTy.getFKind())); + }); addConversion( [&](fir::PointerType pointer) { return convertPointerLike(pointer); }); addConversion( @@ -120,10 +144,19 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { addConversion([&](fir::TypeDescType tdesc) { return convertTypeDescType(tdesc.getContext()); }); - addConversion( - [&](mlir::TupleType tuple) { return convertTupleType(tuple); }); - addConversion( - [&](mlir::ComplexType cmplx) { return convertComplexType(cmplx); }); + addConversion([&](fir::VectorType vecTy) { + return mlir::LLVM::LLVMType::getVectorTy( + unwrap(convertType(vecTy.getEleTy())), vecTy.getLen()); + }); + addConversion([&](mlir::TupleType tuple) { + LLVM_DEBUG(llvm::errs() << "type convert: " << tuple << '\n'); + SmallVector inMembers; + tuple.getFlattenedTypes(inMembers); + SmallVector members; + for (auto mem : inMembers) + members.push_back(convertType(mem).cast()); + return mlir::LLVM::LLVMType::getStructTy(&getContext(), members); + }); addConversion([&](mlir::NoneType none) { return mlir::LLVM::LLVMStructType::getLiteral(none.getContext(), llvm::None); @@ -154,13 +187,6 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { }); } - // This returns the type of a single column. Rows are added by the caller. - // fir.dims --> llvm<"[r x [3 x i64]]"> - mlir::LLVM::LLVMType dimsType() { - auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(&getContext()); - return mlir::LLVM::LLVMType::getArrayTy(i64Ty, 3); - } - // i32 is used here because LLVM wants i32 constants when indexing into struct // types. Indexing into other aggregate types is more flexible. mlir::LLVM::LLVMType offsetType() { @@ -209,14 +235,6 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { .getPointerTo(); } - // fir.boxchar --> llvm<"{ ix*, i64 }"> where ix is kind mapping - mlir::LLVM::LLVMType convertBoxCharType(fir::BoxCharType boxchar) { - auto ptrTy = convertCharType(boxchar.getEleTy()).getPointerTo(); - auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(&getContext()); - SmallVector tuple{ptrTy, i64Ty}; - return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); - } - // fir.boxproc --> llvm<"{ any*, i8* }"> mlir::LLVM::LLVMType convertBoxProcType(fir::BoxProcType boxproc) { auto funcTy = convertType(boxproc.getEleTy()); @@ -236,16 +254,22 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { characterBitsize(charTy)); } + // Convert a complex value's element type based on its Fortran kind. mlir::LLVM::LLVMType convertComplexPartType(fir::KindTy kind) { auto realID = kindMapping.getComplexTypeID(kind); return fromRealTypeID(realID, kind); } - // fir.complex --> llvm<"{ anyfloat, anyfloat }"> - mlir::LLVM::LLVMType convertComplexType(fir::KindTy kind) { - auto realTy = convertComplexPartType(kind); - SmallVector tuple{realTy, realTy}; - return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); + // Use the target specifics to figure out how to map complex to LLVM IR. The + // use of complex values in function signatures is handled before conversion + // to LLVM IR dialect here. + // + // fir.complex | std.complex --> llvm<"{t,t}"> + template + mlir::LLVM::LLVMType convertComplexType(C cmplx) { + LLVM_DEBUG(llvm::errs() << "type convert: " << cmplx << '\n'); + auto eleTy = cmplx.getElementType(); + return unwrap(convertType(specifics->complexMemoryType(eleTy))); } mlir::LLVM::LLVMType getDefaultInt() { @@ -253,18 +277,6 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { return mlir::LLVM::LLVMType::getInt64Ty(&getContext()); } - // fir.int --> llvm.ix where ix is a kind mapping - mlir::LLVM::LLVMType convertIntegerType(fir::IntType intTy) { - return mlir::LLVM::LLVMType::getIntNTy( - &getContext(), kindMapping.getIntegerBitsize(intTy.getFKind())); - } - - // fir.logical --> llvm.ix where ix is a kind mapping - mlir::LLVM::LLVMType convertLogicalType(fir::LogicalType boolTy) { - return mlir::LLVM::LLVMType::getIntNTy( - &getContext(), kindMapping.getLogicalBitsize(boolTy.getFKind())); - } - template mlir::LLVM::LLVMType convertPointerLike(A &ty) { mlir::Type eleTy = ty.getEleTy(); @@ -323,23 +335,6 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { return baseTy.getPointerTo(); } - // tuple --> llvm<"{ ts... }"> - mlir::LLVM::LLVMType convertTupleType(mlir::TupleType tuple) { - SmallVector inMembers; - tuple.getFlattenedTypes(inMembers); - SmallVector members; - for (auto mem : inMembers) - members.push_back(convertType(mem).cast()); - return mlir::LLVM::LLVMType::getStructTy(&getContext(), members); - } - - // complex --> llvm<"{t,t}"> - mlir::LLVM::LLVMType convertComplexType(mlir::ComplexType complex) { - auto eleTy = unwrap(convertType(complex.getElementType())); - SmallVector tuple{eleTy, eleTy}; - return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); - } - // fir.tdesc --> llvm<"i8*"> // FIXME: for now use a void*, however pointer identity is not sufficient for // the f18 object v. class distinction @@ -423,6 +418,7 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { private: fir::KindMapping kindMapping; fir::NameUniquer &uniquer; + std::unique_ptr specifics; static StringMap identStructCache; }; @@ -486,7 +482,7 @@ class FIROpConversion : public mlir::OpConversionPattern { mlir::ConversionPatternRewriter &rewriter) const { auto c0 = genConstantOffset(loc, rewriter, 0); auto c3 = genConstantOffset(loc, rewriter, 3); - llvm::SmallVector args = {box, c0, c3}; + SmallVector args = {box, c0, c3}; auto pty = unwrap(resultTy).getPointerTo(); auto p = rewriter.create(loc, pty, args); return rewriter.create(loc, resultTy, p); @@ -494,8 +490,8 @@ class FIROpConversion : public mlir::OpConversionPattern { /// Method to construct code sequence to get the triple for dimension `dim` /// from a box. - llvm::SmallVector - getDimsFromBox(mlir::Location loc, llvm::ArrayRef retTys, + SmallVector + getDimsFromBox(mlir::Location loc, ArrayRef retTys, mlir::Value box, mlir::Value dim, mlir::ConversionPatternRewriter &rewriter) const { auto c0 = genConstantOffset(loc, rewriter, 0); @@ -738,7 +734,7 @@ struct BoxDimsOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::BoxDimsOp boxdims, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - llvm::SmallVector resultTypes = { + SmallVector resultTypes = { convertType(boxdims.getResult(0).getType()), convertType(boxdims.getResult(1).getType()), convertType(boxdims.getResult(2).getType()), @@ -903,7 +899,7 @@ struct StringLitOpConversion : public FIROpConversion { auto charTy = rewriter.getIntegerType(bits); auto det = mlir::VectorType::get({size}, charTy); // convert each character to a precise bitsize - llvm::SmallVector vec; + SmallVector vec; for (auto a : arr.getValue()) vec.push_back(mlir::IntegerAttr::get( charTy, a.cast().getValue().sextOrTrunc(bits))); @@ -942,7 +938,7 @@ struct CmpcOpConversion : public FIROpConversion { matchAndRewrite(fir::CmpcOp cmp, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { auto ctxt = cmp.getContext(); - auto kind = cmp.lhs().getType().cast().getFKind(); + auto kind = cmp.lhs().getType().cast().getFKind(); auto ty = convertType(fir::RealType::get(ctxt, kind)); auto loc = cmp.getLoc(); auto pos0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctxt); @@ -995,7 +991,7 @@ struct ConstcOpConversion : public FIROpConversion { auto loc = conc.getLoc(); auto ctx = conc.getContext(); auto ty = convertType(conc.getType()); - auto ct = conc.getType().cast(); + auto ct = conc.getType().cast(); auto ety = lowerTy().convertComplexPartType(ct.getFKind()); auto ri = mlir::FloatAttr::get(ety, getValue(conc.getReal())); auto rp = rewriter.create(loc, ety, ri); @@ -1010,7 +1006,7 @@ struct ConstcOpConversion : public FIROpConversion { return success(); } - inline llvm::APFloat getValue(mlir::Attribute attr) const { + inline APFloat getValue(mlir::Attribute attr) const { return attr.cast().getValue(); } }; @@ -1143,7 +1139,7 @@ struct ConvertOpConversion : public FIROpConversion { static mlir::Type getComplexEleTy(mlir::Type complex) { if (auto cc = complex.dyn_cast()) return cc.getElementType(); - return complex.cast().getElementType(); + return complex.cast().getElementType(); } }; @@ -1188,23 +1184,42 @@ struct DTEntryOpConversion : public FIROpConversion { } }; +/// Perform an extension or truncation as needed on an integer value. Lowering +/// to the specific target may involve some sign-extending or truncation of +/// values, particularly to fit them from abstract box types to the appropriate +/// reified structures. +static mlir::Value integerCast(mlir::Location loc, + mlir::ConversionPatternRewriter &rewriter, + mlir::LLVM::LLVMType ty, mlir::Value val) { + auto toSize = ty.getPrimitiveSizeInBits(); + auto fromSize = + val.getType().cast().getPrimitiveSizeInBits(); + if (toSize < fromSize) + return rewriter.create(loc, ty, val); + if (toSize > fromSize) + return rewriter.create(loc, ty, val); + return val; +} + /// create a CHARACTER box struct EmboxCharOpConversion : public FIROpConversion { using FIROpConversion::FIROpConversion; mlir::LogicalResult - matchAndRewrite(fir::EmboxCharOp emboxchar, OperandTy operands, + matchAndRewrite(fir::EmboxCharOp emboxChar, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { auto a = operands[0]; - auto b = operands[1]; - auto loc = emboxchar.getLoc(); - auto ctx = emboxchar.getContext(); - auto ty = convertType(emboxchar.getType()); + auto b1 = operands[1]; + auto loc = emboxChar.getLoc(); + auto ctx = emboxChar.getContext(); + auto ty = convertType(emboxChar.getType()); auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); auto un = rewriter.create(loc, ty); + auto lenTy = unwrap(ty).cast().getBody()[1]; + auto b = integerCast(loc, rewriter, lenTy, b1); auto r = rewriter.create(loc, ty, un, a, c0); - rewriter.replaceOpWithNewOp(emboxchar, ty, r, b, + rewriter.replaceOpWithNewOp(emboxChar, ty, r, b, c1); return success(); } @@ -1244,20 +1259,6 @@ struct EmboxCommonConversion : public FIROpConversion { return boxPtrTy.getPointerElementTy().getStructElementType(i); } - // Perform an extension or truncation as needed on an integer value - mlir::Value integerCast(mlir::Location loc, - mlir::ConversionPatternRewriter &rewriter, - mlir::LLVM::LLVMType ty, mlir::Value val) const { - auto toSize = ty.getPrimitiveSizeInBits(); - auto fromSize = - val.getType().cast().getPrimitiveSizeInBits(); - if (toSize < fromSize) - return rewriter.create(loc, ty, val); - if (toSize > fromSize) - return rewriter.create(loc, ty, val); - return val; - } - // Get the element size and CFI type code of the boxed value. std::tuple getSizeAndTypeCode(mlir::Location loc, @@ -1296,7 +1297,7 @@ struct EmboxCommonConversion : public FIROpConversion { if (fir::isa_integer(boxEleTy)) { if (auto ty = boxEleTy.dyn_cast()) return doInteger(ty.getWidth()); - auto ty = boxEleTy.cast(); + auto ty = boxEleTy.cast(); return doInteger(getKindMap().getIntegerBitsize(ty.getFKind())); } if (fir::isa_real(boxEleTy)) { @@ -1309,7 +1310,7 @@ struct EmboxCommonConversion : public FIROpConversion { if (auto ty = boxEleTy.dyn_cast()) return doComplex( ty.getElementType().cast().getWidth()); - auto ty = boxEleTy.cast(); + auto ty = boxEleTy.cast(); return doComplex(getKindMap().getRealBitsize(ty.getFKind())); } if (auto ty = boxEleTy.dyn_cast()) @@ -1546,7 +1547,7 @@ struct ValueOpCommon { // Translate the arguments pertaining to any multidimensional array to // row-major order for LLVM-IR. - static void toRowMajor(llvm::SmallVectorImpl &attrs, + static void toRowMajor(SmallVectorImpl &attrs, mlir::LLVM::LLVMType ty) { assert(ty && "type is null"); const auto end = attrs.size(); @@ -1699,7 +1700,7 @@ struct XArrayCoorOpConversion prevExt = rewriter.create(loc, idxTy, prevExt, nextExt); } - llvm::SmallVector args{base, off}; + SmallVector args{base, off}; rewriter.replaceOpWithNewOp(coor, ty, args); return success(); } @@ -2027,7 +2028,7 @@ struct FieldIndexOpConversion : public FIROpConversion { auto type = field.on_type().cast(); // note: using std::string to dodge a bug in g++ 7.4.0 std::string tyName = type.getName().str(); - llvm::Twine methodName = "_QQOFFSETOF_" + tyName + "_" + fldName; + Twine methodName = "_QQOFFSETOF_" + tyName + "_" + fldName; return methodName.str(); } }; @@ -2147,8 +2148,7 @@ struct GlobalOpConversion : public FIROpConversion { return success(); } - mlir::LLVM::Linkage - convertLinkage(llvm::Optional optLinkage) const { + mlir::LLVM::Linkage convertLinkage(Optional optLinkage) const { if (optLinkage.hasValue()) { auto name = optLinkage.getValue(); if (name == "internal") @@ -2193,7 +2193,7 @@ struct NoReassocOpConversion : public FIROpConversion { }; void genCondBrOp(mlir::Location loc, mlir::Value cmp, mlir::Block *dest, - llvm::Optional destOps, + Optional destOps, mlir::ConversionPatternRewriter &rewriter, mlir::Block *newBlock) { if (destOps.hasValue()) @@ -2214,7 +2214,7 @@ void genBrOp(A caseOp, mlir::Block *dest, llvm::Optional destOps, } void genCaseLadderStep(mlir::Location loc, mlir::Value cmp, mlir::Block *dest, - llvm::Optional destOps, + Optional destOps, mlir::ConversionPatternRewriter &rewriter) { auto *thisBlock = rewriter.getInsertionBlock(); auto *newBlock = createBlock(rewriter, dest); @@ -2387,15 +2387,15 @@ struct UnboxCharOpConversion : public FIROpConversion { matchAndRewrite(fir::UnboxCharOp unboxchar, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { auto *ctx = unboxchar.getContext(); + auto lenTy = unwrap(convertType(unboxchar.getType(1))); auto loc = unboxchar.getLoc(); auto tuple = operands[0]; auto ty = unwrap(tuple.getType()); mlir::Value ptr = genExtractValueWithIndex(loc, tuple, ty, rewriter, ctx, 0); - mlir::Value len = - genExtractValueWithIndex(loc, tuple, ty, rewriter, ctx, 1); - std::vector repls = {ptr, len}; - unboxchar.replaceAllUsesWith(repls); + auto len1 = genExtractValueWithIndex(loc, tuple, ty, rewriter, ctx, 1); + auto len = integerCast(loc, rewriter, lenTy, len1); + unboxchar.replaceAllUsesWith(llvm::ArrayRef{ptr, len}); rewriter.eraseOp(unboxchar); return success(); } @@ -2735,7 +2735,7 @@ struct NegcOpConversion : public FIROpConversion { struct FIRToLLVMLoweringPass : public mlir::PassWrapper> { - FIRToLLVMLoweringPass(fir::NameUniquer &uniquer) : uniquer{uniquer} {} + FIRToLLVMLoweringPass(fir::NameUniquer &) {} mlir::ModuleOp getModule() { return getOperation(); } @@ -2744,7 +2744,7 @@ struct FIRToLLVMLoweringPass return; auto *context = getModule().getContext(); - FIRToLLVMTypeConverter typeConverter{context, uniquer}; + FIRToLLVMTypeConverter typeConverter{getModule()}; auto loc = mlir::UnknownLoc::get(context); mlir::OwningRewritePatternList pattern; pattern.insert< @@ -2784,9 +2784,6 @@ struct FIRToLLVMLoweringPass signalPassFailure(); } } - -private: - fir::NameUniquer &uniquer; }; /// Lower from LLVM IR dialect to proper LLVM-IR and dump the module diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index 9d3f4a1198f66..c0836d7f28659 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -11,20 +11,29 @@ //===----------------------------------------------------------------------===// #include "PassDetail.h" +#include "Target.h" #include "flang/Optimizer/CodeGen/CodeGen.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Transforms/Passes.h" #include "mlir/Pass/Pass.h" #include "mlir/Transforms/DialectConversion.h" +#include "llvm/ADT/STLExtras.h" +#include "llvm/ADT/TypeSwitch.h" #include "llvm/Support/CommandLine.h" #include "llvm/Support/Debug.h" +#include -#define DEBUG_TYPE "flang-codegen-rewrite" +//===----------------------------------------------------------------------===// +// Codegen rewrite: rewriting of subgraphs of ops +//===----------------------------------------------------------------------===// using namespace fir; +#define DEBUG_TYPE "flang-codegen-rewrite" + static void populateShape(llvm::SmallVectorImpl &vec, ShapeOp shape) { vec.append(shape.extents().begin(), shape.extents().end()); @@ -56,7 +65,7 @@ class EmboxConversion : public mlir::OpRewritePattern { if (shapeVal) return rewriteDynamicShape(embox, rewriter, shapeVal); if (auto boxTy = embox.getType().dyn_cast()) - if (auto seqTy = boxTy.getEleTy().dyn_cast()) + if (auto seqTy = boxTy.getEleTy().dyn_cast()) if (seqTy.hasConstantShape()) return rewriteStaticShape(embox, rewriter, seqTy); return mlir::failure(); @@ -64,7 +73,7 @@ class EmboxConversion : public mlir::OpRewritePattern { mlir::LogicalResult rewriteStaticShape(EmboxOp embox, mlir::PatternRewriter &rewriter, - fir::SequenceType seqTy) const { + SequenceType seqTy) const { auto loc = embox.getLoc(); llvm::SmallVector shapeOpers; auto idxTy = rewriter.getIndexType(); @@ -204,9 +213,8 @@ class CodeGenRewrite : public CodeGenRewriteBase { target.addLegalDialect(); target.addIllegalOp(); target.addDynamicallyLegalOp([](EmboxOp embox) { - return !( - embox.getShape() || - embox.getType().cast().getEleTy().isa()); + return !(embox.getShape() || + embox.getType().cast().getEleTy().isa()); }); // Do the conversions. @@ -274,9 +282,682 @@ class CodeGenRewrite : public CodeGenRewriteBase { } // namespace -/// Convert FIR's structured control flow ops to CFG ops. This -/// conversion enables the `createLowerToCFGPass` to transform these to CFG -/// form. +/// Convert FIR's structured control flow ops to CFG ops. This conversion +/// enables the `createLowerToCFGPass` to transform these to CFG form. std::unique_ptr fir::createFirCodeGenRewritePass() { return std::make_unique(); } + +//===----------------------------------------------------------------------===// +// Target rewrite: reriting of ops to make target-specific lowerings manifest. +//===----------------------------------------------------------------------===// + +#undef DEBUG_TYPE +#define DEBUG_TYPE "flang-target-rewrite" + +namespace { + +/// Fixups for updating a FuncOp's arguments and return values. +struct FixupTy { + // clang-format off + enum class Codes { + ArgumentAsLoad, ArgumentType, CharPair, ReturnAsStore, ReturnType, + Split, Trailing + }; + // clang-format on + + FixupTy(Codes code, std::size_t index, std::size_t second = 0) + : code{code}, index{index}, second{second} {} + FixupTy(Codes code, std::size_t index, + std::function &&finalizer) + : code{code}, index{index}, finalizer{finalizer} {} + FixupTy(Codes code, std::size_t index, std::size_t second, + std::function &&finalizer) + : code{code}, index{index}, second{second}, finalizer{finalizer} {} + + Codes code; + std::size_t index; + std::size_t second{}; + llvm::Optional> finalizer{}; +}; // namespace + +/// Target-specific rewriting of the IR. This is a prerequisite pass to code +/// generation that traverses the IR and modifies types and operations to a +/// form that appropriate for the specific target. LLVM IR has specific idioms +/// that are used for distinct target processor and ABI combinations. +class TargetRewrite : public TargetRewriteBase { +public: + TargetRewrite(const TargetRewriteOptions &options) { + noCharacterConversion = options.noCharacterConversion; + noComplexConversion = options.noComplexConversion; + } + + void runOnOperation() override final { + auto &context = getContext(); + mlir::OpBuilder rewriter(&context); + auto mod = getModule(); + auto specifics = CodeGenSpecifics::get(getOperation().getContext(), + *getTargetTriple(getOperation()), + *getKindMapping(getOperation())); + setMembers(specifics.get(), &rewriter); + + // Perform type conversion on signatures and call sites. + if (mlir::failed(convertTypes(mod))) { + mlir::emitError(mlir::UnknownLoc::get(&context), + "error in converting types to target abi"); + signalPassFailure(); + } + + // Convert ops in target-specific patterns. + mod.walk([&](mlir::Operation *op) { + if (auto call = dyn_cast(op)) { + if (!hasPortableSignature(call.getFunctionType())) + convertCallOp(call); + } else if (auto dispatch = dyn_cast(op)) { + if (!hasPortableSignature(dispatch.getFunctionType())) + convertCallOp(dispatch); + } else if (auto addr = dyn_cast(op)) { + if (addr.getType().isa() && + !hasPortableSignature(addr.getType())) + convertAddrOp(addr); + } + }); + + clearMembers(); + } + + mlir::ModuleOp getModule() { return getOperation(); } + + template + std::function + rewriteCallComplexResultType(A ty, B &newResTys, B &newInTys, C &newOpers) { + auto m = specifics->complexReturnType(ty.getElementType()); + // Currently targets mandate COMPLEX is a single aggregate or packed + // scalar, included the sret case. + assert(m.size() == 1 && "target lowering of complex return not supported"); + auto resTy = std::get(m[0]); + auto attr = std::get(m[0]); + auto loc = mlir::UnknownLoc::get(resTy.getContext()); + if (attr.isSRet()) { + assert(isa_ref_type(resTy)); + mlir::Value stack = + rewriter->create(loc, dyn_cast_ptrEleTy(resTy)); + newInTys.push_back(resTy); + newOpers.push_back(stack); + return [=](mlir::Operation *) -> mlir::Value { + auto memTy = ReferenceType::get(ty); + auto cast = rewriter->create(loc, memTy, stack); + return rewriter->create(loc, cast); + }; + } + newResTys.push_back(resTy); + return [=](mlir::Operation *call) -> mlir::Value { + auto mem = rewriter->create(loc, resTy); + rewriter->create(loc, call->getResult(0), mem); + auto memTy = ReferenceType::get(ty); + auto cast = rewriter->create(loc, memTy, mem); + return rewriter->create(loc, cast); + }; + } + + template + void rewriteCallComplexInputType(A ty, mlir::Value oper, B &newInTys, + C &newOpers) { + auto m = specifics->complexArgumentType(ty.getElementType()); + auto *ctx = ty.getContext(); + auto loc = mlir::UnknownLoc::get(ctx); + if (m.size() == 1) { + // COMPLEX is a single aggregate + auto resTy = std::get(m[0]); + auto attr = std::get(m[0]); + auto oldRefTy = ReferenceType::get(ty); + if (attr.isByVal()) { + auto mem = rewriter->create(loc, ty); + rewriter->create(loc, oper, mem); + newOpers.push_back(rewriter->create(loc, resTy, mem)); + } else { + auto mem = rewriter->create(loc, resTy); + auto cast = rewriter->create(loc, oldRefTy, mem); + rewriter->create(loc, oper, cast); + newOpers.push_back(rewriter->create(loc, mem)); + } + newInTys.push_back(resTy); + } else { + assert(m.size() == 2); + // COMPLEX is split into 2 separate arguments + auto iTy = rewriter->getIntegerType(32); + for (auto e : llvm::enumerate(m)) { + auto &tup = e.value(); + auto ty = std::get(tup); + auto index = e.index(); + mlir::Value idx = rewriter->create( + loc, iTy, mlir::IntegerAttr::get(iTy, index)); + auto val = rewriter->create(loc, ty, oper, idx); + newInTys.push_back(ty); + newOpers.push_back(val); + } + } + } + + // Convert fir.call and fir.dispatch Ops. + template + void convertCallOp(A callOp) { + auto fnTy = callOp.getFunctionType(); + auto loc = callOp.getLoc(); + rewriter->setInsertionPoint(callOp); + llvm::SmallVector newResTys; + llvm::SmallVector newInTys; + llvm::SmallVector newOpers; + // FIXME: if the call is indirect, the first argument must still be the + // function to call. + llvm::Optional> wrap; + if (fnTy.getResults().size() == 1) { + mlir::Type ty = fnTy.getResult(0); + llvm::TypeSwitch(ty) + .template Case([&](fir::ComplexType cmplx) { + wrap = rewriteCallComplexResultType(cmplx, newResTys, newInTys, + newOpers); + }) + .template Case([&](mlir::ComplexType cmplx) { + wrap = rewriteCallComplexResultType(cmplx, newResTys, newInTys, + newOpers); + }) + .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); + } else if (fnTy.getResults().size() > 1) { + // If the function is returning more than 1 result, do not perform any + // target-specific lowering. (FIXME?) This may need to be revisited. + newResTys.insert(newResTys.end(), fnTy.getResults().begin(), + fnTy.getResults().end()); + } + llvm::SmallVector trailingInTys; + llvm::SmallVector trailingOpers; + for (auto e : + llvm::enumerate(llvm::zip(fnTy.getInputs(), callOp.getOperands()))) { + mlir::Type ty = std::get<0>(e.value()); + mlir::Value oper = std::get<1>(e.value()); + unsigned index = e.index(); + llvm::TypeSwitch(ty) + .template Case([&](BoxCharType boxTy) { + bool sret; + if constexpr (std::is_same_v, fir::CallOp>) { + sret = callOp.callee() && + functionArgIsSRet(index, + getModule().lookupSymbol( + *callOp.callee())); + } else { + // TODO: dispatch case; how do we put arguments on a call? + sret = false; + llvm_unreachable("not implemented"); + } + auto m = specifics->boxcharArgumentType(boxTy.getEleTy(), sret); + auto unbox = + rewriter->create(loc, std::get(m[0]), + std::get(m[1]), oper); + // unboxed CHARACTER arguments + for (auto e : llvm::enumerate(m)) { + unsigned idx = e.index(); + auto attr = std::get(e.value()); + auto argTy = std::get(e.value()); + if (attr.isAppend()) { + trailingInTys.push_back(argTy); + trailingOpers.push_back(unbox.getResult(idx)); + } else { + newInTys.push_back(argTy); + newOpers.push_back(unbox.getResult(idx)); + } + } + }) + .template Case([&](fir::ComplexType cmplx) { + rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); + }) + .template Case([&](mlir::ComplexType cmplx) { + rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); + }) + .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); + } + newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); + newOpers.insert(newOpers.end(), trailingOpers.begin(), trailingOpers.end()); + if constexpr (std::is_same_v, fir::CallOp>) { + assert(callOp.callee().hasValue() && "indirect call not implemented"); + auto newCall = rewriter->create(loc, callOp.callee().getValue(), + newResTys, newOpers); + LLVM_DEBUG(llvm::errs() << "replacing call with " << newCall << '\n'); + if (wrap.hasValue()) + replaceOp(callOp, (*wrap)(newCall.getOperation())); + else + replaceOp(callOp, newCall.getResults()); + } else { + // A is fir::DispatchOp + llvm_unreachable("not implemented"); // TODO + } + } + + // Result type fixup for fir::ComplexType and mlir::ComplexType + template + void lowerComplexSignatureRes(A cmplx, B &newResTys, B &newInTys) { + if (noComplexConversion) { + newResTys.push_back(cmplx); + } else { + for (auto &tup : specifics->complexReturnType(cmplx.getElementType())) { + auto argTy = std::get(tup); + if (std::get(tup).isSRet()) + newInTys.push_back(argTy); + else + newResTys.push_back(argTy); + } + } + } + + // Argument type fixup for fir::ComplexType and mlir::ComplexType + template + void lowerComplexSignatureArg(A cmplx, B &newInTys) { + if (noComplexConversion) + newInTys.push_back(cmplx); + else + for (auto &tup : specifics->complexArgumentType(cmplx.getElementType())) + newInTys.push_back(std::get(tup)); + } + + /// Taking the address of a function. Modify the signature as needed. + void convertAddrOp(AddrOfOp addrOp) { + auto addrTy = addrOp.getType().cast(); + llvm::SmallVector newResTys; + llvm::SmallVector newInTys; + for (mlir::Type ty : addrTy.getResults()) { + llvm::TypeSwitch(ty) + .Case([&](fir::ComplexType ty) { + lowerComplexSignatureRes(ty, newResTys, newInTys); + }) + .Case([&](mlir::ComplexType ty) { + lowerComplexSignatureRes(ty, newResTys, newInTys); + }) + .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); + } + llvm::SmallVector trailingInTys; + for (mlir::Type ty : addrTy.getInputs()) { + llvm::TypeSwitch(ty) + .Case([&](BoxCharType box) { + if (noCharacterConversion) { + newInTys.push_back(box); + } else { + for (auto &tup : specifics->boxcharArgumentType(box.getEleTy())) { + auto attr = std::get(tup); + auto argTy = std::get(tup); + auto &vec = attr.isAppend() ? trailingInTys : newInTys; + vec.push_back(argTy); + } + } + }) + .Case( + [&](fir::ComplexType ty) { lowerComplexSignatureArg(ty, newInTys); }) + .Case([&](mlir::ComplexType ty) { + lowerComplexSignatureArg(ty, newInTys); + }) + .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); + } + // append trailing input types + newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); + // replace this op with a new one with the updated signature + auto newTy = rewriter->getFunctionType(newInTys, newResTys); + auto newOp = + rewriter->create(addrOp.getLoc(), newTy, addrOp.symbol()); + replaceOp(addrOp, newOp.getOperation()->getResults()); + } + + /// Convert the type signatures on all the functions present in the module. + /// As the type signature is being changed, this must also update the + /// function itself to use any new arguments, etc. + mlir::LogicalResult convertTypes(mlir::ModuleOp mod) { + for (auto fn : mod.getOps()) + convertSignature(fn); + return mlir::success(); + } + + /// If the signature does not need any special target-specific converions, + /// then it is considered portable for any target, and this function will + /// return `true`. Otherwise, the signature is not portable and `false` is + /// returned. + bool hasPortableSignature(mlir::Type signature) { + assert(signature.isa()); + auto func = signature.dyn_cast(); + for (auto ty : func.getResults()) + if ((ty.isa() && !noCharacterConversion) || + (isa_complex(ty) && !noComplexConversion)) { + LLVM_DEBUG(llvm::errs() << "rewrite " << signature << " for target\n"); + return false; + } + for (auto ty : func.getInputs()) + if ((ty.isa() && !noCharacterConversion) || + (isa_complex(ty) && !noComplexConversion)) { + LLVM_DEBUG(llvm::errs() << "rewrite " << signature << " for target\n"); + return false; + } + return true; + } + + /// Rewrite the signatures and body of the `FuncOp`s in the module for + /// the immediately subsequent target code gen. + void convertSignature(mlir::FuncOp func) { + auto funcTy = func.getType().cast(); + if (hasPortableSignature(funcTy)) + return; + llvm::SmallVector newResTys; + llvm::SmallVector newInTys; + llvm::SmallVector fixups; + + // Convert return value(s) + for (auto ty : funcTy.getResults()) + llvm::TypeSwitch(ty) + .Case([&](fir::ComplexType cmplx) { + if (noComplexConversion) + newResTys.push_back(cmplx); + else + doComplexReturn(func, cmplx, newResTys, newInTys, fixups); + }) + .Case([&](mlir::ComplexType cmplx) { + if (noComplexConversion) + newResTys.push_back(cmplx); + else + doComplexReturn(func, cmplx, newResTys, newInTys, fixups); + }) + .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); + + // Convert arguments + llvm::SmallVector trailingTys; + for (auto e : llvm::enumerate(funcTy.getInputs())) { + auto ty = e.value(); + unsigned index = e.index(); + llvm::TypeSwitch(ty) + .Case([&](BoxCharType boxTy) { + if (noCharacterConversion) { + newInTys.push_back(boxTy); + } else { + // Convert a CHARACTER argument type. This can involve separating + // the pointer and the LEN into two arguments and moving the LEN + // argument to the end of the arg list. + bool sret = functionArgIsSRet(index, func); + for (auto e : llvm::enumerate(specifics->boxcharArgumentType( + boxTy.getEleTy(), sret))) { + auto &tup = e.value(); + auto index = e.index(); + auto attr = std::get(tup); + auto argTy = std::get(tup); + if (attr.isAppend()) { + trailingTys.push_back(argTy); + } else { + if (sret) { + fixups.emplace_back(FixupTy::Codes::CharPair, + newInTys.size(), index); + } else { + fixups.emplace_back(FixupTy::Codes::Trailing, + newInTys.size(), trailingTys.size()); + } + newInTys.push_back(argTy); + } + } + } + }) + .Case([&](fir::ComplexType cmplx) { + if (noComplexConversion) + newInTys.push_back(cmplx); + else + doComplexArg(func, cmplx, newInTys, fixups); + }) + .Case([&](mlir::ComplexType cmplx) { + if (noComplexConversion) + newInTys.push_back(cmplx); + else + doComplexArg(func, cmplx, newInTys, fixups); + }) + .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); + } + + if (!func.empty()) { + // If the function has a body, then apply the fixups to the arguments and + // return ops as required. These fixups are done in place. + auto loc = func.getLoc(); + const auto fixupSize = fixups.size(); + const auto oldArgTys = func.getType().getInputs(); + int offset = 0; + for (std::remove_const_t i = 0; i < fixupSize; ++i) { + const auto &fixup = fixups[i]; + switch (fixup.code) { + case FixupTy::Codes::ArgumentAsLoad: { + // Argument was pass-by-value, but is now pass-by-reference and + // possibly with a different element type. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + rewriter->setInsertionPointToStart(&func.front()); + auto oldArgTy = ReferenceType::get(oldArgTys[fixup.index - offset]); + auto cast = rewriter->create(loc, oldArgTy, newArg); + auto load = rewriter->create(loc, cast); + func.getArgument(fixup.index + 1).replaceAllUsesWith(load); + func.front().eraseArgument(fixup.index + 1); + } break; + case FixupTy::Codes::ArgumentType: { + // Argument is pass-by-value, but its type is likely been modified to + // suit the target ABI convention. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + rewriter->setInsertionPointToStart(&func.front()); + auto mem = + rewriter->create(loc, newInTys[fixup.index]); + rewriter->create(loc, newArg, mem); + auto oldArgTy = ReferenceType::get(oldArgTys[fixup.index - offset]); + auto cast = rewriter->create(loc, oldArgTy, mem); + mlir::Value load = rewriter->create(loc, cast); + func.getArgument(fixup.index + 1).replaceAllUsesWith(load); + func.front().eraseArgument(fixup.index + 1); + LLVM_DEBUG(llvm::errs() + << "old argument: " << oldArgTy.getEleTy() + << ", repl: " << load << ", new argument: " + << func.getArgument(fixup.index).getType() << '\n'); + } break; + case FixupTy::Codes::CharPair: { + // The FIR boxchar argument has been split into a pair of distinct + // arguments that are in juxtaposition to each other. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + if (fixup.second == 1) { + rewriter->setInsertionPointToStart(&func.front()); + auto boxTy = oldArgTys[fixup.index - offset - fixup.second]; + auto box = rewriter->create( + loc, boxTy, func.front().getArgument(fixup.index - 1), newArg); + func.getArgument(fixup.index + 1).replaceAllUsesWith(box); + func.front().eraseArgument(fixup.index + 1); + offset++; + } + } break; + case FixupTy::Codes::ReturnAsStore: { + // The value being returned is now being returned in memory (callee + // stack space) through a hidden reference argument. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + offset++; + func.walk([&](mlir::ReturnOp ret) { + rewriter->setInsertionPoint(ret); + auto oldOper = ret.getOperand(0); + auto oldOperTy = ReferenceType::get(oldOper.getType()); + auto cast = rewriter->create(loc, oldOperTy, newArg); + rewriter->create(loc, oldOper, cast); + rewriter->create(loc); + ret.erase(); + }); + } break; + case FixupTy::Codes::ReturnType: { + // The function is still returning a value, but its type has likely + // changed to suit the target ABI convention. + func.walk([&](mlir::ReturnOp ret) { + rewriter->setInsertionPoint(ret); + auto oldOper = ret.getOperand(0); + auto oldOperTy = ReferenceType::get(oldOper.getType()); + auto mem = + rewriter->create(loc, newResTys[fixup.index]); + auto cast = rewriter->create(loc, oldOperTy, mem); + rewriter->create(loc, oldOper, cast); + mlir::Value load = rewriter->create(loc, mem); + rewriter->create(loc, load); + ret.erase(); + }); + } break; + case FixupTy::Codes::Split: { + // The FIR argument has been split into a pair of distinct arguments + // that are in juxtaposition to each other. (For COMPLEX value.) + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + if (fixup.second == 1) { + rewriter->setInsertionPointToStart(&func.front()); + auto cplxTy = oldArgTys[fixup.index - offset - fixup.second]; + auto undef = rewriter->create(loc, cplxTy); + auto iTy = rewriter->getIntegerType(32); + mlir::Value zero = rewriter->create( + loc, iTy, mlir::IntegerAttr::get(iTy, 0)); + mlir::Value one = rewriter->create( + loc, iTy, mlir::IntegerAttr::get(iTy, 1)); + auto cplx1 = rewriter->create( + loc, cplxTy, undef, func.front().getArgument(fixup.index - 1), + zero); + auto cplx = rewriter->create(loc, cplxTy, cplx1, + newArg, one); + func.getArgument(fixup.index + 1).replaceAllUsesWith(cplx); + func.front().eraseArgument(fixup.index + 1); + offset++; + } + } break; + case FixupTy::Codes::Trailing: { + // The FIR argument has been split into a pair of distinct arguments. + // The first part of the pair appears in the original argument + // position. The second part of the pair is appended after all the + // original arguments. (Boxchar arguments.) + auto newBufArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + auto newLenArg = func.front().addArgument(trailingTys[fixup.second]); + auto boxTy = oldArgTys[fixup.index - offset]; + rewriter->setInsertionPointToStart(&func.front()); + auto box = + rewriter->create(loc, boxTy, newBufArg, newLenArg); + func.getArgument(fixup.index + 1).replaceAllUsesWith(box); + func.front().eraseArgument(fixup.index + 1); + } break; + } + } + } + + // Set the new type and finalize the arguments, etc. + newInTys.insert(newInTys.end(), trailingTys.begin(), trailingTys.end()); + auto newFuncTy = + mlir::FunctionType::get(newInTys, newResTys, func.getContext()); + LLVM_DEBUG(llvm::errs() << "new func: " << newFuncTy << '\n'); + func.setType(newFuncTy); + + for (auto &fixup : fixups) + if (fixup.finalizer) + (*fixup.finalizer)(func); + } + + inline bool functionArgIsSRet(unsigned index, mlir::FuncOp func) { + if (auto attr = func.getArgAttrOfType(index, "llvm.sret")) + return attr.getValue(); + return false; + } + + /// Convert a complex return value. This can involve converting the return + /// value to a "hidden" first argument or packing the complex into a wide + /// GPR. + template + void doComplexReturn(mlir::FuncOp func, A cmplx, B &newResTys, B &newInTys, + C &fixups) { + if (noComplexConversion) { + newResTys.push_back(cmplx); + return; + } + auto m = specifics->complexReturnType(cmplx.getElementType()); + assert(m.size() == 1); + auto &tup = m[0]; + auto attr = std::get(tup); + auto argTy = std::get(tup); + if (attr.isSRet()) { + bool argNo = newInTys.size(); + fixups.emplace_back( + FixupTy::Codes::ReturnAsStore, argNo, [=](mlir::FuncOp func) { + func.setArgAttr(argNo, "llvm.sret", rewriter->getBoolAttr(true)); + }); + newInTys.push_back(argTy); + return; + } + fixups.emplace_back(FixupTy::Codes::ReturnType, newResTys.size()); + newResTys.push_back(argTy); + } + + /// Convert a complex argument value. This can involve storing the value to + /// a temporary memory location or factoring the value into two distinct + /// arguments. + template + void doComplexArg(mlir::FuncOp func, A cmplx, B &newInTys, C &fixups) { + if (noComplexConversion) { + newInTys.push_back(cmplx); + return; + } + auto m = specifics->complexArgumentType(cmplx.getElementType()); + const auto fixupCode = + m.size() > 1 ? FixupTy::Codes::Split : FixupTy::Codes::ArgumentType; + for (auto e : llvm::enumerate(m)) { + auto &tup = e.value(); + auto index = e.index(); + auto attr = std::get(tup); + auto argTy = std::get(tup); + auto argNo = newInTys.size(); + if (attr.isByVal()) { + if (auto align = attr.getAlignment()) + fixups.emplace_back( + FixupTy::Codes::ArgumentAsLoad, argNo, [=](mlir::FuncOp func) { + func.setArgAttr(argNo, "llvm.byval", + rewriter->getBoolAttr(true)); + func.setArgAttr(argNo, "llvm.align", + rewriter->getIntegerAttr( + rewriter->getIntegerType(32), align)); + }); + else + fixups.emplace_back(FixupTy::Codes::ArgumentAsLoad, newInTys.size(), + [=](mlir::FuncOp func) { + func.setArgAttr(argNo, "llvm.byval", + rewriter->getBoolAttr(true)); + }); + } else { + if (auto align = attr.getAlignment()) + fixups.emplace_back(fixupCode, argNo, index, [=](mlir::FuncOp func) { + func.setArgAttr( + argNo, "llvm.align", + rewriter->getIntegerAttr(rewriter->getIntegerType(32), align)); + }); + else + fixups.emplace_back(fixupCode, argNo, index); + } + newInTys.push_back(argTy); + } + } + +private: + // Replace `op` and remove it. + void replaceOp(mlir::Operation *op, mlir::ValueRange newValues) { + op->replaceAllUsesWith(newValues); + op->dropAllReferences(); + op->erase(); + } + + inline void setMembers(CodeGenSpecifics *s, mlir::OpBuilder *r) { + specifics = s; + rewriter = r; + } + + inline void clearMembers() { setMembers(nullptr, nullptr); } + + CodeGenSpecifics *specifics{}; + mlir::OpBuilder *rewriter; +}; // namespace +} // namespace + +std::unique_ptr> +fir::createFirTargetRewritePass(const TargetRewriteOptions &options) { + return std::make_unique(options); +} diff --git a/flang/lib/Optimizer/CodeGen/Target.cpp b/flang/lib/Optimizer/CodeGen/Target.cpp new file mode 100644 index 0000000000000..bab10e5bee6ec --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/Target.cpp @@ -0,0 +1,189 @@ +//===-- Target.cpp --------------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "Target.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/KindMapping.h" +#include "mlir/IR/StandardTypes.h" +#include "mlir/IR/TypeRange.h" +#include "llvm/ADT/Triple.h" + +#define DEBUG_TYPE "flang-codegen-target" + +using namespace fir; + +// Reduce a REAL/float type to the floating point semantics. +static const llvm::fltSemantics &floatToSemantics(KindMapping &kindMap, + mlir::Type type) { + assert(isa_real(type)); + if (auto ty = type.dyn_cast()) + return kindMap.getFloatSemantics(ty.getFKind()); + return type.cast().getFloatSemantics(); +} + +namespace { +template +struct GenericTarget : public CodeGenSpecifics { + using CodeGenSpecifics::CodeGenSpecifics; + using AT = CodeGenSpecifics::Attributes; + + mlir::Type complexMemoryType(mlir::Type eleTy) const override { + assert(fir::isa_real(eleTy)); + // { t, t } struct of 2 eleTy + mlir::TypeRange range = {eleTy, eleTy}; + return mlir::TupleType::get(range, eleTy.getContext()); + } + + mlir::Type boxcharMemoryType(mlir::Type eleTy) const override { + auto idxTy = mlir::IntegerType::get(S::defaultWidth, eleTy.getContext()); + auto ptrTy = fir::ReferenceType::get(eleTy); + // { t*, index } + mlir::TypeRange range = {ptrTy, idxTy}; + return mlir::TupleType::get(range, eleTy.getContext()); + } + + Marshalling boxcharArgumentType(mlir::Type eleTy, bool sret) const override { + CodeGenSpecifics::Marshalling marshal; + auto idxTy = mlir::IntegerType::get(S::defaultWidth, eleTy.getContext()); + auto ptrTy = fir::ReferenceType::get(eleTy); + marshal.emplace_back(ptrTy, AT{}); + // Return value arguments are grouped as a pair. Others are passed in a + // split format with all pointers first (in the declared position) and all + // LEN arguments appended after all of the dummy arguments. + // NB: Other conventions/ABIs can/should be supported via options. + marshal.emplace_back(idxTy, AT{0, {}, {}, /*append=*/!sret}); + return marshal; + } +}; +} // namespace + +//===----------------------------------------------------------------------===// +// i386 (x86 32 bit) linux target specifics. +//===----------------------------------------------------------------------===// + +namespace { +struct TargetI386 : public GenericTarget { + using GenericTarget::GenericTarget; + + static constexpr int defaultWidth = 32; + + CodeGenSpecifics::Marshalling + complexArgumentType(mlir::Type eleTy) const override { + assert(fir::isa_real(eleTy)); + CodeGenSpecifics::Marshalling marshal; + // { t, t } struct of 2 eleTy, byval, align 4 + mlir::TypeRange range = {eleTy, eleTy}; + auto structTy = mlir::TupleType::get(range, eleTy.getContext()); + marshal.emplace_back(fir::ReferenceType::get(structTy), + AT{4, /*byval=*/true, {}}); + return marshal; + } + + CodeGenSpecifics::Marshalling + complexReturnType(mlir::Type eleTy) const override { + assert(fir::isa_real(eleTy)); + CodeGenSpecifics::Marshalling marshal; + const auto *sem = &floatToSemantics(kindMap, eleTy); + if (sem == &llvm::APFloat::IEEEsingle()) { + // i64 pack both floats in a 64-bit GPR + marshal.emplace_back(mlir::IntegerType::get(64, eleTy.getContext()), + AT{}); + } else if (sem == &llvm::APFloat::IEEEdouble()) { + // { t, t } struct of 2 eleTy, sret, align 4 + mlir::TypeRange range = {eleTy, eleTy}; + auto structTy = mlir::TupleType::get(range, eleTy.getContext()); + marshal.emplace_back(fir::ReferenceType::get(structTy), + AT{4, {}, /*sret=*/true}); + } else { + llvm_unreachable("not implemented"); + } + return marshal; + } +}; +} // namespace + +//===----------------------------------------------------------------------===// +// x86_64 (x86 64 bit) linux target specifics. +//===----------------------------------------------------------------------===// + +namespace { +struct TargetX86_64 : public GenericTarget { + using GenericTarget::GenericTarget; + + static constexpr int defaultWidth = 64; + + CodeGenSpecifics::Marshalling + complexArgumentType(mlir::Type eleTy) const override { + CodeGenSpecifics::Marshalling marshal; + const auto *sem = &floatToSemantics(kindMap, eleTy); + if (sem == &llvm::APFloat::IEEEsingle()) { + // <2 x t> vector of 2 eleTy + marshal.emplace_back(fir::VectorType::get(2, eleTy), AT{}); + } else if (sem == &llvm::APFloat::IEEEdouble()) { + // two distinct double arguments + marshal.emplace_back(eleTy, AT{}); + marshal.emplace_back(eleTy, AT{}); + } else { + llvm_unreachable("not implemented"); + } + return marshal; + } + + CodeGenSpecifics::Marshalling + complexReturnType(mlir::Type eleTy) const override { + CodeGenSpecifics::Marshalling marshal; + const auto *sem = &floatToSemantics(kindMap, eleTy); + if (sem == &llvm::APFloat::IEEEsingle()) { + // <2 x t> vector of 2 eleTy + marshal.emplace_back(fir::VectorType::get(2, eleTy), AT{}); + } else if (sem == &llvm::APFloat::IEEEdouble()) { + // { double, double } struct of 2 double + mlir::TypeRange range = {eleTy, eleTy}; + marshal.emplace_back(mlir::TupleType::get(range, eleTy.getContext()), + AT{}); + } else { + llvm_unreachable("not implemented"); + } + return marshal; + } +}; +} // namespace + +// Instantiate the overloaded target instance based on the triple value. +// Currently, the implementation only instantiates `i386-unknown-linux-gnu` and +// `x86_64-unknown-linux-gnu` like triples. Other targets should be added to +// this file as needed. +std::unique_ptr +fir::CodeGenSpecifics::get(mlir::MLIRContext *ctx, llvm::Triple &trp, + KindMapping &kindMap) { + switch (trp.getArch()) { + default: + break; + case llvm::Triple::ArchType::x86: + switch (trp.getOS()) { + default: + break; + case llvm::Triple::OSType::Linux: + return std::make_unique(ctx, trp, kindMap); + } + break; + case llvm::Triple::ArchType::x86_64: + switch (trp.getOS()) { + default: + break; + case llvm::Triple::OSType::Linux: + return std::make_unique(ctx, trp, kindMap); + } + break; + } + llvm::report_fatal_error("target not implemented"); +} diff --git a/flang/lib/Optimizer/CodeGen/Target.h b/flang/lib/Optimizer/CodeGen/Target.h new file mode 100644 index 0000000000000..44b1067d958fa --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/Target.h @@ -0,0 +1,108 @@ +//===- Target.h - target specific details -----------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#ifndef OPTMIZER_CODEGEN_TARGET_H +#define OPTMIZER_CODEGEN_TARGET_H + +#include "mlir/IR/Types.h" +#include +#include +#include + +namespace llvm { +class Triple; +} // namespace llvm + +namespace fir { +class KindMapping; + +namespace details { +/// Extra information about how to marshal an argument or return value that +/// modifies a signature per a particular ABI's calling convention. +/// Note: llvm::Attribute is not used directly, because its use depends on an +/// LLVMContext. +class Attributes { +public: + Attributes() : alignment{0}, byval{false}, sret{false}, append{false} {} + Attributes(unsigned short alignment, bool byval = false, bool sret = false, + bool append = false) + : alignment{alignment}, byval{byval}, sret{sret}, append{append} {} + + unsigned getAlignment() const { return alignment; } + bool hasAlignment() const { return alignment != 0; } + bool isByVal() const { return byval; } + bool returnValueAsArgument() const { return isSRet(); } + bool isSRet() const { return sret; } + bool isAppend() const { return append; } + +private: + unsigned short alignment{}; + bool byval : 1; + bool sret : 1; + bool append : 1; +}; + +} // namespace details + +/// Some details of how to represent certain features depend on the target and +/// ABI that is being used. These specifics are captured here and guide the +/// lowering of FIR to LLVM-IR dialect. +class CodeGenSpecifics { +public: + using Attributes = details::Attributes; + using Marshalling = std::vector>; + + static std::unique_ptr + get(mlir::MLIRContext *ctx, llvm::Triple &trp, KindMapping &kindMap); + + CodeGenSpecifics(mlir::MLIRContext *ctx, llvm::Triple &trp, + KindMapping &kindMap) + : context{*ctx}, triple{trp}, kindMap{kindMap} {} + CodeGenSpecifics() = delete; + virtual ~CodeGenSpecifics() {} + + /// Type presentation of a `complex` type value in memory. + virtual mlir::Type complexMemoryType(mlir::Type eleTy) const = 0; + + /// Type presentation of a `complex` type argument when passed by + /// value. An argument value may need to be passed as a (safe) reference + /// argument. + virtual Marshalling complexArgumentType(mlir::Type eleTy) const = 0; + + /// Type presentation of a `complex` type return value. Such a return + /// value may need to be converted to a hidden reference argument. + virtual Marshalling complexReturnType(mlir::Type eleTy) const = 0; + + /// Type presentation of a `boxchar` type value in memory. + virtual mlir::Type boxcharMemoryType(mlir::Type eleTy) const = 0; + + /// Type presentation of a `boxchar` type argument when passed by value. An + /// argument value may need to be passed as a (safe) reference argument. + /// + /// A function that returns a `boxchar` type value must already have + /// converted that return value to an sret argument. This requirement is in + /// keeping with Fortran semantics, which require the caller to allocate the + /// space for the return CHARACTER value and pass a pointer and the length of + /// that space (a boxchar) to the called function. Such functions should be + /// annotated with an Attribute to distinguish the sret argument. + virtual Marshalling boxcharArgumentType(mlir::Type eleTy, + bool sret = false) const = 0; + +protected: + mlir::MLIRContext &context; + llvm::Triple &triple; + KindMapping &kindMap; +}; + +} // namespace fir + +#endif // OPTMIZER_CODEGEN_TARGET_H diff --git a/flang/test/Fir/boxchar.fir b/flang/test/Fir/boxchar.fir index c5ac9ceb1ef60..22c4e0c8e9412 100644 --- a/flang/test/Fir/boxchar.fir +++ b/flang/test/Fir/boxchar.fir @@ -1,7 +1,6 @@ -// RUN: tco %s | FileCheck %s +// RUN: tco --target=x86_64-unknown-linux-gnu %s | FileCheck %s // Test of building and passing boxchar. -// TODO: split argument into two distinct parameters. func @callee(%x : !fir.boxchar<1>) @@ -11,7 +10,7 @@ func @get_name() { %2 = constant 9 : i64 %3 = fir.convert %1 : (!fir.ref>>) -> !fir.ref> %4 = fir.emboxchar %3, %2 : (!fir.ref>, i64) -> !fir.boxchar<1> - // CHECK: call void @callee({ i8*, i64 } { i8* getelementptr inbounds ([9 x i8], [9 x i8]* @name, i32 0, i32 0), i64 9 }) + // CHECK: call void @callee(i8* getelementptr inbounds ([9 x i8], [9 x i8]* @name, i32 0, i32 0), i64 9) fir.call @callee(%4) : (!fir.boxchar<1>) -> () return } diff --git a/flang/test/Fir/compare.fir b/flang/test/Fir/compare.fir index f569c97a49b5b..3ac8bedde2836 100644 --- a/flang/test/Fir/compare.fir +++ b/flang/test/Fir/compare.fir @@ -1,4 +1,4 @@ -// RUN: tco -emit-fir %s | tco | FileCheck %s +// RUN: tco -emit-fir %s | tco --target=x86_64-unknown-linux-gnu | FileCheck %s // CHECK-LABEL: define i1 @cmp(x86_fp80 %0, x86_fp80 %1) func @cmp(%a : !fir.real<10>, %b : !fir.real<10>) -> i1 { @@ -14,7 +14,7 @@ func @cmp2(%a : !fir.real<16>, %b : !fir.real<16>) -> i1 { return %1 : i1 } -// CHECK-LABEL: define i1 @cmp3({ float, float } %0, { float, float } %1) +// CHECK-LABEL: define i1 @cmp3(<2 x float> %0, <2 x float> %1) func @cmp3(%a : !fir.complex<4>, %b : !fir.complex<4>) -> i1 { // CHECK: fcmp ueq float %1 = fir.cmpc "ueq", %a, %b : !fir.complex<4> @@ -35,10 +35,11 @@ func @neg2(%a : !fir.real<8>) -> !fir.real<8> { return %1 : !fir.real<8> } -// CHECK-LABEL: define { double, double } @neg3({ double, double } %0) +// CHECK-LABEL: define { double, double } @neg3(double %0, double %1) func @neg3(%a : !fir.complex<8>) -> !fir.complex<8> { -// CHECK: %[[r3:.*]] = fneg double -// CHECK: insertvalue { double, double } %0, double %[[r3]] + // CHECK: %[[g2:.*]] = insertvalue { double, double } % + // CHECK: %[[r3:.*]] = fneg double + // CHECK: insertvalue { double, double } %[[g2]], double %[[r3]] %1 = fir.negc %a : !fir.complex<8> return %1 : !fir.complex<8> } diff --git a/flang/test/Fir/complex.fir b/flang/test/Fir/complex.fir index 6d7cfdfcb068d..971551328ddc2 100644 --- a/flang/test/Fir/complex.fir +++ b/flang/test/Fir/complex.fir @@ -1,12 +1,12 @@ // RUN: cc -c %S/print_complex.c -// RUN: tco %s | FileCheck %s --check-prefix=LLVMIR -// RUN: tco %s | llc | as -o %t +// RUN: tco --target=x86_64-unknown-linux-gnu %s | FileCheck %s --check-prefix=LLVMIR +// RUN: tco --target=x86_64-unknown-linux-gnu %s | llc | as -o %t // RUN: cc %t print_complex.o // RUN: ./a.out | FileCheck %s --check-prefix=EXECHECK // EXECHECK: <0.935893, 2.252526> -// LLVMIR-LABEL: define { float, float } @foo +// LLVMIR-LABEL: define <2 x float> @foo(<2 x float> % func @foo(%a : !fir.complex<4>, %b : !fir.complex<4>, %c : !fir.complex<4>, %d : !fir.complex<4>, %e : !fir.complex<4>) -> !fir.complex<4> { // LLVMIR-COUNT-2: extractvalue // LLVMIR: fadd float @@ -23,7 +23,7 @@ func @foo(%a : !fir.complex<4>, %b : !fir.complex<4>, %c : !fir.complex<4>, %d : return %4 : !fir.complex<4> } -// LLVMIR-LABEL: define float @real_part({ float, float } %0) +// LLVMIR-LABEL: define float @real_part(<2 x float> %0) func @real_part(%a : !fir.complex<4>) -> f32 { %0 = constant 0 : i32 // LLVMIR: extractvalue @@ -31,7 +31,7 @@ func @real_part(%a : !fir.complex<4>) -> f32 { return %1 : f32 } -// LLVMIR-LABEL: define { float, float } @conj +// LLVMIR-LABEL: define <2 x float> @conj(<2 x float> % func @conj(%a : !fir.complex<4>) -> !fir.complex<4> { %0 = constant 1 : i32 // LLVMIR: extractvalue diff --git a/flang/test/Fir/convert.fir b/flang/test/Fir/convert.fir index ad480133c6ad7..1fde7ac96d025 100644 --- a/flang/test/Fir/convert.fir +++ b/flang/test/Fir/convert.fir @@ -1,6 +1,6 @@ -// RUN: tco %s | FileCheck %s +// RUN: tco --target=x86_64-unknown-linux-gnu %s | FileCheck %s -// CHECK-LABEL: define { double, double } @c({ float, float } +// CHECK-LABEL: define { double, double } @c(<2 x float> % func @c(%x : !fir.complex<4>) -> !fir.complex<8> { // CHECK: %[[R:.*]] = extractvalue { float, float } %{{.*}}, 0 // CHECK: %[[I:.*]] = extractvalue { float, float } %{{.*}}, 1 diff --git a/flang/test/Fir/target.fir b/flang/test/Fir/target.fir new file mode 100644 index 0000000000000..fc39816301647 --- /dev/null +++ b/flang/test/Fir/target.fir @@ -0,0 +1,117 @@ +// RUN: tco --target=i386-unknown-linux-gnu %s | FileCheck %s --check-prefix=I32 +// RUN: tco --target=x86_64-unknown-linux-gnu %s | FileCheck %s --check-prefix=X64 + +// I32-LABEL: define i64 @gen4() +// X64-LABEL: define <2 x float> @gen4() +func @gen4() -> !fir.complex<4> { + %1 = fir.undefined !fir.complex<4> + %2 = constant 2.0 : f32 + %3 = fir.convert %2 : (f32) -> !fir.real<4> + %c0 = constant 0 : i32 + %4 = fir.insert_value %1, %3, %c0 : (!fir.complex<4>, !fir.real<4>, i32) -> !fir.complex<4> + %c1 = constant 1 : i32 + %5 = constant -42.0 : f32 + %6 = fir.insert_value %4, %5, %c1 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + // I32: store { float, float } { float 2.000000e+00, float -4.200000e+01 } + // I32: %[[load:.*]] = load i64, i64* + // I32: ret i64 %[[load]] + // X64: store { float, float } { float 2.000000e+00, float -4.200000e+01 } + // X64: %[[load:.*]] = load <2 x float>, <2 x float>* + // X64: ret <2 x float> %[[load]] + return %6 : !fir.complex<4> +} + +// I32-LABEL: define void @gen8({ double, double }* sret % +// X64-LABEL: define { double, double } @gen8() +func @gen8() -> !fir.complex<8> { + %1 = fir.undefined !fir.complex<8> + %2 = constant 1.0 : f64 + %3 = constant -4.0 : f64 + %c0 = constant 0 : i32 + %4 = fir.insert_value %1, %3, %c0 : (!fir.complex<8>, f64, i32) -> !fir.complex<8> + %c1 = constant 1 : i32 + %5 = fir.insert_value %4, %2, %c1 : (!fir.complex<8>, f64, i32) -> !fir.complex<8> + // I32: store { double, double } { double -4.000000e+00, double 1.000000e+00 } + // I64: store { double, double } { double -4.000000e+00, double 1.000000e+00 } + // I64: %[[load:.*]] = load { double, double } + // I64: ret { double, double } %[[load]] + return %5 : !fir.complex<8> +} + +// I32: declare void @sink4({ float, float }*) +// X64: declare void @sink4(<2 x float>) +func @sink4(!fir.complex<4>) -> () + +// I32: declare void @sink8({ double, double }*) +// X64: declare void @sink8(double, double) +func @sink8(!fir.complex<8>) -> () + +// I32-LABEL: define void @call4() +// X64-LABEL: define void @call4() +func @call4() { + // I32: = call i64 @gen4() + // X64: = call <2 x float> @gen4() + %1 = fir.call @gen4() : () -> !fir.complex<4> + // I32: call void @sink4({ float, float }* % + // X64: call void @sink4(<2 x float> % + fir.call @sink4(%1) : (!fir.complex<4>) -> () + return +} + +// I32-LABEL: define void @call8() +// X64-LABEL: define void @call8() +func @call8() { + // I32: call void @gen8({ double, double }* % + // X64: = call { double, double } @gen8() + %1 = fir.call @gen8() : () -> !fir.complex<8> + // I32: call void @sink8({ double, double }* % + // X64: call void @sink8(double %4, double %5) + fir.call @sink8(%1) : (!fir.complex<8>) -> () + return +} + +// I32-LABEL: define i64 @char1lensum(i8* %0, i8* %1, i32 %2, i32 %3) +// X64-LABEL: define i64 @char1lensum(i8* %0, i8* %1, i64 %2, i64 %3) +func @char1lensum(%arg0 : !fir.boxchar<1>, %arg1 : !fir.boxchar<1>) -> i64 { + // X64-DAG: %[[p0:.*]] = insertvalue { i8*, i64 } undef, i8* %1, 0 + // X64-DAG: = insertvalue { i8*, i64 } %[[p0]], i64 %3, 1 + // X64-DAG: %[[p1:.*]] = insertvalue { i8*, i64 } undef, i8* %0, 0 + // X64-DAG: = insertvalue { i8*, i64 } %[[p1]], i64 %2, 1 + %1:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, i64) + %2:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref>, i64) + // I32: %[[add:.*]] = add i64 % + // X64: %[[add:.*]] = add i64 % + %3 = addi %1#1, %2#1 : i64 + // I32: ret i64 %[[add]] + // X64: ret i64 %[[add]] + return %3 : i64 +} + +// I32-LABEL: define void @char1copy(i8* sret %0, i32 %1, i8* %2, i32 %3) +// I64-LABEL: define void @char1copy(i8* sret %0, i64 %1, i8* %2, i64 %3) +func @char1copy(%arg0 : !fir.boxchar<1> {llvm.sret = true}, %arg1 : !fir.boxchar<1>) { + // I32-DAG: %[[p0:.*]] = insertvalue { i8*, i32 } undef, i8* %2, 0 + // I32-DAG: = insertvalue { i8*, i32 } %[[p0]], i32 %3, 1 + // I32-DAG: %[[p1:.*]] = insertvalue { i8*, i32 } undef, i8* %0, 0 + // I32-DAG: = insertvalue { i8*, i32 } %[[p1]], i32 %1, 1 + // X64-DAG: %[[p0:.*]] = insertvalue { i8*, i64 } undef, i8* %2, 0 + // X64-DAG: = insertvalue { i8*, i64 } %[[p0]], i64 %3, 1 + // X64-DAG: %[[p1:.*]] = insertvalue { i8*, i64 } undef, i8* %0, 0 + // X64-DAG: = insertvalue { i8*, i64 } %[[p1]], i64 %1, 1 + %1:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>>, i64) + %2:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref>>, i64) + %c0 = constant 0 : index + %c1 = constant 1 : index + %3 = fir.convert %1#1 : (i64) -> index + %last = subi %3, %c1 : index + fir.do_loop %i = %c0 to %last step %c1 { + %in_pos = fir.coordinate_of %2#0, %i : (!fir.ref>>, index) -> !fir.ref> + %out_pos = fir.coordinate_of %1#0, %i : (!fir.ref>>, index) -> !fir.ref> + %ch = fir.load %in_pos : !fir.ref> + fir.store %ch to %out_pos : !fir.ref> + } + // I32: ret void + // X64: ret void + return +} + diff --git a/flang/test/Lower/bbcnull.f90 b/flang/test/Lower/bbcnull.f90 new file mode 100644 index 0000000000000..8b27c796dbeab --- /dev/null +++ b/flang/test/Lower/bbcnull.f90 @@ -0,0 +1,4 @@ +! RUN: bbc --version | FileCheck %s +! CHECK: LLVM version + +! This test is intentionally empty. diff --git a/flang/test/Lower/dummy-procedure.f90 b/flang/test/Lower/dummy-procedure.f90 index a9baa2976756a..71e2ce3c42d20 100644 --- a/flang/test/Lower/dummy-procedure.f90 +++ b/flang/test/Lower/dummy-procedure.f90 @@ -33,8 +33,8 @@ real function func(x) real function test_func() real :: func, prefoo external :: func - !CHECK: %[[f:.*]] = constant @_QPfunc : (!fir.ref) -> f32 - !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> f32) -> (() -> ()) + !CHECK: %[[f:.*]] = fir.address_of(@_QPfunc) : (!fir.ref) -> f32 + !CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.ref) -> f32) -> (() -> ()) !CHECK: fir.call @_QPprefoo(%[[fcast]]) : (() -> ()) -> f32 test_func = prefoo(func) end function @@ -69,8 +69,8 @@ subroutine sub(x) ! CHECK-LABEL: func @_QPtest_sub subroutine test_sub() external :: sub - !CHECK: %[[f:.*]] = constant @_QPsub : (!fir.ref) -> () - !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> ()) -> (() -> ()) + !CHECK: %[[f:.*]] = fir.address_of(@_QPsub) : (!fir.ref) -> () + !CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.ref) -> ()) -> (() -> ()) !CHECK: fir.call @_QPprefoo_sub(%[[fcast]]) : (() -> ()) -> () call prefoo_sub(sub) end subroutine @@ -81,8 +81,8 @@ subroutine test_sub() ! CHECK-LABEL: func @_QPtest_acos subroutine test_acos(x) intrinsic :: acos - !CHECK: %[[f:.*]] = constant @fir.acos.f32.ref_f32 : (!fir.ref) -> f32 - !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> f32) -> (() -> ()) + !CHECK: %[[f:.*]] = fir.address_of(@fir.acos.f32.ref_f32) : (!fir.ref) -> f32 + !CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.ref) -> f32) -> (() -> ()) !CHECK: fir.call @_QPfoo_acos(%[[fcast]]) : (() -> ()) -> () call foo_acos(acos) end subroutine @@ -91,8 +91,8 @@ subroutine test_acos(x) ! CHECK-LABEL: func @_QPtest_aimag subroutine test_aimag() intrinsic :: aimag - !CHECK: %[[f:.*]] = constant @fir.aimag.f32.ref_z4 : (!fir.ref>) -> f32 - !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref>) -> f32) -> (() -> ()) + !CHECK: %[[f:.*]] = fir.address_of(@fir.aimag.f32.ref_z4) : (!fir.ref>) -> f32 + !CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.ref>) -> f32) -> (() -> ()) !CHECK: fir.call @_QPfoo_aimag(%[[fcast]]) : (() -> ()) -> () call foo_aimag(aimag) end subroutine @@ -101,8 +101,8 @@ subroutine test_aimag() ! CHECK-LABEL: func @_QPtest_len subroutine test_len() intrinsic :: len - ! CHECK: %[[f:.*]] = constant @fir.len.i32.bc1 : (!fir.boxchar<1>) -> i32 - ! CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.boxchar<1>) -> i32) -> (() -> ()) + ! CHECK: %[[f:.*]] = fir.address_of(@fir.len.i32.bc1) : (!fir.boxchar<1>) -> i32 + ! CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.boxchar<1>) -> i32) -> (() -> ()) !CHECK: fir.call @_QPfoo_len(%[[fcast]]) : (() -> ()) -> () call foo_len(len) end subroutine @@ -112,8 +112,8 @@ subroutine test_len() ! CHECK-LABEL: func @_QPtest_iabs subroutine test_iabs() intrinsic :: iabs - ! CHECK: %[[f:.*]] = constant @fir.abs.i32.ref_i32 : (!fir.ref) -> i32 - ! CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> i32) -> (() -> ()) + ! CHECK: %[[f:.*]] = fir.address_of(@fir.abs.i32.ref_i32) : (!fir.ref) -> i32 + ! CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.ref) -> i32) -> (() -> ()) ! CHECK: fir.call @_QPfoo_iabs(%[[fcast]]) : (() -> ()) -> () call foo_iabs(iabs) end subroutine @@ -137,7 +137,7 @@ subroutine todo3(dummy_proc) ! CHECK-LABEL: func @fir.acos.f32.ref_f32(%arg0: !fir.ref) -> f32 !CHECK: %[[load:.*]] = fir.load %arg0 - !CHECK: %[[res:.*]] = call @__fs_acos_1(%[[load]]) : (f32) -> f32 + !CHECK: %[[res:.*]] = fir.call @__fs_acos_1(%[[load]]) : (f32) -> f32 !CHECK: return %[[res]] : f32 !CHECK-LABEL: func @fir.aimag.f32.ref_z4(%arg0: !fir.ref>) diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index e7c4b6cc5480e..52390b280e55f 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -13,7 +13,7 @@ subroutine abs_testi(a, b) ! CHECK-LABEL: abs_testr subroutine abs_testr(a, b) real :: a, b - ! CHECK: call @llvm.fabs.f32 + ! CHECK: fir.call @llvm.fabs.f32 b = abs(a) end subroutine @@ -23,7 +23,7 @@ subroutine abs_testz(a, b) real :: b ! CHECK: fir.extract_value ! CHECK: fir.extract_value - ! CHECK: call @{{.*}}hypot + ! CHECK: fir.call @{{.*}}hypot b = abs(a) end subroutine @@ -40,7 +40,7 @@ subroutine aimag_test(a, b) ! CHECK-LABEL: aint_test subroutine aint_test(a, b) real :: a, b - ! CHECK: call @llvm.trunc.f32 + ! CHECK: fir.call @llvm.trunc.f32 b = aint(a) end subroutine @@ -48,7 +48,7 @@ subroutine aint_test(a, b) ! CHECK-LABEL: anint_test subroutine anint_test(a, b) real :: a, b - ! CHECK: call @llvm.round.f32 + ! CHECK: fir.call @llvm.round.f32 b = anint(a) end subroutine @@ -106,7 +106,7 @@ subroutine ceiling_test1(i, a) integer :: i real :: a i = ceiling(a) - ! CHECK: %[[f:.*]] = call @llvm.ceil.f32 + ! CHECK: %[[f:.*]] = fir.call @llvm.ceil.f32 ! CHECK: fir.convert %[[f]] : (f32) -> i32 end subroutine ! CHECK-LABEL: ceiling_test2 @@ -114,7 +114,7 @@ subroutine ceiling_test2(i, a) integer(8) :: i real :: a i = ceiling(a, 8) - ! CHECK: %[[f:.*]] = call @llvm.ceil.f32 + ! CHECK: %[[f:.*]] = fir.call @llvm.ceil.f32 ! CHECK: fir.convert %[[f]] : (f32) -> i64 end subroutine @@ -135,7 +135,7 @@ subroutine floor_test1(i, a) integer :: i real :: a i = floor(a) - ! CHECK: %[[f:.*]] = call @llvm.floor.f32 + ! CHECK: %[[f:.*]] = fir.call @llvm.floor.f32 ! CHECK: fir.convert %[[f]] : (f32) -> i32 end subroutine ! CHECK-LABEL: floor_test2 @@ -143,7 +143,7 @@ subroutine floor_test2(i, a) integer(8) :: i real :: a i = floor(a, 8) - ! CHECK: %[[f:.*]] = call @llvm.floor.f32 + ! CHECK: %[[f:.*]] = fir.call @llvm.floor.f32 ! CHECK: fir.convert %[[f]] : (f32) -> i64 end subroutine @@ -242,14 +242,14 @@ subroutine nint_test1(i, a) integer :: i real :: a i = nint(a) - ! CHECK: call @llvm.lround.i32.f32 + ! CHECK: fir.call @llvm.lround.i32.f32 end subroutine ! CHECK-LABEL: nint_test2 subroutine nint_test2(i, a) integer(8) :: i real(8) :: a i = nint(a, 8) - ! CHECK: call @llvm.lround.i64.f64 + ! CHECK: fir.call @llvm.lround.i64.f64 end subroutine @@ -270,7 +270,7 @@ subroutine sign_testi(a, b, c) ! CHECK-LABEL: sign_testr subroutine sign_testr(a, b, c) real a, b, c - ! CHECK-DAG: call {{.*}}fabs + ! CHECK-DAG: fir.call {{.*}}fabs ! CHECK-DAG: fir.negf ! CHECK-DAG: fir.cmpf "olt" ! CHECK: select @@ -281,6 +281,6 @@ subroutine sign_testr(a, b, c) ! CHECK-LABEL: sqrt_testr subroutine sqrt_testr(a, b) real :: a, b - ! CHECK: call {{.*}}sqrt + ! CHECK: fir.call {{.*}}sqrt b = sqrt(a) end subroutine diff --git a/flang/test/Lower/procedure-declarations.f90 b/flang/test/Lower/procedure-declarations.f90 index 164db03adff93..48f458750b9a8 100644 --- a/flang/test/Lower/procedure-declarations.f90 +++ b/flang/test/Lower/procedure-declarations.f90 @@ -14,7 +14,7 @@ ! CHECK-LABEL: func @_QPpass_foo() { subroutine pass_foo() external :: foo - ! CHECK: %[[f:.*]] = constant @_QPfoo + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo) ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo) end subroutine @@ -42,7 +42,7 @@ subroutine call_foo2(i) ! CHECK-LABEL: func @_QPpass_foo2() { subroutine pass_foo2() external :: foo2 - ! CHECK: %[[f:.*]] = constant @_QPfoo2 + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo2) ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo2) end subroutine @@ -68,7 +68,7 @@ subroutine foo3(i) ! CHECK-LABEL: func @_QPpass_foo3() { subroutine pass_foo3() external :: foo3 - ! CHECK: %[[f:.*]] = constant @_QPfoo3 + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo3) ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo3) end subroutine @@ -89,7 +89,7 @@ subroutine call_foo4(i) ! CHECK-LABEL: func @_QPpass_foo4() { subroutine pass_foo4() external :: foo4 - ! CHECK: %[[f:.*]] = constant @_QPfoo4 + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo4) ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo4) end subroutine @@ -103,7 +103,7 @@ subroutine foo5(i) ! CHECK-LABEL: func @_QPpass_foo5() { subroutine pass_foo5() external :: foo5 - ! CHECK: %[[f:.*]] = constant @_QPfoo5 + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo5) ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo5) end subroutine @@ -129,7 +129,7 @@ subroutine call_foo6(i) ! CHECK-LABEL: func @_QPpass_foo6() { subroutine pass_foo6() external :: foo6 - ! CHECK: %[[f:.*]] = constant @_QPfoo6 : (!fir.ref>) -> () + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo6) : (!fir.ref>) -> () ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo6) end subroutine @@ -144,7 +144,7 @@ subroutine pass_foo7() ! CHECK-LABEL: func @_QPcall_foo7(%arg0: !fir.ref>) -> f32 { function call_foo7(i) integer :: i(10) - ! CHECK: %[[f:.*]] = constant @_QPfoo7 : () -> () + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo7) : () -> () ! CHECK: %[[funccast:.*]] = fir.convert %[[f]] : (() -> ()) -> ((!fir.ref>) -> f32) ! CHECK: fir.call %[[funccast]](%arg0) : (!fir.ref>) -> f32 call_foo7 = foo7(i) diff --git a/flang/test/Lower/stmt-function.f90 b/flang/test/Lower/stmt-function.f90 index 47f8c934b6c88..7912fbbaeb0b8 100644 --- a/flang/test/Lower/stmt-function.f90 +++ b/flang/test/Lower/stmt-function.f90 @@ -92,7 +92,7 @@ integer function test_stmt_character(c, j) func(argc, argj) = len_trim(argc, 4) + argj !CHECK-DAG: %[[j:.*]] = fir.load %arg1 !CHECK-DAG: %[[c4:.*]] = constant 4 : - !CHECK-DAG: %[[len_trim:.*]] = call @fir.len_trim.i32.bc1.i32(%[[c]], %[[c4]]) + !CHECK-DAG: %[[len_trim:.*]] = fir.call @fir.len_trim.i32.bc1.i32(%[[c]], %[[c4]]) !CHECK: addi %[[len_trim]], %[[j]] test_stmt_character = func(c, j) end function @@ -101,7 +101,7 @@ integer function test_stmt_character(c, j) ! CHECK-LABEL: @_QPbug247 subroutine bug247(r) I(R) = R - ! CHECK: call {{.*}}OutputInteger + ! CHECK: fir.call {{.*}}OutputInteger PRINT *, I(2.5) - ! CHECK: call {{.*}}EndIo + ! CHECK: fir.call {{.*}}EndIo END subroutine bug247 diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index bf8b7f9c859cc..da8ba2bcd3a8a 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// /// /// \file /// This is a tool for translating Fortran sources to the FIR dialect of MLIR. @@ -19,6 +23,7 @@ #include "flang/Lower/Support/Verifier.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/OptPasses.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Optimizer/Support/KindMapping.h" #include "flang/Parser/characters.h" @@ -137,7 +142,10 @@ static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) { out << '\n'; } -// Convert Fortran input to MLIR (target is FIR dialect) +//===----------------------------------------------------------------------===// +// Translate Fortran input to FIR, a dialect of MLIR. +//===----------------------------------------------------------------------===// + static mlir::LogicalResult convertFortranSourceToMLIR( std::string path, Fortran::parser::Options options, const ProgramName &programPrefix, @@ -211,13 +219,18 @@ static mlir::LogicalResult convertFortranSourceToMLIR( return mlir::failure(); } - // MLIR+FIR + // translate to FIR dialect of MLIR + llvm::Triple triple(fir::determineTargetTriple(targetTriple)); fir::NameUniquer nameUniquer; auto burnside = Fortran::lower::LoweringBridge::create( semanticsContext.defaultKinds(), semanticsContext.intrinsics(), parsing.cooked()); burnside.lower(parseTree, nameUniquer, semanticsContext); mlir::ModuleOp mlirModule = burnside.getModule(); + fir::KindMapping kindMap(mlirModule.getContext()); + fir::setTargetTriple(mlirModule, triple); + fir::setNameUniquer(mlirModule, nameUniquer); + fir::setKindMapping(mlirModule, kindMap); std::error_code ec; std::string outputName = outputFilename; if (!outputName.size()) @@ -308,9 +321,8 @@ int main(int argc, char **argv) { if (includeDirs.size() == 0) includeDirs.push_back("."); - if (!intrinsicModuleDir.empty()) { + if (!intrinsicModuleDir.empty()) includeDirs.insert(includeDirs.begin(), intrinsicModuleDir); - } Fortran::parser::Options options; options.predefinitions.emplace_back("__F18", "1"); diff --git a/flang/unittests/Lower/RTBuilder.cpp b/flang/unittests/Lower/RTBuilder.cpp index b475b5e59ab0e..f68cf9844c9b8 100644 --- a/flang/unittests/Lower/RTBuilder.cpp +++ b/flang/unittests/Lower/RTBuilder.cpp @@ -29,7 +29,7 @@ TEST(RTBuilderTest, ComplexRuntimeInterface) { auto c99_cacosf_funcTy = c99_cacosf_signature.cast(); EXPECT_EQ(c99_cacosf_funcTy.getNumInputs(), 1u); EXPECT_EQ(c99_cacosf_funcTy.getNumResults(), 1u); - auto cplx_ty = fir::CplxType::get(&ctx, 4); + auto cplx_ty = fir::ComplexType::get(&ctx, 4); EXPECT_EQ(c99_cacosf_funcTy.getInput(0), cplx_ty); EXPECT_EQ(c99_cacosf_funcTy.getResult(0), cplx_ty); } From bc7a2294eb9a91114a04fad3478b78e1251524b8 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 31 Aug 2020 13:56:58 -0700 Subject: [PATCH 0239/1017] disable affine in bbc fix a few bugs --- .../Optimizer/Transforms/RewritePatterns.td | 5 +++-- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 20 +++++++++++-------- flang/tools/bbc/bbc.cpp | 2 +- 3 files changed, 16 insertions(+), 11 deletions(-) diff --git a/flang/include/flang/Optimizer/Transforms/RewritePatterns.td b/flang/include/flang/Optimizer/Transforms/RewritePatterns.td index 97bc1a4ae4638..087c27f9e5f5e 100644 --- a/flang/include/flang/Optimizer/Transforms/RewritePatterns.td +++ b/flang/include/flang/Optimizer/Transforms/RewritePatterns.td @@ -51,8 +51,9 @@ def createConstantOp "rewriter.getIndexAttr($1.dyn_cast().getInt()))">; def ForwardConstantConvertPattern - : Pat<(fir_ConvertOp:$res (ConstantOp $attr)), + : Pat<(fir_ConvertOp:$res (ConstantOp:$cnt $attr)), (createConstantOp $res, $attr), - [(IndexTypePred $res)]>; + [(IndexTypePred $res) + ,(IntegerTypePred $cnt)]>; #endif // FIR_REWRITE_PATTERNS diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index c0836d7f28659..69d956f7328f7 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -454,7 +454,7 @@ class TargetRewrite : public TargetRewriteBase { if (fnTy.getResults().size() == 1) { mlir::Type ty = fnTy.getResult(0); llvm::TypeSwitch(ty) - .template Case([&](fir::ComplexType cmplx) { + .template Case([&](fir::ComplexType cmplx) { wrap = rewriteCallComplexResultType(cmplx, newResTys, newInTys, newOpers); }) @@ -507,13 +507,16 @@ class TargetRewrite : public TargetRewriteBase { } } }) - .template Case([&](fir::ComplexType cmplx) { + .template Case([&](fir::ComplexType cmplx) { rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); }) .template Case([&](mlir::ComplexType cmplx) { rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); }) - .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); + .Default([&](mlir::Type ty) { + newInTys.push_back(ty); + newOpers.push_back(oper); + }); } newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); newOpers.insert(newOpers.end(), trailingOpers.begin(), trailingOpers.end()); @@ -565,7 +568,7 @@ class TargetRewrite : public TargetRewriteBase { llvm::SmallVector newInTys; for (mlir::Type ty : addrTy.getResults()) { llvm::TypeSwitch(ty) - .Case([&](fir::ComplexType ty) { + .Case([&](fir::ComplexType ty) { lowerComplexSignatureRes(ty, newResTys, newInTys); }) .Case([&](mlir::ComplexType ty) { @@ -588,8 +591,9 @@ class TargetRewrite : public TargetRewriteBase { } } }) - .Case( - [&](fir::ComplexType ty) { lowerComplexSignatureArg(ty, newInTys); }) + .Case([&](fir::ComplexType ty) { + lowerComplexSignatureArg(ty, newInTys); + }) .Case([&](mlir::ComplexType ty) { lowerComplexSignatureArg(ty, newInTys); }) @@ -648,7 +652,7 @@ class TargetRewrite : public TargetRewriteBase { // Convert return value(s) for (auto ty : funcTy.getResults()) llvm::TypeSwitch(ty) - .Case([&](fir::ComplexType cmplx) { + .Case([&](fir::ComplexType cmplx) { if (noComplexConversion) newResTys.push_back(cmplx); else @@ -697,7 +701,7 @@ class TargetRewrite : public TargetRewriteBase { } } }) - .Case([&](fir::ComplexType cmplx) { + .Case([&](fir::ComplexType cmplx) { if (noComplexConversion) newInTys.push_back(cmplx); else diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index da8ba2bcd3a8a..c4602ac5dcc84 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -264,7 +264,7 @@ static mlir::LogicalResult convertFortranSourceToMLIR( pm.addPass(std::make_unique()); pm.addPass(mlir::createCanonicalizerPass()); pm.addPass(fir::createCSEPass()); - pm.addPass(fir::createPromoteToAffinePass()); + // pm.addPass(fir::createPromoteToAffinePass()); pm.addPass(fir::createFirToCfgPass()); pm.addPass(fir::createControlFlowLoweringPass()); pm.addPass(mlir::createLowerToCFGPass()); From ab67be3a7cdebdd3e11d3289fe1e105acddc6082 Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 31 Aug 2020 13:36:47 -0700 Subject: [PATCH 0240/1017] Turn on the assertion to check that the Value bound to a Symbol in the lowering symbol table has a legal type. Corrects a number of bugs associated with fixing the symbol table, etc. --- flang/include/flang/Evaluate/expression.h | 8 +- flang/include/flang/Lower/Support/BoxValue.h | 25 ++++-- .../include/flang/Optimizer/Support/Matcher.h | 34 ++++++++ flang/lib/Lower/ConvertExpr.cpp | 42 +++++----- flang/lib/Lower/SymbolMap.h | 14 ++++ flang/test/Lower/stmt-function.f90 | 83 ++++++++++--------- 6 files changed, 137 insertions(+), 69 deletions(-) create mode 100644 flang/include/flang/Optimizer/Support/Matcher.h diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h index 8fdeb45024d8f..b349be24f72c0 100644 --- a/flang/include/flang/Evaluate/expression.h +++ b/flang/include/flang/Evaluate/expression.h @@ -26,6 +26,7 @@ #include "flang/Common/indirection.h" #include "flang/Common/template.h" #include "flang/Parser/char-block.h" +#include "llvm/Support/Compiler.h" #include #include #include @@ -93,6 +94,9 @@ template class ExpressionBase { std::optional GetType() const; int Rank() const; std::string AsFortran() const; + LLVM_DUMP_METHOD void dump() const { + llvm::errs() << "Ev::Expr is <{" << AsFortran() << "}>\n"; + } llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; static Derived Rewrite(FoldingContext &, Derived &&); }; @@ -129,8 +133,8 @@ class Operation { public: CLASS_BOILERPLATE(Operation) - explicit Operation(const Expr &...x) : operand_{x...} {} - explicit Operation(Expr &&...x) : operand_{std::move(x)...} {} + explicit Operation(const Expr &... x) : operand_{x...} {} + explicit Operation(Expr &&... x) : operand_{std::move(x)...} {} Derived &derived() { return *static_cast(this); } const Derived &derived() const { return *static_cast(this); } diff --git a/flang/include/flang/Lower/Support/BoxValue.h b/flang/include/flang/Lower/Support/BoxValue.h index db109db196c26..9521062d32c08 100644 --- a/flang/include/flang/Lower/Support/BoxValue.h +++ b/flang/include/flang/Lower/Support/BoxValue.h @@ -14,6 +14,7 @@ #define LOWER_SUPPORT_BOXVALUE_H #include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/Matcher.h" #include "mlir/IR/Value.h" #include "llvm/ADT/SmallVector.h" #include "llvm/Support/Compiler.h" @@ -53,8 +54,8 @@ class AbstractBox { public: AbstractBox() = delete; AbstractBox(mlir::Value addr) : addr{addr} { - // FIXME: enable the assert! - // assert(fir::isa_passbyref_type(addr.getType())); + assert(isa_passbyref_type(addr.getType()) && + "box values must be references"); } /// An abstract box always contains a memory reference to a value. @@ -219,17 +220,25 @@ ExtendedValue substBase(const ExtendedValue &exv, mlir::Value base); /// example, an entity may have an address in memory that contains its value(s) /// as well as various attribute values that describe the shape and starting /// indices if it is an array entity. -class ExtendedValue { +class ExtendedValue : public details::matcher { public: + using VT = std::variant; + template constexpr ExtendedValue(A &&box) : box{std::forward(box)} {} + template + constexpr const A *getBoxOf() const { + return std::get_if(&box); + } + constexpr const CharBoxValue *getCharBox() const { - return std::get_if(&box); + return getBoxOf(); } constexpr const UnboxedValue *getUnboxed() const { - return std::get_if(&box); + return getBoxOf(); } /// LLVM style debugging of extended values @@ -241,10 +250,10 @@ class ExtendedValue { friend mlir::Value getLen(const ExtendedValue &exv); friend ExtendedValue substBase(const ExtendedValue &exv, mlir::Value base); + const VT &matchee() const { return box; } + private: - std::variant - box; + VT box; }; } // namespace fir diff --git a/flang/include/flang/Optimizer/Support/Matcher.h b/flang/include/flang/Optimizer/Support/Matcher.h new file mode 100644 index 0000000000000..e8b62ae7f37e0 --- /dev/null +++ b/flang/include/flang/Optimizer/Support/Matcher.h @@ -0,0 +1,34 @@ +//===-- Optimizer/Support/Matcher.h -----------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#ifndef OPTIMIZER_SUPPORT_MATCHER_H +#define OPTIMIZER_SUPPORT_MATCHER_H + +#include + +// Boilerplate CRTP class for a simplified type-casing syntactic sugar. +namespace fir::details { +// clang-format off +template struct matches : Ts... { using Ts::operator()...; }; +template matches(Ts...) -> matches; +template struct matcher { + template auto match(Ts... ts) { + return std::visit(matches{ts...}, static_cast(this)->matchee()); + } + template auto match(Ts... ts) const { + return std::visit(matches{ts...}, static_cast(this)->matchee()); + } +}; +// clang-format on +} // namespace fir::details + +#endif // OPTIMIZER_SUPPORT_MATCHER_H diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 9c0de546492fe..de27c7b9dc16b 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -844,6 +844,8 @@ class ExprLowering { &con) { // TODO: // - derived type constant + // ?? derived type cannot match the above template, can it? looks like it + // would have to be Constant> instead if (con.Rank() > 0) return genArrayLit(con); auto opt = con.GetScalarValue(); @@ -1263,16 +1265,16 @@ class ExprLowering { return std::visit([&](const auto &x) { return genval(x); }, des.u); } - // call a function template - fir::ExtendedValue gen(const Fortran::evaluate::FunctionRef &funRef) { - TODO(); - } - template - fir::ExtendedValue genval(const Fortran::evaluate::FunctionRef &funRef) { - TODO(); // Derived type functions (user + intrinsics) + fir::ExtendedValue gen(const Fortran::evaluate::FunctionRef &func) { + auto resTy = converter.genType(*func.proc().GetSymbol()); + auto retVal = genProcedureRef(func, llvm::ArrayRef{resTy}); + auto mem = builder.create(getLoc(), resTy); + builder.create(getLoc(), fir::getBase(retVal), mem); + return mem.getResult(); } + /// Generate a call to an intrinsic function. fir::ExtendedValue genIntrinsicRef(const Fortran::evaluate::ProcedureRef &procRef, const Fortran::evaluate::SpecificIntrinsic &intrinsic, @@ -1289,11 +1291,10 @@ class ExprLowering { // lowering facility should control argument lowering. for (const auto &arg : procRef.arguments()) { if (auto *expr = Fortran::evaluate::UnwrapExpr< - Fortran::evaluate::Expr>(arg)) { + Fortran::evaluate::Expr>(arg)) operands.emplace_back(genval(*expr)); - } else { - operands.emplace_back(mlir::Value{}); // absent optional - } + else + operands.emplace_back(fir::UnboxedValue{}); // absent optional } // Let the intrinsic library lower the intrinsic procedure call llvm::StringRef name = intrinsic.name; @@ -1340,15 +1341,9 @@ class ExprLowering { // allowed, probably because nobody thought of restricting this usage. // gfortran/ifort compiles this. assert(expr && "assumed type used as statement function argument"); - auto argVal = genval(*expr); - if (auto *charBox = argVal.getCharBox()) { - symMap.addCharSymbol(dummySymbol, charBox->getBuffer(), - charBox->getLen()); - } else { - // As per Fortran 2018 C1580, statement function arguments can only be - // scalars, so just pass the base address. - symMap.addSymbol(dummySymbol, fir::getBase(argVal)); - } + // As per Fortran 2018 C1580, statement function arguments can only be + // scalars, so just pass the box with the address. + symMap.addSymbol(dummySymbol, genExtAddr(*expr)); } auto result = genval(details.stmtFunction().value()); LLVM_DEBUG(llvm::errs() << "stmt-function: " << result << '\n'); @@ -1565,7 +1560,12 @@ class ExprLowering { if constexpr (inRefSet>) { return gen(a); } else { - llvm_unreachable("expression error"); + // Since `a` is not itself a valid referent, determine its value and + // create a temporary location for referencing. + auto val = fir::getBase(genval(a)); + auto mem = builder.create(getLoc(), val.getType()); + builder.create(getLoc(), val, mem); + return mem.getResult(); } } diff --git a/flang/lib/Lower/SymbolMap.h b/flang/lib/Lower/SymbolMap.h index 30da502f9793f..135e77e3a9dd9 100644 --- a/flang/lib/Lower/SymbolMap.h +++ b/flang/lib/Lower/SymbolMap.h @@ -172,6 +172,20 @@ struct SymbolBox { /// etc. class SymMap { public: + /// Add an extended value to the symbol table. + void addSymbol(semantics::SymbolRef sym, const fir::ExtendedValue &ext, + bool force = false) { + ext.match([&](const fir::UnboxedValue &v) { addSymbol(sym, v, force); }, + [&](const fir::CharBoxValue &v) { makeSym(sym, v, force); }, + [&](const fir::ArrayBoxValue &v) { makeSym(sym, v, force); }, + [&](const fir::CharArrayBoxValue &v) { makeSym(sym, v, force); }, + [&](const fir::BoxValue &v) { makeSym(sym, v, force); }, + [](auto) { + llvm::report_fatal_error( + "box value should not be added to symbol table"); + }); + } + /// Add a trivial symbol mapping to an address. void addSymbol(semantics::SymbolRef sym, mlir::Value value, bool force = false) { diff --git a/flang/test/Lower/stmt-function.f90 b/flang/test/Lower/stmt-function.f90 index 7912fbbaeb0b8..9c62798c47a7f 100644 --- a/flang/test/Lower/stmt-function.f90 +++ b/flang/test/Lower/stmt-function.f90 @@ -3,19 +3,19 @@ ! Test statement function lowering ! Simple case -!CHECK-LABEL: func @_QPtest_stmt_0(%arg0: !fir.ref) -> f32 +! CHECK-LABEL: func @_QPtest_stmt_0(%arg0: !fir.ref) -> f32 real function test_stmt_0(x) real :: x, func, arg func(arg) = arg + 0.123456 - !CHECK: %[[x:.*]] = fir.load %arg0 - !CHECK: %[[cst:.*]] = constant 1.234560e-01 - !CHECK: %[[eval:.*]] = fir.addf %[[x]], %[[cst]] - !CHECK: fir.store %[[eval]] to %[[resmem:.*]] : !fir.ref + ! CHECK: %[[x:.*]] = fir.load %arg0 + ! CHECK: %[[cst:.*]] = constant 1.234560e-01 + ! CHECK: %[[eval:.*]] = fir.addf %[[x]], %[[cst]] + ! CHECK: fir.store %[[eval]] to %[[resmem:.*]] : !fir.ref test_stmt_0 = func(x) - !CHECK: %[[res:.*]] = fir.load %[[resmem]] - !CHECK: return %[[res]] + ! CHECK: %[[res:.*]] = fir.load %[[resmem]] + ! CHECK: return %[[res]] end function ! Check this is not lowered as a simple macro: e.g. argument is only @@ -25,8 +25,13 @@ real function test_stmt_0(x) real(4) function test_stmt_only_eval_arg_once() real(4) :: only_once, x1 func(x1) = x1 + x1 - !CHECK: %[[x1:.*]] = fir.call @_QPonly_once() - !CHECK: fir.addf %[[x1]], %[[x1]] + ! CHECK: %[[x1:.*]] = fir.call @_QPonly_once() + ! Note: using -emit-fir, so the faked pass-by-reference is exposed + ! CHECK: %[[x2:.*]] = fir.alloca f32 + ! CHECK: fir.store %[[x1]] to %[[x2]] + ! CHECK-DAG: %[[x3:.*]] = fir.load %[[x2]] + ! CHECK-DAG: %[[x4:.*]] = fir.load %[[x2]] + ! CHECK: fir.addf %[[x3]], %[[x4]] test_stmt_only_eval_arg_once = func(only_once()) end function @@ -38,45 +43,47 @@ real function test_stmt_1(x, a) real :: res1, res2 func1(arg1) = a + foo(arg1) func2(arg2) = func1(arg2) + b - !CHECK-DAG: %[[bmem:.*]] = fir.alloca f32 {name = "b"} - !CHECK-DAG: %[[res1:.*]] = fir.alloca f32 {name = "res1"} - !CHECK-DAG: %[[res2:.*]] = fir.alloca f32 {name = "res2"} + ! CHECK-DAG: %[[bmem:.*]] = fir.alloca f32 {name = "b"} + ! CHECK-DAG: %[[res1:.*]] = fir.alloca f32 {name = "res1"} + ! CHECK-DAG: %[[res2:.*]] = fir.alloca f32 {name = "res2"} b = 5 - !CHECK-DAG: %[[cst_8:.*]] = constant 8.000000e+00 - !CHECK-DAG: fir.store %[[cst_8]] to %[[tmp1:.*]] : !fir.ref - !CHECK-DAG: %[[foocall1:.*]] = fir.call @_QPfoo(%[[tmp1]]) - !CHECK-DAG: %[[aload1:.*]] = fir.load %arg1 - !CHECK: %[[add1:.*]] = fir.addf %[[aload1]], %[[foocall1]] - !CHECK: fir.store %[[add1]] to %[[res1]] + ! CHECK-DAG: %[[cst_8:.*]] = constant 8.000000e+00 + ! CHECK-DAG: fir.store %[[cst_8]] to %[[tmp1:.*]] : !fir.ref + ! CHECK-DAG: %[[foocall1:.*]] = fir.call @_QPfoo(%[[tmp1]]) + ! CHECK-DAG: %[[aload1:.*]] = fir.load %arg1 + ! CHECK: %[[add1:.*]] = fir.addf %[[aload1]], %[[foocall1]] + ! CHECK: fir.store %[[add1]] to %[[res1]] res1 = func1(8.) - !CHECK-DAG: %[[x:.*]] = fir.load %arg0 - !CHECK-DAG: fir.store %[[x]] to %[[tmp2:.*]] : !fir.ref - !CHECK-DAG: %[[foocall2:.*]] = fir.call @_QPfoo(%[[tmp2]]) - !CHECK-DAG: %[[aload2:.*]] = fir.load %arg1 - !CHECK-DAG: %[[add2:.*]] = fir.addf %[[aload2]], %[[foocall2]] - !CHECK-DAG: %[[b:.*]] = fir.load %[[bmem]] - !CHECK: %[[add3:.*]] = fir.addf %[[add2]], %[[b]] - !CHECK: fir.store %[[add3]] to %[[res2]] + ! CHECK-DAG: %[[a2:.*]] = fir.load %arg1 + ! CHECK-DAG: %[[foocall2:.*]] = fir.call @_QPfoo(%arg0) + ! CHECK-DAG: %[[add2:.*]] = fir.addf %[[a2]], %[[foocall2]] + ! CHECK-DAG: %[[b:.*]] = fir.load %[[bmem]] + ! CHECK: %[[add3:.*]] = fir.addf %[[add2]], %[[b]] + ! CHECK: fir.store %[[add3]] to %[[res2]] res2 = func2(x) + ! CHECK-DAG: %[[res12:.*]] = fir.load %[[res1]] + ! CHECK-DAG: %[[res22:.*]] = fir.load %[[res2]] + ! CHECK: = fir.addf %[[res12]], %[[res22]] : f32 test_stmt_1 = res1 + res2 + ! CHECK: return %{{.*}} : f32 end function ! Test statement functions with no argument. ! Test that they are not pre-evaluated. -!CHECK-LABEL: func @_QPtest_stmt_no_args +! CHECK-LABEL: func @_QPtest_stmt_no_args real function test_stmt_no_args(x, y) func() = x + y - !CHECK: fir.addf + ! CHECK: fir.addf a = func() - !CHECK: fir.call @_QPfoo_may_modify_xy + ! CHECK: fir.call @_QPfoo_may_modify_xy call foo_may_modify_xy(x, y) - !CHECK: fir.addf - !CHECK: fir.addf + ! CHECK: fir.addf + ! CHECK: fir.addf test_stmt_no_args = func() + a end function @@ -85,15 +92,15 @@ real function test_stmt_no_args(x, y) integer function test_stmt_character(c, j) integer :: i, j, func, argj character(10) :: c, argc - !CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : - !CHECK-DAG: %[[c10:.*]] = constant 10 : - !CHECK: %[[c:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10]] + ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : + ! CHECK-DAG: %[[c10:.*]] = constant 10 : + ! CHECK: %[[c:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10]] func(argc, argj) = len_trim(argc, 4) + argj - !CHECK-DAG: %[[j:.*]] = fir.load %arg1 - !CHECK-DAG: %[[c4:.*]] = constant 4 : - !CHECK-DAG: %[[len_trim:.*]] = fir.call @fir.len_trim.i32.bc1.i32(%[[c]], %[[c4]]) - !CHECK: addi %[[len_trim]], %[[j]] + ! CHECK-DAG: %[[j:.*]] = fir.load %arg1 + ! CHECK-DAG: %[[c4:.*]] = constant 4 : + ! CHECK-DAG: %[[len_trim:.*]] = fir.call @fir.len_trim.i32.bc1.i32(%[[c]], %[[c4]]) + ! CHECK: addi %[[len_trim]], %[[j]] test_stmt_character = func(c, j) end function From d98250decd4ef773cac7f48be2932ba094e0bda1 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 1 Sep 2020 13:34:47 -0700 Subject: [PATCH 0241/1017] rebase fallout: - changes made to tco in llvm-project failed to load any dialects - integrate with Ev::Expr change modify test to pass when g++ is the build compiler --- flang/include/flang/Lower/Bridge.h | 6 ++++-- flang/lib/Lower/Bridge.cpp | 11 ++++++----- flang/lib/Lower/ConvertExpr.cpp | 3 +-- flang/lib/Optimizer/Transforms/MemDataFlowOpt.cpp | 2 ++ flang/test/Lower/stmt-function.f90 | 15 +++++---------- flang/tools/bbc/bbc.cpp | 13 +++++++------ flang/unittests/Lower/RTBuilder.cpp | 2 +- 7 files changed, 26 insertions(+), 26 deletions(-) diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h index e724a2f338587..a8412448659e3 100644 --- a/flang/include/flang/Lower/Bridge.h +++ b/flang/include/flang/Lower/Bridge.h @@ -45,7 +45,8 @@ class LoweringBridge { public: /// Create a lowering bridge instance. static LoweringBridge - create(const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, + create(mlir::MLIRContext &ctx, + const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, const Fortran::parser::AllCookedSources &allCooked) { return LoweringBridge{defaultKinds, intrinsics, allCooked}; @@ -55,7 +56,7 @@ class LoweringBridge { // Getters //===--------------------------------------------------------------------===// - mlir::MLIRContext &getMLIRContext() { return *context.get(); } + mlir::MLIRContext &getMLIRContext() { return context; } mlir::ModuleOp &getModule() { return *module.get(); } const Fortran::common::IntrinsicTypeDefaultKinds &getDefaultKinds() const { return defaultKinds; @@ -89,6 +90,7 @@ class LoweringBridge { private: explicit LoweringBridge( + mlir::MLIRContext &ctx, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, const Fortran::parser::AllCookedSources &); diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 864e18a4fde3d..afebacd2d6014 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2445,18 +2445,19 @@ void Fortran::lower::LoweringBridge::lower( } void Fortran::lower::LoweringBridge::parseSourceFile(llvm::SourceMgr &srcMgr) { - auto owningRef = mlir::parseSourceFile(srcMgr, context.get()); + auto owningRef = mlir::parseSourceFile(srcMgr, &context); module.reset(new mlir::ModuleOp(owningRef.get().getOperation())); owningRef.release(); } Fortran::lower::LoweringBridge::LoweringBridge( + mlir::MLIRContext &ctx, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, const Fortran::parser::CookedSource &cooked) - : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked}, - context{std::make_unique()}, kindMap{context.get()} { - context.get()->getDiagEngine().registerHandler([](mlir::Diagnostic &diag) { + : defaultKinds{defaultKinds}, + intrinsics{intrinsics}, cooked{&cooked}, context{ctx}, kindMap{&ctx} { + context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) { auto &os = llvm::errs(); switch (diag.getSeverity()) { case mlir::DiagnosticSeverity::Error: @@ -2478,5 +2479,5 @@ Fortran::lower::LoweringBridge::LoweringBridge( return mlir::success(); }); module = std::make_unique( - mlir::ModuleOp::create(mlir::UnknownLoc::get(context.get()))); + mlir::ModuleOp::create(mlir::UnknownLoc::get(&context))); } diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index de27c7b9dc16b..83432021b1350 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -412,8 +412,7 @@ class ExprLowering { return res; } - template - fir::ExtendedValue genval(const Fortran::evaluate::TypeParamInquiry &) { + fir::ExtendedValue genval(const Fortran::evaluate::TypeParamInquiry &) { TODO(); } diff --git a/flang/lib/Optimizer/Transforms/MemDataFlowOpt.cpp b/flang/lib/Optimizer/Transforms/MemDataFlowOpt.cpp index 136ada8fbc409..54e37ce0c1cf1 100644 --- a/flang/lib/Optimizer/Transforms/MemDataFlowOpt.cpp +++ b/flang/lib/Optimizer/Transforms/MemDataFlowOpt.cpp @@ -34,6 +34,7 @@ getParentOpsWithTrait(mlir::Operation *op) { return parentLoops; } +#if 0 unsigned getNumCommonSurroundingOps( const llvm::SmallVectorImpl OpsA, const llvm::SmallVectorImpl OpsB) { @@ -46,6 +47,7 @@ unsigned getNumCommonSurroundingOps( } return numCommonOps; } +#endif /// This is based on MLIR's MemRefDataFlowOpt which is specialized on AffineRead /// and AffineWrite interface diff --git a/flang/test/Lower/stmt-function.f90 b/flang/test/Lower/stmt-function.f90 index 9c62798c47a7f..f86e655e2c4fd 100644 --- a/flang/test/Lower/stmt-function.f90 +++ b/flang/test/Lower/stmt-function.f90 @@ -8,8 +8,8 @@ real function test_stmt_0(x) real :: x, func, arg func(arg) = arg + 0.123456 - ! CHECK: %[[x:.*]] = fir.load %arg0 - ! CHECK: %[[cst:.*]] = constant 1.234560e-01 + ! CHECK-DAG: %[[x:.*]] = fir.load %arg0 + ! CHECK-DAG: %[[cst:.*]] = constant 1.234560e-01 ! CHECK: %[[eval:.*]] = fir.addf %[[x]], %[[cst]] ! CHECK: fir.store %[[eval]] to %[[resmem:.*]] : !fir.ref test_stmt_0 = func(x) @@ -21,7 +21,7 @@ real function test_stmt_0(x) ! Check this is not lowered as a simple macro: e.g. argument is only ! evaluated once even if it appears in several placed inside the ! statement function expression - +! CHECK-LABEL: func @_QPtest_stmt_only_eval_arg_once() -> f32 real(4) function test_stmt_only_eval_arg_once() real(4) :: only_once, x1 func(x1) = x1 + x1 @@ -29,9 +29,7 @@ real(4) function test_stmt_only_eval_arg_once() ! Note: using -emit-fir, so the faked pass-by-reference is exposed ! CHECK: %[[x2:.*]] = fir.alloca f32 ! CHECK: fir.store %[[x1]] to %[[x2]] - ! CHECK-DAG: %[[x3:.*]] = fir.load %[[x2]] - ! CHECK-DAG: %[[x4:.*]] = fir.load %[[x2]] - ! CHECK: fir.addf %[[x3]], %[[x4]] + ! CHECK: fir.addf %{{.*}}, %{{.*}} test_stmt_only_eval_arg_once = func(only_once()) end function @@ -97,10 +95,7 @@ integer function test_stmt_character(c, j) ! CHECK: %[[c:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10]] func(argc, argj) = len_trim(argc, 4) + argj - ! CHECK-DAG: %[[j:.*]] = fir.load %arg1 - ! CHECK-DAG: %[[c4:.*]] = constant 4 : - ! CHECK-DAG: %[[len_trim:.*]] = fir.call @fir.len_trim.i32.bc1.i32(%[[c]], %[[c4]]) - ! CHECK: addi %[[len_trim]], %[[j]] + ! CHECK: addi %{{.*}}, %{{.*}} : i test_stmt_character = func(c, j) end function diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index c4602ac5dcc84..65e8d69a79c3e 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -154,7 +154,7 @@ static mlir::LogicalResult convertFortranSourceToMLIR( if (!(fixedForm || freeForm)) { auto dot = path.rfind("."); if (dot != std::string::npos) { - std::string suffix{path.substr(dot + 1)}; + std::string suffix = path.substr(dot + 1); options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff"; } } @@ -198,7 +198,7 @@ static mlir::LogicalResult convertFortranSourceToMLIR( } // run semantics - auto &parseTree{*parsing.parseTree()}; + auto &parseTree = *parsing.parseTree(); Fortran::semantics::Semantics semantics{semanticsContext, parseTree, parsing.cooked()}; semantics.Perform(); @@ -211,7 +211,7 @@ static mlir::LogicalResult convertFortranSourceToMLIR( semantics.DumpSymbols(llvm::outs()); if (pftDumpTest) { - if (auto ast{Fortran::lower::createPFT(parseTree, semanticsContext)}) { + if (auto ast = Fortran::lower::createPFT(parseTree, semanticsContext)) { Fortran::lower::dumpPFT(llvm::outs(), *ast); return mlir::success(); } @@ -222,12 +222,14 @@ static mlir::LogicalResult convertFortranSourceToMLIR( // translate to FIR dialect of MLIR llvm::Triple triple(fir::determineTargetTriple(targetTriple)); fir::NameUniquer nameUniquer; + mlir::MLIRContext ctx; + fir::registerAndLoadDialects(ctx); auto burnside = Fortran::lower::LoweringBridge::create( - semanticsContext.defaultKinds(), semanticsContext.intrinsics(), + ctx, semanticsContext.defaultKinds(), semanticsContext.intrinsics(), parsing.cooked()); burnside.lower(parseTree, nameUniquer, semanticsContext); mlir::ModuleOp mlirModule = burnside.getModule(); - fir::KindMapping kindMap(mlirModule.getContext()); + fir::KindMapping kindMap(&ctx); fir::setTargetTriple(mlirModule, triple); fir::setNameUniquer(mlirModule, nameUniquer); fir::setKindMapping(mlirModule, kindMap); @@ -303,7 +305,6 @@ static mlir::LogicalResult convertFortranSourceToMLIR( } int main(int argc, char **argv) { - fir::registerFIR(); fir::registerFIRPasses(); fir::registerOptPasses(); [[maybe_unused]] llvm::InitLLVM y(argc, argv); diff --git a/flang/unittests/Lower/RTBuilder.cpp b/flang/unittests/Lower/RTBuilder.cpp index f68cf9844c9b8..159d4bea5587d 100644 --- a/flang/unittests/Lower/RTBuilder.cpp +++ b/flang/unittests/Lower/RTBuilder.cpp @@ -21,8 +21,8 @@ c_float_complex_t c99_cacosf(c_float_complex_t); TEST(RTBuilderTest, ComplexRuntimeInterface) { - fir::registerFIR(); mlir::MLIRContext ctx; + fir::registerAndLoadDialects(ctx); mlir::Type c99_cacosf_signature{ Fortran::lower::RuntimeTableKey::getTypeModel()( &ctx)}; From 2fa11d3446e81594995b9155fc77cbd2fabe83b0 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 2 Sep 2020 10:12:20 -0700 Subject: [PATCH 0242/1017] Move the OpenACC related tests to expected fail list for now. --- flang/test/Lower/OpenACC/acc-loop.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/flang/test/Lower/OpenACC/acc-loop.f90 b/flang/test/Lower/OpenACC/acc-loop.f90 index 9038454032967..2b584e60c884d 100644 --- a/flang/test/Lower/OpenACC/acc-loop.f90 +++ b/flang/test/Lower/OpenACC/acc-loop.f90 @@ -1,6 +1,7 @@ ! This test checks lowering of OpenACC loop directive. ! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s +! XFAIL: * program acc_loop From 9ec9c3d57ff621ead9d93c8553025a140c11965b Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Wed, 2 Sep 2020 14:41:14 -0400 Subject: [PATCH 0243/1017] [flang][openacc] Fix acc.loop lowering + re-activate tests --- flang/test/Lower/OpenACC/acc-loop.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/flang/test/Lower/OpenACC/acc-loop.f90 b/flang/test/Lower/OpenACC/acc-loop.f90 index 2b584e60c884d..9038454032967 100644 --- a/flang/test/Lower/OpenACC/acc-loop.f90 +++ b/flang/test/Lower/OpenACC/acc-loop.f90 @@ -1,7 +1,6 @@ ! This test checks lowering of OpenACC loop directive. ! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s -! XFAIL: * program acc_loop From 9b60823c747ed4bf555857a1f878b0bf9dec1408 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 2 Sep 2020 15:01:44 -0700 Subject: [PATCH 0244/1017] revert the assert in AbstractBox for the moment --- flang/include/flang/Lower/Support/BoxValue.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/include/flang/Lower/Support/BoxValue.h b/flang/include/flang/Lower/Support/BoxValue.h index 9521062d32c08..5ec50105e90ea 100644 --- a/flang/include/flang/Lower/Support/BoxValue.h +++ b/flang/include/flang/Lower/Support/BoxValue.h @@ -54,8 +54,8 @@ class AbstractBox { public: AbstractBox() = delete; AbstractBox(mlir::Value addr) : addr{addr} { - assert(isa_passbyref_type(addr.getType()) && - "box values must be references"); + //assert(isa_passbyref_type(addr.getType()) && + // "box values must be references"); } /// An abstract box always contains a memory reference to a value. From cac787adccabc5d2fb2289ea8318dcbf83a925cc Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 2 Sep 2020 14:00:18 -0700 Subject: [PATCH 0245/1017] - thread default kinds to code gen - fix some bugs - some work on furthering support of descriptors for "F77" I/O --- flang/include/flang/Lower/Bridge.h | 19 +++++++--- flang/include/flang/Lower/CharacterExpr.h | 17 ++++++++- flang/lib/Lower/Bridge.cpp | 22 ++++++++---- flang/lib/Lower/CharacterExpr.cpp | 43 +++++++++++++++++++---- flang/tools/bbc/bbc.cpp | 38 ++++++++++++++------ 5 files changed, 111 insertions(+), 28 deletions(-) diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h index a8412448659e3..af31b95ed1083 100644 --- a/flang/include/flang/Lower/Bridge.h +++ b/flang/include/flang/Lower/Bridge.h @@ -18,6 +18,13 @@ #include "flang/Optimizer/Support/KindMapping.h" #include "mlir/IR/BuiltinOps.h" +namespace fir { +struct NameUniquer; +} +namespace llvm { +class Triple; +} + namespace Fortran { namespace common { class IntrinsicTypeDefaultKinds; @@ -48,8 +55,11 @@ class LoweringBridge { create(mlir::MLIRContext &ctx, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, - const Fortran::parser::AllCookedSources &allCooked) { - return LoweringBridge{defaultKinds, intrinsics, allCooked}; + const Fortran::parser::AllCookedSource &allCooked, + llvm::Triple &triple, fir::NameUniquer &uniquer, + fir::KindMapping &kindMap) { + return LoweringBridge(ctx, defaultKinds, intrinsics, allCooked, triple, + uniquer, kindMap); } //===--------------------------------------------------------------------===// @@ -93,7 +103,8 @@ class LoweringBridge { mlir::MLIRContext &ctx, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, - const Fortran::parser::AllCookedSources &); + const Fortran::parser::AllCookedSource &cooked, llvm::Triple &triple, + fir::NameUniquer &uniquer, fir::KindMapping &kindMap); LoweringBridge() = delete; LoweringBridge(const LoweringBridge &) = delete; @@ -102,7 +113,7 @@ class LoweringBridge { const Fortran::parser::AllCookedSources *cooked; std::unique_ptr context; std::unique_ptr module; - fir::KindMapping kindMap; + fir::KindMapping &kindMap; }; } // namespace lower diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index 58c9f5c57f153..57ea893003b54 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #ifndef FORTRAN_LOWER_CHARACTEREXPR_H #define FORTRAN_LOWER_CHARACTEREXPR_H @@ -107,7 +111,10 @@ class CharacterExprHelper { static bool isCharacter(mlir::Type type); /// Extract the kind of a character type - static int getCharacterKind(mlir::Type type); + static fir::KindTy getCharacterKind(mlir::Type type); + + /// Extract the kind of a character or array of character type. + static fir::KindTy getCharacterOrSequenceKind(mlir::Type type); /// Determine the base character type static fir::CharacterType getCharacterType(mlir::Type type); @@ -130,6 +137,14 @@ class CharacterExprHelper { fir::ExtendedValue toExtendedValue(mlir::Value character, mlir::Value len = {}); + /// Is `type` a sequence (array) of CHARACTER type? Return true for any of the + /// following cases: + /// - !fir.array> + /// - !fir.array> + /// - !fir.ref where T is either of the first two cases + /// - !fir.box where T is either of the first two cases + static bool isArray(mlir::Type type); + private: fir::CharBoxValue materializeValue(const fir::CharBoxValue &str); fir::CharBoxValue toDataLengthPair(mlir::Value character); diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index afebacd2d6014..b50cc1b8e0b42 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -29,6 +29,7 @@ #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Optimizer/Transforms/Passes.h" #include "flang/Parser/parse-tree.h" @@ -41,6 +42,7 @@ #include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorHandling.h" #include "llvm/Support/MD5.h" + #define DEBUG_TYPE "flang-lower-bridge" #undef TODO @@ -2435,12 +2437,12 @@ Fortran::lower::LoweringBridge::createFoldingContext() const { } void Fortran::lower::LoweringBridge::lower( - const Fortran::parser::Program &prg, fir::NameUniquer &uniquer, + const Fortran::parser::Program &prg, const Fortran::semantics::SemanticsContext &semanticsContext) { auto pft = Fortran::lower::createPFT(prg, semanticsContext); if (dumpBeforeFir) Fortran::lower::dumpPFT(llvm::errs(), *pft); - FirConverter converter{*this, uniquer}; + FirConverter converter{*this, *fir::getNameUniquer(getModule())}; converter.run(*pft); } @@ -2451,12 +2453,14 @@ void Fortran::lower::LoweringBridge::parseSourceFile(llvm::SourceMgr &srcMgr) { } Fortran::lower::LoweringBridge::LoweringBridge( - mlir::MLIRContext &ctx, + mlir::MLIRContext &context, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, - const Fortran::parser::CookedSource &cooked) - : defaultKinds{defaultKinds}, - intrinsics{intrinsics}, cooked{&cooked}, context{ctx}, kindMap{&ctx} { + const Fortran::parser::CookedSource &cooked, llvm::Triple &triple, + fir::NameUniquer &uniquer, fir::KindMapping &kindMap) + : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked}, + context{context}, kindMap{kindMap} { + // Register the diagnostic handler. context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) { auto &os = llvm::errs(); switch (diag.getSeverity()) { @@ -2478,6 +2482,12 @@ Fortran::lower::LoweringBridge::LoweringBridge( os.flush(); return mlir::success(); }); + + // Create the module and attach the attributes. module = std::make_unique( mlir::ModuleOp::create(mlir::UnknownLoc::get(&context))); + assert(module.get() && "module was not created"); + fir::setTargetTriple(*module.get(), triple); + fir::setNameUniquer(*module.get(), uniquer); + fir::setKindMapping(*module.get(), kindMap); } diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index 5c31ac2ce6a43..37423dcd3c7a5 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// #include "flang/Lower/CharacterExpr.h" #include "flang/Lower/ConvertType.h" @@ -17,15 +21,17 @@ // CharacterExprHelper implementation //===----------------------------------------------------------------------===// -/// Get fir.char type with the same kind as inside str. -fir::CharacterType -Fortran::lower::CharacterExprHelper::getCharacterType(mlir::Type type) { +template +static fir::CharacterType recoverCharacterType(mlir::Type type) { if (auto boxType = type.dyn_cast()) return boxType.getEleTy(); if (auto refType = type.dyn_cast()) type = refType.getEleTy(); if (auto seqType = type.dyn_cast()) { - assert(seqType.getShape().size() == 1 && "rank must be 1"); + // In a context where `type` may be a sequence, we want to opt out of this + // assertion by setting `checkForScalar` to `false`. + assert((!checkForScalar || seqType.getShape().size() == 1) && + "rank must be 1 for a scalar CHARACTER"); type = seqType.getEleTy(); } if (auto charType = type.dyn_cast()) @@ -33,6 +39,12 @@ Fortran::lower::CharacterExprHelper::getCharacterType(mlir::Type type) { llvm_unreachable("Invalid character value type"); } +/// Get fir.char type with the same kind as inside str. +fir::CharacterType +Fortran::lower::CharacterExprHelper::getCharacterType(mlir::Type type) { + return recoverCharacterType(type); +} + fir::CharacterType Fortran::lower::CharacterExprHelper::getCharacterType( const fir::CharBoxValue &box) { return getCharacterType(box.getBuffer().getType()); @@ -499,6 +511,25 @@ bool Fortran::lower::CharacterExprHelper::isCharacter(mlir::Type type) { return type.isa(); } -int Fortran::lower::CharacterExprHelper::getCharacterKind(mlir::Type type) { - return getCharacterType(type).getFKind(); +fir::KindTy +Fortran::lower::CharacterExprHelper::getCharacterKind(mlir::Type type) { + return recoverCharacterType(type).getFKind(); +} + +fir::KindTy Fortran::lower::CharacterExprHelper::getCharacterOrSequenceKind( + mlir::Type type) { + return recoverCharacterType(type).getFKind(); +} + +bool Fortran::lower::CharacterExprHelper::isArray(mlir::Type type) { + if (auto boxTy = type.dyn_cast()) + type = boxTy.getEleTy(); + if (auto eleTy = fir::dyn_cast_ptrEleTy(type)) + type = eleTy; + if (auto seqTy = type.dyn_cast()) { + auto charTy = seqTy.getEleTy().dyn_cast(); + assert(charTy); + return (!charTy.singleton()) || (seqTy.getDimension() > 1); + } + return false; } diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 65e8d69a79c3e..ec6958e7243fd 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -142,6 +142,22 @@ static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) { out << '\n'; } +// Translate front-end KINDs for use in the IR and code gen. +static std::vector +fromDefaultKinds(const Fortran::common::IntrinsicTypeDefaultKinds &defKinds) { + return {static_cast(defKinds.GetDefaultKind( + Fortran::common::TypeCategory::Character)), + static_cast( + defKinds.GetDefaultKind(Fortran::common::TypeCategory::Complex)), + static_cast(defKinds.doublePrecisionKind()), + static_cast( + defKinds.GetDefaultKind(Fortran::common::TypeCategory::Integer)), + static_cast( + defKinds.GetDefaultKind(Fortran::common::TypeCategory::Logical)), + static_cast( + defKinds.GetDefaultKind(Fortran::common::TypeCategory::Real))}; +} + //===----------------------------------------------------------------------===// // Translate Fortran input to FIR, a dialect of MLIR. //===----------------------------------------------------------------------===// @@ -224,24 +240,23 @@ static mlir::LogicalResult convertFortranSourceToMLIR( fir::NameUniquer nameUniquer; mlir::MLIRContext ctx; fir::registerAndLoadDialects(ctx); + auto &defKinds = semanticsContext.defaultKinds(); + fir::KindMapping kindMap( + &ctx, llvm::ArrayRef{fromDefaultKinds(defKinds)}); auto burnside = Fortran::lower::LoweringBridge::create( - ctx, semanticsContext.defaultKinds(), semanticsContext.intrinsics(), - parsing.cooked()); - burnside.lower(parseTree, nameUniquer, semanticsContext); + ctx, defKinds, semanticsContext.intrinsics(), parsing.cooked(), triple, + nameUniquer, kindMap); + burnside.lower(parseTree, semanticsContext); mlir::ModuleOp mlirModule = burnside.getModule(); - fir::KindMapping kindMap(&ctx); - fir::setTargetTriple(mlirModule, triple); - fir::setNameUniquer(mlirModule, nameUniquer); - fir::setKindMapping(mlirModule, kindMap); std::error_code ec; std::string outputName = outputFilename; if (!outputName.size()) outputName = llvm::sys::path::stem(inputFilename).str().append(".mlir"); llvm::raw_fd_ostream out(outputName, ec); - if (ec) { - llvm::errs() << "could not open output file " << outputName << '\n'; - return mlir::failure(); - } + if (ec) + return mlir::emitError(mlir::UnknownLoc::get(&ctx), + "could not open output file ") + << outputName; // Otherwise run the default passes. mlir::PassManager pm(mlirModule.getContext()); @@ -278,6 +293,7 @@ static mlir::LogicalResult convertFortranSourceToMLIR( if (emitLLVM) { // Continue to lower from MLIR down to LLVM IR. Emit LLVM and MLIR. pm.addPass(fir::createFirCodeGenRewritePass()); + pm.addPass(fir::createFirTargetRewritePass()); pm.addPass(fir::createFIRToLLVMPass(nameUniquer)); std::error_code ec; llvm::ToolOutputFile outFile(outputName + ".ll", ec, From e3b67da4adc83c7a08fe9d6e49547f787947e325 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 3 Sep 2020 13:23:48 -0700 Subject: [PATCH 0246/1017] fix the driver so the test passes --- ...end-to-end-character-assignment-driver.cpp | 94 +++++++------------ 1 file changed, 33 insertions(+), 61 deletions(-) diff --git a/flang/test/Lower/end-to-end-character-assignment-driver.cpp b/flang/test/Lower/end-to-end-character-assignment-driver.cpp index e5b324bd19cca..6bbd6675abf53 100644 --- a/flang/test/Lower/end-to-end-character-assignment-driver.cpp +++ b/flang/test/Lower/end-to-end-character-assignment-driver.cpp @@ -26,16 +26,8 @@ struct Fchar { LenT len; }; -template using SubF18 = void (*)(Fchar, Fchar, T...); -template -using SubF77 = void (*)(char *, char *, T..., LenT, LenT); -template -void CallSubroutine(SubF18 f, Fchar s1, Fchar s2, T... args) { - f(s1, s2, args...); -} - -template -void CallSubroutine(SubF77 f, Fchar s1, Fchar s2, T... args) { +template +void CallSubroutine(F f, Fchar s1, Fchar s2, T... args) { f(s1.data, s2.data, args..., s1.len, s2.len); } @@ -113,29 +105,9 @@ bool Check(const FcharData &test, const FcharData &ref, return true; } -// Call compiled test subroutine and compare variable afterwards with a -// reference. Compare against result from reference subroutine. -template -bool TestSubroutine(const std::string &testName, SubF18 fooTest, - SubF18 fooRef, const FcharData &s1, const FcharData &s2, - T... otherArgs) { - // Make copies because data may be modified - FcharData testS1{s1}, testS2{s2}; - CallSubroutine(fooTest, testS1.getFchar(), testS2.getFchar(), otherArgs...); - - // Compare against reference subroutine - FcharData refS1{s1}, refS2{s2}; - CallSubroutine(fooRef, refS1.getFchar(), refS2.getFchar(), otherArgs...); - - auto description{testName + " KIND=" + std::to_string(Kind)}; - bool result{Check(testS1, refS1, description + " s1")}; - result &= Check(testS2, refS2, description + " s2"); - return result; -} - // Compare against precomputed results. -template -bool TestSubroutine(const std::string &testName, SubF18 fooTest, +template +bool TestSubroutine(const std::string &testName, F fooTest, const FcharData &s1, const FcharData &refS1, const FcharData &s2, const FcharData &refS2, T... otherArgs) { // Make copies because data may be modified @@ -176,13 +148,13 @@ extern "C" { // CHARACTER(*, K) :: s1, s2 // s1 = s2 // END SUBROUTINE -void _QPassign1(Fchar, Fchar); -void _QPassign2(Fchar, Fchar); -void _QPassign4(Fchar, Fchar); +void _QPassign1(char *, char *, LenT, LenT); +void _QPassign2(char *, char *, LenT, LenT); +void _QPassign4(char *, char *, LenT, LenT); } template -void TestNormalAssignement(Func testedSub, int &tests, int &passed) { +void TestNormalAssignment(Func testedSub, int &tests, int &passed) { auto &s1{Inputs::s1}; auto &s2{Inputs::s2}; auto &s3{Inputs::s3}; @@ -221,13 +193,13 @@ extern "C" { // INTEGER :: lb, ub // s1(lb:ub) = s2 // END SUBROUTINE -void _QPassign_substring1(Fchar s1, Fchar s2, int *lb, int *ub); -void _QPassign_substring2(Fchar, Fchar, int *, int *); -void _QPassign_substring4(Fchar, Fchar, int *, int *); +void _QPassign_substring1(char *s1, char *s2, int *lb, int *ub, LenT, LenT); +void _QPassign_substring2(char *, char *, int *, int *, LenT, LenT); +void _QPassign_substring4(char *, char *, int *, int *, LenT, LenT); } template -void TestSubstringAssignement(Func testedSub, int &tests, int &passed) { +void TestSubstringAssignment(Func testedSub, int &tests, int &passed) { auto &s1{Inputs::s3}; auto &s2{Inputs::s1}; int lb{3}; @@ -257,13 +229,13 @@ extern "C" { // INTEGER :: lb // s1(lb:) = s2 // END SUBROUTINE -void _QPassign_overlap1(Fchar s1, Fchar s2, int *lb); -void _QPassign_overlap2(Fchar, Fchar, int *); -void _QPassign_overlap4(Fchar, Fchar, int *); +void _QPassign_overlap1(char *s1, char *s2, int *lb, LenT, LenT); +void _QPassign_overlap2(char *, char *, int *, LenT, LenT); +void _QPassign_overlap4(char *, char *, int *, LenT, LenT); } template -void TestOverlappingAssignement(Func testedSub, int &tests, int &passed) { +void TestOverlappingAssignment(Func testedSub, int &tests, int &passed) { auto &s1{Inputs::s1}; auto &s2{Inputs::s2}; int lb{2}; @@ -290,13 +262,13 @@ extern "C" { // CHARACTER(l2, K) :: s2 // s1 = s2 // END SUBROUTINE -void _QPassign_spec_expr_len1(Fchar s1, Fchar s2, int *l1, int *l2); -void _QPassign_spec_expr_len2(Fchar s1, Fchar s2, int *l1, int *l2); -void _QPassign_spec_expr_len4(Fchar s1, Fchar s2, int *l1, int *l2); +void _QPassign_spec_expr_len1(char *s1, char *s2, int *l1, int *l2, LenT, LenT); +void _QPassign_spec_expr_len2(char *s1, char *s2, int *l1, int *l2, LenT, LenT); +void _QPassign_spec_expr_len4(char *s1, char *s2, int *l1, int *l2, LenT, LenT); } template -void TestSpecExprLenAssignement(Func testedSub, int &tests, int &passed) { +void TestSpecExprLenAssignment(Func testedSub, int &tests, int &passed) { auto &s1{Inputs::s1}; auto &s2{Inputs::s2}; auto &s3{Inputs::s3}; @@ -339,7 +311,7 @@ extern "C" { // CHARACTER(*) :: s1, s2 // s2 = s1 // " another piece of string" // END SUBROUTINE -void _QPconcat1(Fchar s1, Fchar s2); +void _QPconcat1(char *s1, char *s2, LenT, LenT); } template @@ -360,21 +332,21 @@ void TestConcat(Func testedSub, int &tests, int &passed) { int main(int, char **) { int tests{0}, passed{0}; - TestNormalAssignement<1>(_QPassign1, tests, passed); - TestNormalAssignement<2>(_QPassign2, tests, passed); - TestNormalAssignement<4>(_QPassign4, tests, passed); + TestNormalAssignment<1>(_QPassign1, tests, passed); + TestNormalAssignment<2>(_QPassign2, tests, passed); + TestNormalAssignment<4>(_QPassign4, tests, passed); - TestSubstringAssignement<1>(_QPassign_substring1, tests, passed); - TestSubstringAssignement<2>(_QPassign_substring2, tests, passed); - TestSubstringAssignement<4>(_QPassign_substring4, tests, passed); + TestSubstringAssignment<1>(_QPassign_substring1, tests, passed); + TestSubstringAssignment<2>(_QPassign_substring2, tests, passed); + TestSubstringAssignment<4>(_QPassign_substring4, tests, passed); - TestOverlappingAssignement<1>(_QPassign_overlap1, tests, passed); - TestOverlappingAssignement<2>(_QPassign_overlap2, tests, passed); - TestOverlappingAssignement<4>(_QPassign_overlap4, tests, passed); + TestOverlappingAssignment<1>(_QPassign_overlap1, tests, passed); + TestOverlappingAssignment<2>(_QPassign_overlap2, tests, passed); + TestOverlappingAssignment<4>(_QPassign_overlap4, tests, passed); - TestSpecExprLenAssignement<1>(_QPassign_spec_expr_len1, tests, passed); - TestSpecExprLenAssignement<2>(_QPassign_spec_expr_len2, tests, passed); - TestSpecExprLenAssignement<4>(_QPassign_spec_expr_len4, tests, passed); + TestSpecExprLenAssignment<1>(_QPassign_spec_expr_len1, tests, passed); + TestSpecExprLenAssignment<2>(_QPassign_spec_expr_len2, tests, passed); + TestSpecExprLenAssignment<4>(_QPassign_spec_expr_len4, tests, passed); TestConcat<1>(_QPconcat1, tests, passed); From efca746fef541201bb8a7658f4e9cc8b49bb0122 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 3 Sep 2020 16:00:09 -0700 Subject: [PATCH 0247/1017] fix nullptr deref bug --- flang/lib/Lower/ConvertExpr.cpp | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 83432021b1350..d2f38af4a6e54 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1264,9 +1264,16 @@ class ExprLowering { return std::visit([&](const auto &x) { return genval(x); }, des.u); } + mlir::Type genType(const Fortran::evaluate::DynamicType &dt) { + if (dt.category() != Fortran::common::TypeCategory::Derived) + return converter.genType(dt.category(), dt.kind()); + llvm::report_fatal_error("derived types not implemented"); + } + template fir::ExtendedValue gen(const Fortran::evaluate::FunctionRef &func) { - auto resTy = converter.genType(*func.proc().GetSymbol()); + assert(func.GetType().has_value() && "function has no type"); + auto resTy = genType(*func.GetType()); auto retVal = genProcedureRef(func, llvm::ArrayRef{resTy}); auto mem = builder.create(getLoc(), resTy); builder.create(getLoc(), fir::getBase(retVal), mem); From 2245f8e0c62ba6bbc777acb725dc46ee8956651a Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Sat, 22 Aug 2020 02:50:31 -0700 Subject: [PATCH 0248/1017] Lower date_and_time intrinsic (only date for now) --- flang/include/flang/Lower/IntrinsicCall.h | 4 ++- flang/include/flang/Lower/Runtime.h | 17 ++++++++++ flang/lib/Lower/ConvertExpr.cpp | 13 +++---- flang/lib/Lower/Runtime.cpp | 32 ++++++++++++++++-- flang/runtime/CMakeLists.txt | 1 + flang/runtime/clock.cpp | 41 +++++++++++++++++++++++ flang/runtime/clock.h | 26 ++++++++++++++ 7 files changed, 124 insertions(+), 10 deletions(-) create mode 100644 flang/runtime/clock.cpp create mode 100644 flang/runtime/clock.h diff --git a/flang/include/flang/Lower/IntrinsicCall.h b/flang/include/flang/Lower/IntrinsicCall.h index 2db1bda335b53..f6aa1805939b8 100644 --- a/flang/include/flang/Lower/IntrinsicCall.h +++ b/flang/include/flang/Lower/IntrinsicCall.h @@ -10,6 +10,7 @@ #define FORTRAN_LOWER_INTRINSICCALL_H #include "flang/Lower/FIRBuilder.h" +#include "llvm/ADT/Optional.h" namespace fir { class ExtendedValue; @@ -32,7 +33,8 @@ namespace Fortran::lower { /// with arguments \p args and expected result type \p resultType. /// Returned mlir::Value is the returned Fortran intrinsic value. fir::ExtendedValue genIntrinsicCall(FirOpBuilder &, mlir::Location, - llvm::StringRef name, mlir::Type resultType, + llvm::StringRef name, + llvm::Optional resultType, llvm::ArrayRef args); /// Get SymbolRefAttr of runtime (or wrapper function containing inlined diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h index 1f8bd0f0b1d99..86652d1b93ea1 100644 --- a/flang/include/flang/Lower/Runtime.h +++ b/flang/include/flang/Lower/Runtime.h @@ -20,6 +20,19 @@ #ifndef FORTRAN_LOWER_RUNTIME_H #define FORTRAN_LOWER_RUNTIME_H +namespace llvm { +template +class Optional; +} + +namespace mlir { +class Location; +} + +namespace fir { +class CharBoxValue; +} + namespace Fortran { namespace parser { @@ -38,6 +51,7 @@ struct UnlockStmt; namespace lower { class AbstractConverter; +class FirOpBuilder; // Lowering of Fortran statement related runtime (other than IO and maths) @@ -55,6 +69,9 @@ void genSyncTeamStatement(AbstractConverter &, const parser::SyncTeamStmt &); void genUnlockStatement(AbstractConverter &, const parser::UnlockStmt &); void genPauseStatement(AbstractConverter &, const parser::PauseStmt &); +void genDateAndTime(FirOpBuilder &, mlir::Location, + llvm::Optional date); + } // namespace lower } // namespace Fortran diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index d2f38af4a6e54..f42f40cc2b589 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1284,9 +1284,10 @@ class ExprLowering { fir::ExtendedValue genIntrinsicRef(const Fortran::evaluate::ProcedureRef &procRef, const Fortran::evaluate::SpecificIntrinsic &intrinsic, - mlir::ArrayRef resultType) { - if (resultType.size() != 1) - TODO(); // Intrinsic subroutine + mlir::ArrayRef resultTypes) { + llvm::Optional resultType; + if (resultTypes.size() == 1) + resultType = resultTypes[0]; llvm::SmallVector operands; // Lower arguments @@ -1304,8 +1305,8 @@ class ExprLowering { } // Let the intrinsic library lower the intrinsic procedure call llvm::StringRef name = intrinsic.name; - return Fortran::lower::genIntrinsicCall(builder, getLoc(), name, - resultType[0], operands); + return Fortran::lower::genIntrinsicCall(builder, getLoc(), name, resultType, + operands); } template @@ -1363,7 +1364,7 @@ class ExprLowering { genProcedureRef(const Fortran::evaluate::ProcedureRef &procRef, mlir::ArrayRef resultType) { if (const auto *intrinsic = procRef.proc().GetSpecificIntrinsic()) - return genIntrinsicRef(procRef, *intrinsic, resultType[0]); + return genIntrinsicRef(procRef, *intrinsic, resultType); if (isStatementFunctionCall(procRef)) return genStmtFunctionRef(procRef, resultType); diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index 5ccc599806ab0..ecf67c0c80368 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -7,20 +7,23 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/Runtime.h" +#include "../runtime/clock.h" #include "../runtime/stop.h" #include "RTBuilder.h" #include "flang/Lower/Bridge.h" #include "flang/Lower/FIRBuilder.h" +#include "flang/Lower/Support/BoxValue.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/tools.h" #include "llvm/ADT/SmallVector.h" +using namespace Fortran::runtime; #define mkRTKey(X) mkKey(RTNAME(X)) -static constexpr std::tuple + mkRTKey(StopStatement), mkRTKey(StopStatementText)> newRTTable; template @@ -177,3 +180,26 @@ void Fortran::lower::genPauseStatement( auto callee = genRuntimeFunction(loc, bldr); bldr.create(loc, callee, llvm::None); } + +void Fortran::lower::genDateAndTime(Fortran::lower::FirOpBuilder &builder, + mlir::Location loc, + llvm::Optional date) { + auto callee = genRuntimeFunction(loc, builder); + mlir::Type idxTy = builder.getIndexType(); + mlir::Value dateBuffer; + mlir::Value dateLen; + if (date) { + dateBuffer = date->getBuffer(); + dateLen = date->getLen(); + } else { + auto zero = builder.createIntegerConstant(loc, idxTy, 0); + dateBuffer = zero; + dateLen = zero; + } + llvm::SmallVector args{dateBuffer, dateLen}; + llvm::SmallVector operands; + for (const auto &op : llvm::zip(args, callee.getType().getInputs())) + operands.emplace_back( + builder.convertWithSemantics(loc, std::get<1>(op), std::get<0>(op))); + builder.create(loc, callee, operands); +} diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index 8601ec1d76675..560e9ce59f69a 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -29,6 +29,7 @@ add_flang_library(FortranRuntime ISO_Fortran_binding.cpp allocatable.cpp buffer.cpp + clock.cpp complex-reduction.c copy.cpp character.cpp diff --git a/flang/runtime/clock.cpp b/flang/runtime/clock.cpp new file mode 100644 index 0000000000000..e9db3529761e4 --- /dev/null +++ b/flang/runtime/clock.cpp @@ -0,0 +1,41 @@ +//===-- runtime/clock.cpp ---------------------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Implement time measurement intrinsic functions + +#include "clock.h" +#include +#include +#include +#include +// FIXME: windows +#include + +namespace Fortran::runtime { + +void RTNAME(DateAndTime)(char *date, std::size_t dateChars) { + static constexpr int buffSize{16}; + char buffer[buffSize]; + timeval t; + time_t timer; + tm time; + + gettimeofday(&t, nullptr); + timer = t.tv_sec; + // TODO windows + localtime_r(&timer, &time); + if (date) { + auto len = strftime(buffer, buffSize, "%Y%m%d", &time); + auto copyLen = std::min(len, dateChars); + std::memcpy(date, buffer, copyLen); + for (auto i{copyLen}; i < dateChars; ++i) { + date[i] = ' '; + } + } +} +} // namespace Fortran::runtime diff --git a/flang/runtime/clock.h b/flang/runtime/clock.h new file mode 100644 index 0000000000000..5b6d4290603bc --- /dev/null +++ b/flang/runtime/clock.h @@ -0,0 +1,26 @@ +//===-- runtime/clock.h -------------------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Defines API between compiled code and the time measurement +// support functions in the runtime library. + +#ifndef FORTRAN_RUNTIME_CLOCK_H_ +#define FORTRAN_RUNTIME_CLOCK_H_ +#include "entry-names.h" +#include + +namespace Fortran::runtime { + +class Descriptor; + +extern "C" { + +void RTNAME(DateAndTime)(char *date, std::size_t dateChars); +} +} // namespace Fortran::runtime +#endif // FORTRAN_RUNTIME_CLOCK_H_ From fa34b27812bad51e711bdd89e989d21427da0f5d Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Wed, 26 Aug 2020 08:27:18 -0700 Subject: [PATCH 0249/1017] DATE_AND_TIME TIME and ZONE args lowering --- flang/include/flang/Lower/Runtime.h | 4 +- flang/lib/Lower/Runtime.cpp | 36 ++++++++++++----- flang/runtime/clock.cpp | 61 +++++++++++++++++++++-------- flang/runtime/clock.h | 11 +++++- 4 files changed, 83 insertions(+), 29 deletions(-) diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h index 86652d1b93ea1..b3a7ee2d25eba 100644 --- a/flang/include/flang/Lower/Runtime.h +++ b/flang/include/flang/Lower/Runtime.h @@ -70,7 +70,9 @@ void genUnlockStatement(AbstractConverter &, const parser::UnlockStmt &); void genPauseStatement(AbstractConverter &, const parser::PauseStmt &); void genDateAndTime(FirOpBuilder &, mlir::Location, - llvm::Optional date); + llvm::Optional date, + llvm::Optional time, + llvm::Optional zone); } // namespace lower } // namespace Fortran diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index ecf67c0c80368..93ba4356dc9ab 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -183,20 +183,36 @@ void Fortran::lower::genPauseStatement( void Fortran::lower::genDateAndTime(Fortran::lower::FirOpBuilder &builder, mlir::Location loc, - llvm::Optional date) { + llvm::Optional date, + llvm::Optional time, + llvm::Optional zone) { auto callee = genRuntimeFunction(loc, builder); mlir::Type idxTy = builder.getIndexType(); + mlir::Value zero; + auto splitArg = [&](llvm::Optional arg, + mlir::Value &buffer, mlir::Value &len) { + if (arg) { + buffer = arg->getBuffer(); + len = arg->getLen(); + } else { + if (!zero) + zero = builder.createIntegerConstant(loc, idxTy, 0); + buffer = zero; + len = zero; + } + }; mlir::Value dateBuffer; mlir::Value dateLen; - if (date) { - dateBuffer = date->getBuffer(); - dateLen = date->getLen(); - } else { - auto zero = builder.createIntegerConstant(loc, idxTy, 0); - dateBuffer = zero; - dateLen = zero; - } - llvm::SmallVector args{dateBuffer, dateLen}; + splitArg(date, dateBuffer, dateLen); + mlir::Value timeBuffer; + mlir::Value timeLen; + splitArg(time, timeBuffer, timeLen); + mlir::Value zoneBuffer; + mlir::Value zoneLen; + splitArg(zone, zoneBuffer, zoneLen); + + llvm::SmallVector args{dateBuffer, timeBuffer, zoneBuffer, + dateLen, timeLen, zoneLen}; llvm::SmallVector operands; for (const auto &op : llvm::zip(args, callee.getType().getInputs())) operands.emplace_back( diff --git a/flang/runtime/clock.cpp b/flang/runtime/clock.cpp index e9db3529761e4..8861fe0591d28 100644 --- a/flang/runtime/clock.cpp +++ b/flang/runtime/clock.cpp @@ -12,30 +12,59 @@ #include #include #include +#include #include -// FIXME: windows +// TODO: windows, localtime_r/gettimeofday do not exists/ are different. +#ifndef _WIN32 #include namespace Fortran::runtime { -void RTNAME(DateAndTime)(char *date, std::size_t dateChars) { - static constexpr int buffSize{16}; - char buffer[buffSize]; +void RTNAME(DateAndTime)(char *date, char *time, char *zone, + std::size_t dateChars, std::size_t timeChars, std::size_t zoneChars) { timeval t; - time_t timer; - tm time; + ::gettimeofday(&t, nullptr); + time_t timer{t.tv_sec}; + tm localTime; + ::localtime_r(&timer, &localTime); - gettimeofday(&t, nullptr); - timer = t.tv_sec; - // TODO windows - localtime_r(&timer, &time); + static constexpr int buffSize{16}; + char buffer[buffSize]; + auto copyBufferAndPad{ + [&](char *dest, std::size_t destChars, std::size_t len) { + auto copyLen{std::min(len, destChars)}; + std::memcpy(dest, buffer, copyLen); + for (auto i{copyLen}; i < destChars; ++i) { + dest[i] = ' '; + } + }}; if (date) { - auto len = strftime(buffer, buffSize, "%Y%m%d", &time); - auto copyLen = std::min(len, dateChars); - std::memcpy(date, buffer, copyLen); - for (auto i{copyLen}; i < dateChars; ++i) { - date[i] = ' '; - } + auto len = ::strftime(buffer, buffSize, "%Y%m%d", &localTime); + copyBufferAndPad(date, dateChars, len); + } + if (time) { + auto ms{t.tv_usec / 1000}; + auto len{::snprintf(buffer, buffSize, "%02d%02d%02d.%03ld", + localTime.tm_hour, localTime.tm_min, localTime.tm_sec, ms)}; + copyBufferAndPad(time, timeChars, len); } + if (zone) { + // Note: this may leave the buffer empty on many platforms. Classic flang + // has a much more complex way of doing this (see __io_timezone in classic + // flang). + auto len{::strftime(buffer, buffSize, "%z", &localTime)}; + copyBufferAndPad(zone, zoneChars, len); + } +} +} // namespace Fortran::runtime + +#else /* Windows */ +// TODO: implement windows version (probably best to try merging implementations +// as much as possible). +namespace Fortran::runtime { +void RTNAME(DateAndTime)( + char *, char *, char *, std::size_t, std::size_t, std::size_t) { + // TODO } } // namespace Fortran::runtime +#endif diff --git a/flang/runtime/clock.h b/flang/runtime/clock.h index 5b6d4290603bc..169e35f012a62 100644 --- a/flang/runtime/clock.h +++ b/flang/runtime/clock.h @@ -1,4 +1,4 @@ -//===-- runtime/clock.h -------------------------------------*- C++ -*-===// +//===-- runtime/clock.h -----------------------------------------*- C++ -*-===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. @@ -20,7 +20,14 @@ class Descriptor; extern "C" { -void RTNAME(DateAndTime)(char *date, std::size_t dateChars); +/// Implement runtime for DATE_AND_TIME intrinsic. +/// TODO: +/// - Add VALUES argument (through descriptor). +/// - Windows implementation (currently does nothing) +void RTNAME(DateAndTime)(char *date, char *time, char *zone, + std::size_t dateChars, std::size_t timeChars, std::size_t zoneChars); } + +// TODO: CPU_TIME, SYSTEM_CLOCK } // namespace Fortran::runtime #endif // FORTRAN_RUNTIME_CLOCK_H_ From ba052ddca4e0e5dda9137536f03d0f21cbc36d65 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Mon, 31 Aug 2020 21:48:56 -0400 Subject: [PATCH 0250/1017] [flang][openacc] Lower rest of clauses for the loop construct --- flang/test/Lower/OpenACC/acc-loop.f90 | 221 +++++++++++++++++++++++++- 1 file changed, 218 insertions(+), 3 deletions(-) diff --git a/flang/test/Lower/OpenACC/acc-loop.f90 b/flang/test/Lower/OpenACC/acc-loop.f90 index 9038454032967..3a6e7b760066f 100644 --- a/flang/test/Lower/OpenACC/acc-loop.f90 +++ b/flang/test/Lower/OpenACC/acc-loop.f90 @@ -8,6 +8,10 @@ program acc_loop integer, parameter :: n = 10 real, dimension(n) :: a, b real, dimension(n, n) :: c, d + integer :: gangNum = 8 + integer :: gangStatic = 8 + integer :: vectorLength = 128 + integer, parameter :: tileSize = 2 !$acc loop @@ -18,7 +22,218 @@ program acc_loop !CHECK: acc.loop { !CHECK: fir.do_loop !CHECK: acc.yield -!CHECK-NEXT: } +!CHECK-NEXT: }{{$}} + + !$acc loop seq + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: } attributes {seq} + + !$acc loop auto + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: } attributes {auto} + + !$acc loop independent + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: } attributes {independent} + + !$acc loop gang + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop gang { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop gang(num: 8) + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: [[GANGNUM1:%.*]] = constant 8 : i32 +!CHECK-NEXT: acc.loop gang(num: [[GANGNUM1]]) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop gang(num: gangNum) + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: [[GANGNUM2:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK-NEXT: acc.loop gang(num: [[GANGNUM2]]) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop gang(num: gangNum, static: gangStatic) + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop gang(num: %{{.*}}, static: %{{.*}}) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop vector + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop vector { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop vector(128) + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: [[CONSTANT128:%.*]] = constant 128 : i32 +!CHECK: acc.loop vector([[CONSTANT128]]) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop vector(vectorLength) + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: [[VECTORLENGTH:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: acc.loop vector([[VECTORLENGTH]]) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + +!$acc loop worker + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop worker { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop worker(128) + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: [[WORKER128:%.*]] = constant 128 : i32 +!CHECK: acc.loop worker([[WORKER128]]) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop private(c) + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop private(%{{.*}}: !fir.ref>) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop private(c, d) + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop private(%{{.*}}: !fir.ref>, %{{.*}}: !fir.ref>) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop private(c) private(d) + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop private(%{{.*}}: !fir.ref>, %{{.*}}: !fir.ref>) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop tile(2) + DO i = 1, n + a(i) = b(i) + END DO +!CHECK: [[TILESIZE:%.*]] = constant 2 : i32 +!CHECK: acc.loop tile([[TILESIZE]]: i32) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop tile(*) + DO i = 1, n + a(i) = b(i) + END DO +!CHECK: [[TILESIZEM1:%.*]] = constant -1 : i32 +!CHECK: acc.loop tile([[TILESIZEM1]]: i32) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop tile(2, 2) + DO i = 1, n + DO j = 1, n + c(i, j) = d(i, j) + END DO + END DO + +!CHECK: [[TILESIZE1:%.*]] = constant 2 : i32 +!CHECK: [[TILESIZE2:%.*]] = constant 2 : i32 +!CHECK: acc.loop tile([[TILESIZE1]]: i32, [[TILESIZE2]]: i32) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop tile(tileSize) + DO i = 1, n + a(i) = b(i) + END DO + +!CHECK: acc.loop tile(%{{.*}}: i32) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc loop tile(tileSize, tileSize) + DO i = 1, n + DO j = 1, n + c(i, j) = d(i, j) + END DO + END DO + +!CHECK: acc.loop tile(%{{.*}}: i32, %{{.*}}: i32) { +!CHECK: fir.do_loop +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} !$acc loop collapse(2) DO i = 1, n @@ -46,9 +261,9 @@ program acc_loop !CHECK: acc.loop { !CHECK: fir.do_loop !CHECK: acc.yield -!CHECK-NEXT: } +!CHECK-NEXT: }{{$}} !CHECK: acc.yield -!CHECK-NEXT: } +!CHECK-NEXT: }{{$}} end program From b7b7ce9ca9bf58b9c8e269285c5d05ebb1eca104 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 8 Sep 2020 17:36:45 -0700 Subject: [PATCH 0251/1017] Enable the assertion checking that a BoxValue has an address and resides in memory. The remaining issues were problems with the lowering of CHARACTER variables and values. This patch attempts to clean up some of that, passing CharBoxValue and Value where appropriate, etc. Use llvm::dbgs() consistently. Some clean up of other small TODOs and FIXMEs. --- flang/include/flang/Lower/CharacterExpr.h | 29 +- flang/include/flang/Lower/Support/BoxValue.h | 10 +- flang/lib/Lower/Bridge.cpp | 10 +- flang/lib/Lower/CharacterExpr.cpp | 667 +++++++++++-------- flang/lib/Lower/ConvertExpr.cpp | 31 +- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 15 +- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 16 +- flang/test/Lower/character-assignment.f90 | 2 +- 8 files changed, 448 insertions(+), 332 deletions(-) diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index 57ea893003b54..71442d87de9d6 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -53,7 +53,7 @@ class CharacterExprHelper { /// Lower \p lhs = \p rhs where \p lhs and \p rhs are scalar characters. /// It handles cases where \p lhs and \p rhs may overlap. - void createAssign(mlir::Value lhs, mlir::Value rhs); + void createAssign(mlir::Value lhs, const fir::ExtendedValue &rhs); /// Lower an assignment where the buffer and LEN parameter are known and do /// not need to be unboxed. @@ -101,7 +101,7 @@ class CharacterExprHelper { materializeCharacterOrSequence(mlir::Value str); /// Return true if \p type is a character literal type (is - /// fir.array>).; + /// `fir.array>`).; static bool isCharacterLiteral(mlir::Type type); /// Return true if \p type is one of the following type @@ -119,6 +119,7 @@ class CharacterExprHelper { /// Determine the base character type static fir::CharacterType getCharacterType(mlir::Type type); static fir::CharacterType getCharacterType(const fir::CharBoxValue &box); + static fir::CharacterType getCharacterType(mlir::Value str); /// Return the integer type that must be used to manipulate /// Character lengths. TODO: move this to FirOpBuilder? @@ -130,10 +131,12 @@ class CharacterExprHelper { /// - fir.array> /// - fir.char /// - fir.ref> - /// If the no length is passed, it is attempted to be extracted from \p - /// character (or its type). This will crash if this is not possible. - /// The returned value is a CharBoxValue if \p character is a scalar, - /// otherwise it is a CharArrayBoxValue. + /// + /// Does the heavy lifting of converting the value \p character (along with an + /// optional \p len value) to an extended value. If \p len is null, a length + /// value is extracted from \p character (or its type). This will produce an + /// error if it's not possible. The returned value is a CharBoxValue if \p + /// character is a scalar, otherwise it is a CharArrayBoxValue. fir::ExtendedValue toExtendedValue(mlir::Value character, mlir::Value len = {}); @@ -143,17 +146,23 @@ class CharacterExprHelper { /// - !fir.array> /// - !fir.ref where T is either of the first two cases /// - !fir.box where T is either of the first two cases + /// + /// In certain contexts, Fortran allows an array of CHARACTERs to be treated + /// as if it were one longer CHARACTER scalar, each element append to the + /// previous. static bool isArray(mlir::Type type); private: - fir::CharBoxValue materializeValue(const fir::CharBoxValue &str); + fir::CharBoxValue materializeValue(mlir::Value str); fir::CharBoxValue toDataLengthPair(mlir::Value character); mlir::Type getReferenceType(const fir::CharBoxValue &c) const; + mlir::Type getReferenceType(mlir::Value str) const; mlir::Type getSeqTy(const fir::CharBoxValue &c) const; + mlir::Type getSeqTy(mlir::Value str) const; + mlir::Value getCharBoxBuffer(const fir::CharBoxValue &box); mlir::Value createEmbox(const fir::CharBoxValue &str); - mlir::Value createLoadCharAt(const fir::CharBoxValue &str, mlir::Value index); - void createStoreCharAt(const fir::CharBoxValue &str, mlir::Value index, - mlir::Value c); + mlir::Value createLoadCharAt(mlir::Value buff, mlir::Value index); + void createStoreCharAt(mlir::Value str, mlir::Value index, mlir::Value c); void createCopy(const fir::CharBoxValue &dest, const fir::CharBoxValue &src, mlir::Value count); void createPadding(const fir::CharBoxValue &str, mlir::Value lower, diff --git a/flang/include/flang/Lower/Support/BoxValue.h b/flang/include/flang/Lower/Support/BoxValue.h index 5ec50105e90ea..f1e85f2d9e7ee 100644 --- a/flang/include/flang/Lower/Support/BoxValue.h +++ b/flang/include/flang/Lower/Support/BoxValue.h @@ -54,8 +54,8 @@ class AbstractBox { public: AbstractBox() = delete; AbstractBox(mlir::Value addr) : addr{addr} { - //assert(isa_passbyref_type(addr.getType()) && - // "box values must be references"); + assert(isa_passbyref_type(addr.getType()) && + "box values must be references"); } /// An abstract box always contains a memory reference to a value. @@ -225,7 +225,11 @@ class ExtendedValue : public details::matcher { using VT = std::variant; - template + ExtendedValue() : box{UnboxedValue{}} {} + ExtendedValue(const ExtendedValue &) = default; + ExtendedValue(ExtendedValue &&) = default; + template , ExtendedValue>>> constexpr ExtendedValue(A &&box) : box{std::forward(box)} {} template diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index b50cc1b8e0b42..0c011a642495c 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1484,8 +1484,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (isCharacterCategory(lhsType->category())) { // Fortran 2018 10.2.1.3 p10 and p11 // Generating value for lhs to get fir.boxchar. + Fortran::lower::ExpressionContext context; auto lhs = genExprAddr(assign.lhs); - auto rhs = genExprValue(assign.rhs); + auto rhs = createSomeExtendedExpression( + toLocation(), *this, assign.rhs, localSymbols, context); Fortran::lower::CharacterExprHelper{*builder, loc}.createAssign( lhs, rhs); return; @@ -1798,11 +1800,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Assume that the members of the COMMON block will appear in an order // that is sorted by offset. [[maybe_unused]] std::int64_t lastByteOff = -1; - LLVM_DEBUG(llvm::errs() << "block {\n"); + LLVM_DEBUG(llvm::dbgs() << "block {\n"); for (const auto &obj : details->objects()) { assert(lastByteOff < static_cast(obj->offset())); lastByteOff = static_cast(obj->offset()); - LLVM_DEBUG(llvm::errs() << "offset: " << obj->offset() << '\n'); + LLVM_DEBUG(llvm::dbgs() << "offset: " << obj->offset() << '\n'); if (const auto *objDet = obj->detailsIf()) if (objDet->init()) { @@ -1814,7 +1816,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { castVal, off); } } - LLVM_DEBUG(llvm::errs() << "}\n"); + LLVM_DEBUG(llvm::dbgs() << "}\n"); builder.create(loc, cb); }; global = builder->createGlobal(loc, commonTy, globalName, diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index 37423dcd3c7a5..cc139f8f6b873 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -14,35 +14,37 @@ #include "flang/Lower/ConvertType.h" #include "flang/Lower/DoLoopHelper.h" #include "flang/Lower/IntrinsicCall.h" +#include "flang/Lower/Todo.h" #include "llvm/Support/Debug.h" + #define DEBUG_TYPE "flang-lower-character" //===----------------------------------------------------------------------===// // CharacterExprHelper implementation //===----------------------------------------------------------------------===// -template +/// Unwrap base fir.char type. static fir::CharacterType recoverCharacterType(mlir::Type type) { if (auto boxType = type.dyn_cast()) return boxType.getEleTy(); - if (auto refType = type.dyn_cast()) - type = refType.getEleTy(); - if (auto seqType = type.dyn_cast()) { - // In a context where `type` may be a sequence, we want to opt out of this - // assertion by setting `checkForScalar` to `false`. - assert((!checkForScalar || seqType.getShape().size() == 1) && - "rank must be 1 for a scalar CHARACTER"); - type = seqType.getEleTy(); + while (true) { + if (auto pointedType = fir::dyn_cast_ptrEleTy(type)) + type = pointedType; + else if (auto boxTy = type.dyn_cast()) + type = boxTy.getEleTy(); + else + break; } - if (auto charType = type.dyn_cast()) - return charType; - llvm_unreachable("Invalid character value type"); + if (auto seqType = type.dyn_cast()) + type = seqType.getEleTy(); + return type.cast(); } /// Get fir.char type with the same kind as inside str. fir::CharacterType Fortran::lower::CharacterExprHelper::getCharacterType(mlir::Type type) { - return recoverCharacterType(type); + assert(isCharacterScalar(type) && "expected scalar character"); + return recoverCharacterType(type); } fir::CharacterType Fortran::lower::CharacterExprHelper::getCharacterType( @@ -50,70 +52,75 @@ fir::CharacterType Fortran::lower::CharacterExprHelper::getCharacterType( return getCharacterType(box.getBuffer().getType()); } -static bool needToMaterialize(const fir::CharBoxValue &box) { - return box.getBuffer().getType().isa() || - box.getBuffer().getType().isa(); +fir::CharacterType +Fortran::lower::CharacterExprHelper::getCharacterType(mlir::Value str) { + return getCharacterType(str.getType()); } -static std::optional +/// Determine the static size of the character. Returns the computed size, not +/// an IR Value. +static std::optional getCompileTimeLength(const fir::CharBoxValue &box) { - // FIXME: should this just return box.getLen() ?? - auto type = box.getBuffer().getType(); - if (type.isa()) - return 1; - if (auto refType = type.dyn_cast()) - type = refType.getEleTy(); - if (auto seqType = type.dyn_cast()) { - auto shape = seqType.getShape(); - assert(shape.size() == 1 && "only scalar character supported"); - if (shape[0] != fir::SequenceType::getUnknownExtent()) - return shape[0]; - } - return {}; + auto len = recoverCharacterType(box.getBuffer().getType()).getLen(); + if (len == fir::CharacterType::unknownLen()) + return {}; + return len; } -fir::CharBoxValue Fortran::lower::CharacterExprHelper::materializeValue( - const fir::CharBoxValue &str) { - if (!needToMaterialize(str)) - return str; - auto variable = builder.create(loc, str.getBuffer().getType()); - builder.create(loc, str.getBuffer(), variable); - LLVM_DEBUG(llvm::dbgs() << "materialized as local: " << str << " -> (" - << variable << ", " << str.getLen() << ")\n"); - return {variable, str.getLen()}; +/// Detect the precondition that the value `str` does not reside in memory. Such +/// values will have a type `!fir.array<...x!fir.char>` or `!fir.char`. +LLVM_ATTRIBUTE_UNUSED static bool needToMaterialize(mlir::Value str) { + return str.getType().isa() || + str.getType().isa(); +} + +/// Unwrap integer constant from mlir::Value. +static llvm::Optional getIntIfConstant(mlir::Value value) { + if (auto definingOp = value.getDefiningOp()) + if (auto cst = mlir::dyn_cast(definingOp)) + if (auto intAttr = cst.getValue().dyn_cast()) + return intAttr.getInt(); + return {}; } +/// This is called only if `str` does not reside in memory. Such a bare string +/// value will be converted into a memory-based temporary and an extended +/// boxchar value returned. fir::CharBoxValue -Fortran::lower::CharacterExprHelper::toDataLengthPair(mlir::Value character) { - // TODO: get rid of toDataLengthPair when adding support for arrays - auto *charBox = toExtendedValue(character).getCharBox(); - assert(charBox && "Array unsupported in character lowering helper"); - return *charBox; +Fortran::lower::CharacterExprHelper::materializeValue(mlir::Value str) { + assert(needToMaterialize(str)); + auto ty = str.getType(); + assert(isCharacterScalar(ty) && "expected scalar character"); + auto charTy = ty.dyn_cast(); + if (!charTy || charTy.getLen() == fir::CharacterType::unknownLen()) { + LLVM_DEBUG(llvm::dbgs() << "cannot materialize: " << str << '\n'); + llvm_unreachable("must be a !fir.char type"); + } + auto len = builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), charTy.getLen()); + auto temp = builder.create(loc, charTy); + builder.create(loc, str, temp); + LLVM_DEBUG(llvm::dbgs() << "materialized as local: " << str << " -> (" << temp + << ", " << len << ")\n"); + return {temp, len}; } fir::ExtendedValue Fortran::lower::CharacterExprHelper::toExtendedValue(mlir::Value character, mlir::Value len) { - auto lenType = getLengthType(); + auto lenType = builder.getCharacterLengthType(); auto type = character.getType(); - auto base = character; + auto base = fir::isa_passbyref_type(type) ? character : mlir::Value{}; auto resultLen = len; llvm::SmallVector extents; - if (auto refType = type.dyn_cast()) - type = refType.getEleTy(); + if (auto eleType = fir::dyn_cast_ptrEleTy(type)) + type = eleType; if (auto arrayType = type.dyn_cast()) { - type = arrayType.getEleTy(); - auto shape = arrayType.getShape(); - auto cstLen = shape[0]; - if (!resultLen && cstLen != fir::SequenceType::getUnknownExtent()) - resultLen = builder.createIntegerConstant(loc, lenType, cstLen); - // FIXME: only allow `?` in last dimension ? - auto typeExtents = - llvm::ArrayRef{shape}.drop_front(); + type = arrayType; auto indexType = builder.getIndexType(); - for (auto extent : typeExtents) { + for (auto extent : arrayType.getShape()) { if (extent == fir::SequenceType::getUnknownExtent()) break; extents.emplace_back( @@ -122,97 +129,182 @@ Fortran::lower::CharacterExprHelper::toExtendedValue(mlir::Value character, // Last extent might be missing in case of assumed-size. If more extents // could not be deduced from type, that's an error (a fir.box should // have been used in the interface). - if (extents.size() + 1 < typeExtents.size()) + if (extents.size() + 1 < arrayType.getShape().size()) mlir::emitError(loc, "cannot retrieve array extents from type"); - } else if (type.isa()) { - if (!resultLen) - resultLen = builder.createIntegerConstant(loc, lenType, 1); + } + + if (auto charTy = type.dyn_cast()) { + if (!resultLen && charTy.getLen() != fir::CharacterType::unknownLen()) + resultLen = builder.createIntegerConstant(loc, lenType, charTy.getLen()); } else if (auto boxCharType = type.dyn_cast()) { auto refType = builder.getRefType(boxCharType.getEleTy()); - auto unboxed = - builder.create(loc, refType, lenType, character); - base = unboxed.getResult(0); - if (!resultLen) - resultLen = unboxed.getResult(1); + // If the embox is accessible, use its operand to avoid filling + // the generated fir with embox/unbox. + mlir::Value boxCharLen; + if (auto definingOp = character.getDefiningOp()) { + if (auto box = dyn_cast(definingOp)) { + base = box.memref(); + boxCharLen = box.len(); + } + } + if (!boxCharLen) { + auto unboxed = + builder.create(loc, refType, lenType, character); + base = builder.createConvert(loc, refType, unboxed.getResult(0)); + boxCharLen = unboxed.getResult(1); + } + if (!resultLen) { + resultLen = boxCharLen; + } } else if (type.isa()) { mlir::emitError(loc, "descriptor or derived type not yet handled"); } else { llvm_unreachable("Cannot translate mlir::Value to character ExtendedValue"); } + if (!base) { + if (auto load = + mlir::dyn_cast_or_null(character.getDefiningOp())) { + base = load.getOperand(); + } else { + return materializeValue(fir::getBase(character)); + } + } if (!resultLen) - mlir::emitError(loc, "no dynamic length found for character"); + llvm::report_fatal_error("no dynamic length found for character"); if (!extents.empty()) return fir::CharArrayBoxValue{base, resultLen, extents}; return fir::CharBoxValue{base, resultLen}; } -/// Get canonical `!fir.ref>` type. -mlir::Type Fortran::lower::CharacterExprHelper::getReferenceType( - const fir::CharBoxValue &box) const { - return builder.getRefType(getCharacterType(box)); -} - -mlir::Type Fortran::lower::CharacterExprHelper::getSeqTy( - const fir::CharBoxValue &box) const { - auto ty = box.getBuffer().getType(); - if (ty.isa()) - return ty; - return builder.getRefType(builder.getVarLenSeqTy(getCharacterType(box))); +static mlir::Type getSingletonCharType(mlir::MLIRContext *ctxt, int kind) { + return fir::CharacterType::getSingleton(ctxt, kind); } mlir::Value Fortran::lower::CharacterExprHelper::createEmbox(const fir::CharBoxValue &box) { - // BoxChar require a reference. - auto str = box; - if (needToMaterialize(box)) - str = materializeValue(box); - auto kind = getCharacterType(str).getFKind(); - auto boxCharType = fir::BoxCharType::get(builder.getContext(), kind); - auto refType = getReferenceType(str); - auto buff = builder.createConvert(loc, refType, str.getBuffer()); + // BoxChar require a reference. Base CharBoxValue of CharArrayBoxValue + // are ok here (do not require a scalar type) + auto charTy = recoverCharacterType(box.getBuffer().getType()); + auto boxCharType = + fir::BoxCharType::get(builder.getContext(), charTy.getFKind()); + auto refType = fir::ReferenceType::get(boxCharType.getEleTy()); + auto buff = builder.createConvert(loc, refType, box.getBuffer()); // Convert in case the provided length is not of the integer type that must // be used in boxchar. - auto lenType = getLengthType(); - auto len = builder.createConvert(loc, lenType, str.getLen()); + auto len = builder.createConvert(loc, builder.getCharacterLengthType(), + box.getLen()); return builder.create(loc, boxCharType, buff, len); } -mlir::Value Fortran::lower::CharacterExprHelper::createLoadCharAt( - const fir::CharBoxValue &str, mlir::Value index) { - // In case this is addressing a length one character scalar simply return - // the single character. - auto buff = str.getBuffer(); - if (auto charTy = buff.getType().dyn_cast()) { - assert(charTy.getLen() == 1 && "string not handled"); - return buff; - } - assert(fir::isa_ref_type(buff.getType())); - auto coor = builder.createConvert(loc, getSeqTy(str), buff); - auto addr = builder.create(loc, getReferenceType(str), - coor, index); - return builder.create(loc, addr); -} - -void Fortran::lower::CharacterExprHelper::createStoreCharAt( - const fir::CharBoxValue &str, mlir::Value index, mlir::Value c) { - assert(!needToMaterialize(str) && "not in memory"); - auto buff = builder.createConvert(loc, getSeqTy(str), str.getBuffer()); - auto addr = builder.create(loc, getReferenceType(str), - buff, index); +fir::CharBoxValue Fortran::lower::CharacterExprHelper::toScalarCharacter( + const fir::CharArrayBoxValue &box) { + if (box.getBuffer().getType().isa()) + TODO(loc, "concatenating non contiguous character array into a scalar"); + + // TODO: add a fast path multiplying new length at compile time if the info is + // in the array type. + auto lenType = builder.getCharacterLengthType(); + auto len = builder.createConvert(loc, lenType, box.getLen()); + for (auto extent : box.getExtents()) + len = builder.create( + loc, len, builder.createConvert(loc, lenType, extent)); + + // TODO: typeLen can be improved in compiled constant cases + // TODO: allow bare fir.array<> (no ref) conversion here ? + auto typeLen = fir::CharacterType::unknownLen(); + auto kind = recoverCharacterType(box.getBuffer().getType()).getFKind(); + auto charTy = fir::CharacterType::get(builder.getContext(), kind, typeLen); + auto type = fir::ReferenceType::get(charTy); + auto buffer = builder.createConvert(loc, type, box.getBuffer()); + return {buffer, len}; +} + +mlir::Value Fortran::lower::CharacterExprHelper::createEmbox( + const fir::CharArrayBoxValue &box) { + // Use same embox as for scalar. It's losing the actual data size information + // (We do not multiply the length by the array size), but that is what Fortran + // call interfaces using boxchar expect. + return createEmbox(static_cast(box)); +} + +/// Get the address of the element at position \p index of the scalar character +/// \p buffer. +/// \p buffer must be of type !fir.ref>. The length may be +/// unknown. \p index must have any integer type, and is zero based. The return +/// value is a singleton address (!fir.ref>) +mlir::Value +Fortran::lower::CharacterExprHelper::createElementAddr(mlir::Value buffer, + mlir::Value index) { + // The only way to address an element of a fir.ref> is to cast + // it to a fir.array> and use fir.coordinate_of. + auto bufferType = buffer.getType(); + assert(fir::isa_ref_type(bufferType)); + assert(isCharacterScalar(bufferType)); + auto charTy = recoverCharacterType(bufferType); + auto singleTy = getSingletonCharType(builder.getContext(), charTy.getFKind()); + auto singleRefTy = builder.getRefType(singleTy); + auto extent = fir::SequenceType::getUnknownExtent(); + if (charTy.getLen() != fir::CharacterType::unknownLen()) + extent = charTy.getLen(); + auto coorTy = builder.getRefType(fir::SequenceType::get({extent}, singleTy)); + + auto coor = builder.createConvert(loc, coorTy, buffer); + auto i = builder.createConvert(loc, builder.getIndexType(), index); + return builder.create(loc, singleRefTy, coor, i); +} + +/// Load a character out of `buff` from offset `index`. +/// `buff` must be a reference to memory. +mlir::Value +Fortran::lower::CharacterExprHelper::createLoadCharAt(mlir::Value buff, + mlir::Value index) { + LLVM_DEBUG(llvm::dbgs() << "load a char: " << buff << " type: " + << buff.getType() << " at: " << index << '\n'); + return builder.create(loc, createElementAddr(buff, index)); +} + +/// Store the singleton character `c` to `str` at offset `index`. +/// `str` must be a reference to memory. +void Fortran::lower::CharacterExprHelper::createStoreCharAt(mlir::Value str, + mlir::Value index, + mlir::Value c) { + LLVM_DEBUG(llvm::dbgs() << "store the char: " << c << " into: " << str + << " type: " << str.getType() << " at: " << index + << '\n'); + auto addr = createElementAddr(str, index); builder.create(loc, c, addr); } +// FIXME: this temp is useless... either fir.coordinate_of needs to +// work on "loaded" characters (!fir.array>) or +// character should never be loaded. +// If this is a fir.array<>, allocate and store the value so that +// fir.cooridnate_of can be use on the value. +mlir::Value Fortran::lower::CharacterExprHelper::getCharBoxBuffer( + const fir::CharBoxValue &box) { + auto buff = box.getBuffer(); + if (buff.getType().isa()) { + auto newBuff = builder.create(loc, buff.getType()); + builder.create(loc, buff, newBuff); + return newBuff; + } + return buff; +} + +/// Create a loop to copy `count` characters from `src` to `dest`. void Fortran::lower::CharacterExprHelper::createCopy( const fir::CharBoxValue &dest, const fir::CharBoxValue &src, mlir::Value count) { - auto from = src; - if (needToMaterialize(src)) - from = materializeValue(src); + auto fromBuff = getCharBoxBuffer(src); + auto toBuff = getCharBoxBuffer(dest); + LLVM_DEBUG(llvm::dbgs() << "create char copy from: "; src.dump(); + llvm::dbgs() << " to: "; dest.dump(); + llvm::dbgs() << " count: " << count << '\n'); Fortran::lower::DoLoopHelper{builder, loc}.createLoop( count, [&](Fortran::lower::FirOpBuilder &, mlir::Value index) { - auto charVal = createLoadCharAt(from, index); - createStoreCharAt(dest, index, charVal); + auto charVal = createLoadCharAt(fromBuff, index); + createStoreCharAt(toBuff, index, charVal); }); } @@ -221,18 +313,28 @@ void Fortran::lower::CharacterExprHelper::createPadding( auto blank = createBlankConstant(getCharacterType(str)); // Always create the loop, if upper < lower, no iteration will be // executed. + auto toBuff = getCharBoxBuffer(str); Fortran::lower::DoLoopHelper{builder, loc}.createLoop( lower, upper, [&](Fortran::lower::FirOpBuilder &, mlir::Value index) { - createStoreCharAt(str, index, blank); + createStoreCharAt(toBuff, index, blank); }); } fir::CharBoxValue -Fortran::lower::CharacterExprHelper::createTemp(mlir::Type type, - mlir::Value len) { - assert(type.isa() && "expected fir character type"); - llvm::SmallVector sizes{len}; - auto ref = builder.allocateLocal(loc, type, llvm::StringRef{}, sizes); +Fortran::lower::CharacterExprHelper::createCharacterTemp(mlir::Type type, + mlir::Value len) { + auto kind = recoverCharacterType(type).getFKind(); + auto typeLen = fir::CharacterType::unknownLen(); + // If len is a constant, reflect the length in the type. + if (auto cstLen = getIntIfConstant(len)) + typeLen = *cstLen; + auto *ctxt = builder.getContext(); + auto charTy = fir::CharacterType::get(ctxt, kind, typeLen); + llvm::SmallVector lenParams; + if (typeLen == fir::CharacterType::unknownLen()) + lenParams.push_back(len); + auto ref = builder.allocateLocal(loc, charTy, llvm::StringRef{}, llvm::None, + lenParams); return {ref, len}; } @@ -240,21 +342,9 @@ Fortran::lower::CharacterExprHelper::createTemp(mlir::Type type, void Fortran::lower::CharacterExprHelper::createLengthOneAssign( const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) { auto addr = lhs.getBuffer(); - auto val = rhs.getBuffer(); - // If rhs value resides in memory, load it. - if (!needToMaterialize(rhs)) - val = builder.create(loc, val); - auto valTy = val.getType(); - // Precondition is rhs is size 1, but it may be wrapped in a fir.array. - if (auto seqTy = valTy.dyn_cast()) { - auto zero = - builder.createIntegerConstant(loc, builder.getIntegerType(32), 0); - valTy = seqTy.getEleTy(); - val = builder.create(loc, valTy, val, zero); - } - auto addrTy = fir::ReferenceType::get(valTy); + mlir::Value val = builder.create(loc, rhs.getBuffer()); + auto addrTy = builder.getRefType(val.getType()); addr = builder.createConvert(loc, addrTy, addr); - assert(fir::dyn_cast_ptrEleTy(addr.getType()) == val.getType()); builder.create(loc, val, addr); } @@ -272,29 +362,26 @@ void Fortran::lower::CharacterExprHelper::createAssign( // Copy the minimum of the lhs and rhs lengths and pad the lhs remainder // if needed. - mlir::Value copyCount = lhs.getLen(); - if (!compileTimeSameLength) - copyCount = - Fortran::lower::genMin(builder, loc, {lhs.getLen(), rhs.getLen()}); - - fir::CharBoxValue safeRhs = rhs; - if (needToMaterialize(rhs)) { - // TODO: revisit now that character constant handling changed. - // Need to materialize the constant to get its elements. - // (No equivalent of fir.coordinate_of for array value). - safeRhs = materializeValue(rhs); - } else { - // If rhs is in memory, always assumes rhs might overlap with lhs - // in a way that require a temp for the copy. That can be optimize later. - // Only create a temp of copyCount size because we do not need more from - // rhs. - auto temp = createTemp(getCharacterType(rhs), copyCount); - createCopy(temp, rhs, copyCount); - safeRhs = temp; + auto copyCount = lhs.getLen(); + auto idxTy = builder.getIndexType(); + if (!compileTimeSameLength) { + auto lhsLen = builder.createConvert(loc, idxTy, lhs.getLen()); + auto rhsLen = builder.createConvert(loc, idxTy, rhs.getLen()); + copyCount = Fortran::lower::genMin(builder, loc, {lhsLen, rhsLen}); } + // If rhs is in memory, always assumes rhs might overlap with lhs + // in a way that require a temp for the copy. That can be optimize later. + // Only create a temp of copyCount size because we do not need more from + // rhs. + // TODO: It should be rare that the assignment is between overlapping + // substrings of the same variable. So this extra copy is pessimistic in the + // common case. + auto temp = createCharacterTemp(getCharacterType(rhs), copyCount); + createCopy(temp, rhs, copyCount); + // Actual copy - createCopy(lhs, safeRhs, copyCount); + createCopy(lhs, temp, copyCount); // Pad if needed. if (!compileTimeSameLength) { @@ -306,23 +393,24 @@ void Fortran::lower::CharacterExprHelper::createAssign( fir::CharBoxValue Fortran::lower::CharacterExprHelper::createConcatenate( const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) { - mlir::Value len = - builder.create(loc, lhs.getLen(), rhs.getLen()); - auto temp = createTemp(getCharacterType(rhs), len); - createCopy(temp, lhs, lhs.getLen()); + auto lhsLen = builder.createConvert(loc, builder.getCharacterLengthType(), + lhs.getLen()); + auto rhsLen = builder.createConvert(loc, builder.getCharacterLengthType(), + rhs.getLen()); + mlir::Value len = builder.create(loc, lhsLen, rhsLen); + auto temp = createCharacterTemp(getCharacterType(rhs), len); + createCopy(temp, lhs, lhsLen); auto one = builder.createIntegerConstant(loc, len.getType(), 1); auto upperBound = builder.create(loc, len, one); - auto lhsLen = - builder.createConvert(loc, builder.getIndexType(), lhs.getLen()); - auto from = rhs; - if (needToMaterialize(rhs)) - from = materializeValue(rhs); + auto lhsLenIdx = builder.createConvert(loc, builder.getIndexType(), lhsLen); + auto fromBuff = getCharBoxBuffer(rhs); + auto toBuff = getCharBoxBuffer(temp); Fortran::lower::DoLoopHelper{builder, loc}.createLoop( - lhs.getLen(), upperBound, one, + lhsLenIdx, upperBound, one, [&](Fortran::lower::FirOpBuilder &bldr, mlir::Value index) { - auto rhsIndex = bldr.create(loc, index, lhsLen); - auto charVal = createLoadCharAt(from, rhsIndex); - createStoreCharAt(temp, index, charVal); + auto rhsIndex = bldr.create(loc, index, lhsLenIdx); + auto charVal = createLoadCharAt(fromBuff, rhsIndex); + createStoreCharAt(toBuff, index, charVal); }); return temp; } @@ -330,10 +418,6 @@ fir::CharBoxValue Fortran::lower::CharacterExprHelper::createConcatenate( fir::CharBoxValue Fortran::lower::CharacterExprHelper::createSubstring( const fir::CharBoxValue &box, llvm::ArrayRef bounds) { // Constant need to be materialize in memory to use fir.coordinate_of. - auto str = box; - if (needToMaterialize(box)) - str = materializeValue(box); - auto nbounds = bounds.size(); if (nbounds < 1 || nbounds > 2) { mlir::emitError(loc, "Incorrect number of bounds in substring"); @@ -342,23 +426,23 @@ fir::CharBoxValue Fortran::lower::CharacterExprHelper::createSubstring( mlir::SmallVector castBounds; // Convert bounds to length type to do safe arithmetic on it. for (auto bound : bounds) - castBounds.push_back(builder.createConvert(loc, getLengthType(), bound)); + castBounds.push_back( + builder.createConvert(loc, builder.getCharacterLengthType(), bound)); auto lowerBound = castBounds[0]; // FIR CoordinateOp is zero based but Fortran substring are one based. auto one = builder.createIntegerConstant(loc, lowerBound.getType(), 1); auto offset = builder.create(loc, lowerBound, one).getResult(); - auto idxType = builder.getIndexType(); - if (offset.getType() != idxType) - offset = builder.createConvert(loc, idxType, offset); - auto buff = builder.createConvert(loc, getSeqTy(str), str.getBuffer()); - auto substringRef = builder.create( - loc, getReferenceType(str), buff, offset); + auto addr = createElementAddr(box.getBuffer(), offset); + auto kind = getCharacterKind(box.getBuffer().getType()); + auto charTy = fir::CharacterType::getUnknownLen(builder.getContext(), kind); + auto resultType = builder.getRefType(charTy); + auto substringRef = builder.createConvert(loc, resultType, addr); // Compute the length. mlir::Value substringLen; if (nbounds < 2) { substringLen = - builder.create(loc, str.getLen(), castBounds[0]); + builder.create(loc, box.getLen(), castBounds[0]); } else { substringLen = builder.create(loc, castBounds[1], castBounds[0]); @@ -376,16 +460,52 @@ fir::CharBoxValue Fortran::lower::CharacterExprHelper::createSubstring( mlir::Value Fortran::lower::CharacterExprHelper::createLenTrim( const fir::CharBoxValue &str) { - return {}; + // Note: Runtime for LEN_TRIM should also be available at some + // point. For now use an inlined implementation. + auto indexType = builder.getIndexType(); + auto len = builder.createConvert(loc, indexType, str.getLen()); + auto one = builder.createIntegerConstant(loc, indexType, 1); + auto minusOne = builder.createIntegerConstant(loc, indexType, -1); + auto zero = builder.createIntegerConstant(loc, indexType, 0); + auto trueVal = builder.createIntegerConstant(loc, builder.getI1Type(), 1); + auto blank = createBlankConstantCode(getCharacterType(str)); + mlir::Value lastChar = builder.create(loc, len, one); + + auto iterWhile = + builder.create(loc, lastChar, zero, minusOne, trueVal, + /*returnFinalCount=*/false, lastChar); + auto insPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(iterWhile.getBody()); + auto index = iterWhile.getInductionVar(); + // Look for first non-blank from the right of the character. + auto fromBuff = getCharBoxBuffer(str); + auto elemAddr = createElementAddr(fromBuff, index); + auto codeAddr = + builder.createConvert(loc, builder.getRefType(blank.getType()), elemAddr); + auto c = builder.create(loc, codeAddr); + auto isBlank = + builder.create(loc, mlir::CmpIPredicate::eq, blank, c); + llvm::SmallVector results = {isBlank, index}; + builder.create(loc, results); + builder.restoreInsertionPoint(insPt); + // Compute length after iteration (zero if all blanks) + mlir::Value newLen = + builder.create(loc, iterWhile.getResult(1), one); + auto result = + builder.create(loc, iterWhile.getResult(0), zero, newLen); + return builder.createConvert(loc, builder.getCharacterLengthType(), result); } -mlir::Value Fortran::lower::CharacterExprHelper::createTemp(mlir::Type type, - int len) { - assert(type.isa() && "expected fir character type"); +fir::CharBoxValue +Fortran::lower::CharacterExprHelper::createCharacterTemp(mlir::Type type, + int len) { assert(len >= 0 && "expected positive length"); - fir::SequenceType::Shape shape{len}; - auto seqType = fir::SequenceType::get(shape, type); - return builder.create(loc, seqType); + auto kind = recoverCharacterType(type).getFKind(); + auto charType = fir::CharacterType::get(builder.getContext(), kind, len); + auto addr = builder.create(loc, charType); + auto mlirLen = + builder.createIntegerConstant(loc, builder.getCharacterLengthType(), len); + return {addr, mlirLen}; } // Returns integer with code for blank. The integer has the same @@ -399,48 +519,21 @@ mlir::Value Fortran::lower::CharacterExprHelper::createBlankConstantCode( mlir::Value Fortran::lower::CharacterExprHelper::createBlankConstant( fir::CharacterType type) { - return builder.createConvert(loc, type, createBlankConstantCode(type)); + return createSingletonFromCode(createBlankConstantCode(type), + type.getFKind()); } -void Fortran::lower::CharacterExprHelper::createCopy(mlir::Value dest, - mlir::Value src, - mlir::Value count) { - createCopy(toDataLengthPair(dest), toDataLengthPair(src), count); -} - -void Fortran::lower::CharacterExprHelper::createPadding(mlir::Value str, - mlir::Value lower, - mlir::Value upper) { - createPadding(toDataLengthPair(str), lower, upper); -} - -mlir::Value Fortran::lower::CharacterExprHelper::createSubstring( - mlir::Value str, llvm::ArrayRef bounds) { - return createEmbox(createSubstring(toDataLengthPair(str), bounds)); -} - -void Fortran::lower::CharacterExprHelper::createAssign(mlir::Value lhs, - mlir::Value rhs) { - createAssign(toDataLengthPair(lhs), toDataLengthPair(rhs)); -} - -mlir::Value -Fortran::lower::CharacterExprHelper::createLenTrim(mlir::Value str) { - return createLenTrim(toDataLengthPair(str)); -} - -void Fortran::lower::CharacterExprHelper::createAssign(mlir::Value lptr, - mlir::Value llen, - mlir::Value rptr, - mlir::Value rlen) { - createAssign(fir::CharBoxValue{lptr, llen}, fir::CharBoxValue{rptr, rlen}); -} - -mlir::Value -Fortran::lower::CharacterExprHelper::createConcatenate(mlir::Value lhs, - mlir::Value rhs) { - return createEmbox( - createConcatenate(toDataLengthPair(lhs), toDataLengthPair(rhs))); +void Fortran::lower::CharacterExprHelper::createAssign( + const fir::ExtendedValue &lhs, const fir::ExtendedValue &rhs) { + if (auto *str = rhs.getBoxOf()) { + if (auto *to = lhs.getBoxOf()) { + createAssign(*to, *str); + return; + } + } + TODO(loc, "character array assignment"); + // Note that it is not sure the array aspect should be handled + // by this utility. } mlir::Value @@ -451,46 +544,15 @@ Fortran::lower::CharacterExprHelper::createEmboxChar(mlir::Value addr, std::pair Fortran::lower::CharacterExprHelper::createUnboxChar(mlir::Value boxChar) { - auto box = toDataLengthPair(boxChar); - return {box.getBuffer(), box.getLen()}; -} - -mlir::Value -Fortran::lower::CharacterExprHelper::createCharacterTemp(mlir::Type type, - mlir::Value len) { - return createEmbox(createTemp(type, len)); -} - -std::pair -Fortran::lower::CharacterExprHelper::materializeCharacter(mlir::Value str) { - auto box = toDataLengthPair(str); - if (needToMaterialize(box)) - box = materializeValue(box); - return {box.getBuffer(), box.getLen()}; -} - -std::pair -Fortran::lower::CharacterExprHelper::materializeCharacterOrSequence( - mlir::Value str) { - if (auto ptrToTy = fir::dyn_cast_ptrEleTy(str.getType())) - if (auto seqTy = ptrToTy.dyn_cast()) { - // Handle linearization of an array in a scalar context. - auto eleTy = seqTy.getEleTy(); - assert(eleTy.isa() && seqTy.hasConstantShape()); - // Linearize the shape. - fir::SequenceType::Extent size = 1; - for (auto e : seqTy.getShape()) - size *= e; - fir::SequenceType::Shape newShape = {size}; - auto newTy = builder.getRefType(fir::SequenceType::get(newShape, eleTy)); - // Recast the buffer ref to look like a scalar. - auto buffer = builder.createConvert(loc, newTy, str); - // Cons the new cumulative length. - auto length = - builder.createIntegerConstant(loc, builder.getIndexType(), size); - return {buffer, length}; - } - return materializeCharacter(str); + using T = std::pair; + return toExtendedValue(boxChar).match( + [](const fir::CharBoxValue &b) -> T { + return {b.getBuffer(), b.getLen()}; + }, + [](const fir::CharArrayBoxValue &b) -> T { + return {b.getBuffer(), b.getLen()}; + }, + [](const auto &) -> T { llvm::report_fatal_error("not a character"); }); } bool Fortran::lower::CharacterExprHelper::isCharacterLiteral(mlir::Type type) { @@ -500,36 +562,73 @@ bool Fortran::lower::CharacterExprHelper::isCharacterLiteral(mlir::Type type) { return false; } -bool Fortran::lower::CharacterExprHelper::isCharacter(mlir::Type type) { +bool Fortran::lower::CharacterExprHelper::isCharacterScalar(mlir::Type type) { if (type.isa()) return true; - if (auto refType = type.dyn_cast()) - type = refType.getEleTy(); + if (auto pointedType = fir::dyn_cast_ptrEleTy(type)) + type = pointedType; + if (auto boxTy = type.dyn_cast()) + type = boxTy.getEleTy(); + if (auto pointedType = fir::dyn_cast_ptrEleTy(type)) + type = pointedType; if (auto seqType = type.dyn_cast()) - if (seqType.getShape().size() == 1) - type = seqType.getEleTy(); + return false; return type.isa(); } fir::KindTy Fortran::lower::CharacterExprHelper::getCharacterKind(mlir::Type type) { - return recoverCharacterType(type).getFKind(); + assert(isCharacterScalar(type) && "expected scalar character"); + return recoverCharacterType(type).getFKind(); } fir::KindTy Fortran::lower::CharacterExprHelper::getCharacterOrSequenceKind( mlir::Type type) { - return recoverCharacterType(type).getFKind(); + return recoverCharacterType(type).getFKind(); } bool Fortran::lower::CharacterExprHelper::isArray(mlir::Type type) { - if (auto boxTy = type.dyn_cast()) - type = boxTy.getEleTy(); - if (auto eleTy = fir::dyn_cast_ptrEleTy(type)) - type = eleTy; - if (auto seqTy = type.dyn_cast()) { - auto charTy = seqTy.getEleTy().dyn_cast(); - assert(charTy); - return (!charTy.singleton()) || (seqTy.getDimension() > 1); + return !isCharacterScalar(type); +} + +bool Fortran::lower::CharacterExprHelper::hasConstantLengthInType( + const fir::ExtendedValue &exv) { + auto charTy = recoverCharacterType(fir::getBase(exv).getType()); + return charTy.getLen() != fir::CharacterType::unknownLen(); +} + +mlir::Value +Fortran::lower::CharacterExprHelper::createSingletonFromCode(mlir::Value code, + int kind) { + auto charType = fir::CharacterType::get(builder.getContext(), kind, 1); + auto bits = builder.getKindMap().getCharacterBitsize(kind); + auto intType = builder.getIntegerType(bits); + auto cast = builder.createConvert(loc, intType, code); + auto undef = builder.create(loc, charType); + auto zero = builder.createIntegerConstant(loc, builder.getIndexType(), 0); + return builder.create(loc, charType, undef, cast, zero); +} + +mlir::Value Fortran::lower::CharacterExprHelper::extractCodeFromSingleton( + mlir::Value singleton) { + auto type = getCharacterType(singleton); + assert(type.getLen() == 1); + auto bits = builder.getKindMap().getCharacterBitsize(type.getFKind()); + auto intType = builder.getIntegerType(bits); + auto zero = builder.createIntegerConstant(loc, builder.getIndexType(), 0); + return builder.create(loc, intType, singleton, zero); +} + +mlir::Value +Fortran::lower::CharacterExprHelper::readLengthFromBox(mlir::Value box) { + auto lenTy = builder.getCharacterLengthType(); + auto size = builder.create(loc, lenTy, box); + auto charTy = recoverCharacterType(box.getType()); + auto bits = builder.getKindMap().getCharacterBitsize(charTy.getFKind()); + auto width = bits / 8; + if (width > 1) { + auto widthVal = builder.createIntegerConstant(loc, lenTy, width); + return builder.create(loc, size, widthVal); } - return false; + return size; } diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index f42f40cc2b589..25017367f4fbe 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -242,13 +242,12 @@ class ExprLowering { const fir::ExtendedValue &left, const fir::ExtendedValue &right) { if (auto *lhs = left.getUnboxed()) { - if (auto *rhs = right.getUnboxed()) { + if (auto *rhs = right.getUnboxed()) return Fortran::lower::genBoxCharCompare(converter, getLoc(), pred, *lhs, *rhs); - } else if (auto *rhs = right.getCharBox()) { + if (auto *rhs = right.getCharBox()) return Fortran::lower::genBoxCharCompare(converter, getLoc(), pred, *lhs, rhs->getBuffer()); - } } if (auto *lhs = left.getCharBox()) { if (auto *rhs = right.getCharBox()) { @@ -256,10 +255,10 @@ class ExprLowering { // addresses return Fortran::lower::genBoxCharCompare( converter, getLoc(), pred, lhs->getBuffer(), rhs->getBuffer()); - } else if (auto *rhs = right.getUnboxed()) { + } + if (auto *rhs = right.getUnboxed()) return Fortran::lower::genBoxCharCompare(converter, getLoc(), pred, lhs->getBuffer(), *rhs); - } } // Error if execution reaches this point @@ -1269,7 +1268,7 @@ class ExprLowering { return converter.genType(dt.category(), dt.kind()); llvm::report_fatal_error("derived types not implemented"); } - + template fir::ExtendedValue gen(const Fortran::evaluate::FunctionRef &func) { assert(func.GetType().has_value() && "function has no type"); @@ -1353,7 +1352,7 @@ class ExprLowering { symMap.addSymbol(dummySymbol, genExtAddr(*expr)); } auto result = genval(details.stmtFunction().value()); - LLVM_DEBUG(llvm::errs() << "stmt-function: " << result << '\n'); + LLVM_DEBUG(llvm::dbgs() << "stmt-function: " << result << '\n'); // Remove dummy local arguments from the map. for (const auto *dummySymbol : details.dummyArgs()) symMap.erase(*dummySymbol); @@ -1594,8 +1593,8 @@ mlir::Value Fortran::lower::createSomeExpression( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap) { Fortran::lower::ExpressionContext unused; - LLVM_DEBUG(llvm::errs() << "expr: "; expr.AsFortran(llvm::errs()); - llvm::errs() << '\n'); + LLVM_DEBUG(llvm::dbgs() << "expr: "; expr.AsFortran(llvm::dbgs()); + llvm::dbgs() << '\n'); return ExprLowering{loc, converter, symMap, unused}.genValue(expr); } @@ -1604,8 +1603,8 @@ fir::ExtendedValue Fortran::lower::createSomeExtendedExpression( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap, const Fortran::lower::ExpressionContext &context) { - LLVM_DEBUG(llvm::errs() << "expr: "; expr.AsFortran(llvm::errs()); - llvm::errs() << '\n'); + LLVM_DEBUG(llvm::dbgs() << "expr: "; expr.AsFortran(llvm::dbgs()); + llvm::dbgs() << '\n'); return ExprLowering{loc, converter, symMap, context}.genExtValue(expr); } @@ -1614,8 +1613,8 @@ mlir::Value Fortran::lower::createSomeAddress( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap) { Fortran::lower::ExpressionContext unused; - LLVM_DEBUG(llvm::errs() << "address: "; expr.AsFortran(llvm::errs()); - llvm::errs() << '\n'); + LLVM_DEBUG(llvm::dbgs() << "address: "; expr.AsFortran(llvm::dbgs()); + llvm::dbgs() << '\n'); return ExprLowering{loc, converter, symMap, unused}.genAddr(expr); } @@ -1624,8 +1623,8 @@ fir::ExtendedValue Fortran::lower::createSomeExtendedAddress( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap, const Fortran::lower::ExpressionContext &context) { - LLVM_DEBUG(llvm::errs() << "address: "; expr.AsFortran(llvm::errs()); - llvm::errs() << '\n'); + LLVM_DEBUG(llvm::dbgs() << "address: "; expr.AsFortran(llvm::dbgs()); + llvm::dbgs() << '\n'); return ExprLowering{loc, converter, symMap, context}.genExtAddr(expr); } @@ -1635,7 +1634,7 @@ fir::ExtendedValue Fortran::lower::createStringLiteral( assert(str.size() == len); Fortran::lower::SymMap unused1; Fortran::lower::ExpressionContext unused2; - LLVM_DEBUG(llvm::errs() << "string-lit: \"" << str << "\"\n"); + LLVM_DEBUG(llvm::dbgs() << "string-lit: \"" << str << "\"\n"); return ExprLowering{loc, converter, unused1, unused2}.genStringLit(str, len); } diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index fb82365b907c9..cea97ef92b61e 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -98,12 +98,12 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { specifics(fir::CodeGenSpecifics::get(module.getContext(), *fir::getTargetTriple(module), *fir::getKindMapping(module))) { - LLVM_DEBUG(llvm::errs() << "FIR type converter\n"); + LLVM_DEBUG(llvm::dbgs() << "FIR type converter\n"); // Each conversion should return a value of type mlir::LLVM::LLVMType. addConversion([&](fir::BoxType box) { return convertBoxType(box); }); addConversion([&](fir::BoxCharType boxchar) { - LLVM_DEBUG(llvm::errs() << "type convert: " << boxchar << '\n'); + LLVM_DEBUG(llvm::dbgs() << "type convert: " << boxchar << '\n'); return unwrap( convertType(specifics->boxcharMemoryType(boxchar.getEleTy()))); }); @@ -149,7 +149,7 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { unwrap(convertType(vecTy.getEleTy())), vecTy.getLen()); }); addConversion([&](mlir::TupleType tuple) { - LLVM_DEBUG(llvm::errs() << "type convert: " << tuple << '\n'); + LLVM_DEBUG(llvm::dbgs() << "type convert: " << tuple << '\n'); SmallVector inMembers; tuple.getFlattenedTypes(inMembers); SmallVector members; @@ -267,14 +267,17 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { // fir.complex | std.complex --> llvm<"{t,t}"> template mlir::LLVM::LLVMType convertComplexType(C cmplx) { - LLVM_DEBUG(llvm::errs() << "type convert: " << cmplx << '\n'); + LLVM_DEBUG(llvm::dbgs() << "type convert: " << cmplx << '\n'); auto eleTy = cmplx.getElementType(); return unwrap(convertType(specifics->complexMemoryType(eleTy))); } + // Get the default size of INTEGER. (The default size might have been set on + // the command line.) mlir::LLVM::LLVMType getDefaultInt() { - // FIXME: this should be tied to the front-end default - return mlir::LLVM::LLVMType::getInt64Ty(&getContext()); + return mlir::LLVM::LLVMType::getIntNTy( + &getContext(), + kindMapping.getIntegerBitsize(kindMapping.defaultIntegerKind())); } template diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index 69d956f7328f7..78861d5c98620 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -97,7 +97,7 @@ class EmboxConversion : public mlir::OpRewritePattern { auto xbox = rewriter.create(loc, embox.getType(), embox.memref(), shapeOpers, llvm::None, llvm::None, llvm::None, attrs); - LLVM_DEBUG(llvm::errs() << "rewriting " << embox << " to " << xbox << '\n'); + LLVM_DEBUG(llvm::dbgs() << "rewriting " << embox << " to " << xbox << '\n'); rewriter.replaceOp(embox, xbox.getOperation()->getResults()); return mlir::success(); } @@ -141,7 +141,7 @@ class EmboxConversion : public mlir::OpRewritePattern { auto xbox = rewriter.create(loc, embox.getType(), embox.memref(), shapeOpers, shiftOpers, sliceOpers, embox.getLenParams(), attrs); - LLVM_DEBUG(llvm::errs() << "rewriting " << embox << " to " << xbox << '\n'); + LLVM_DEBUG(llvm::dbgs() << "rewriting " << embox << " to " << xbox << '\n'); rewriter.replaceOp(embox, xbox.getOperation()->getResults()); return mlir::success(); } @@ -195,7 +195,7 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { auto xArrCoor = rewriter.create( loc, arrCoor.getType(), arrCoor.memref(), shapeOpers, shiftOpers, sliceOpers, arrCoor.indices(), arrCoor.lenParams(), attrs); - LLVM_DEBUG(llvm::errs() + LLVM_DEBUG(llvm::dbgs() << "rewriting " << arrCoor << " to " << xArrCoor << '\n'); rewriter.replaceOp(arrCoor, xArrCoor.getOperation()->getResults()); return mlir::success(); @@ -524,7 +524,7 @@ class TargetRewrite : public TargetRewriteBase { assert(callOp.callee().hasValue() && "indirect call not implemented"); auto newCall = rewriter->create(loc, callOp.callee().getValue(), newResTys, newOpers); - LLVM_DEBUG(llvm::errs() << "replacing call with " << newCall << '\n'); + LLVM_DEBUG(llvm::dbgs() << "replacing call with " << newCall << '\n'); if (wrap.hasValue()) replaceOp(callOp, (*wrap)(newCall.getOperation())); else @@ -627,13 +627,13 @@ class TargetRewrite : public TargetRewriteBase { for (auto ty : func.getResults()) if ((ty.isa() && !noCharacterConversion) || (isa_complex(ty) && !noComplexConversion)) { - LLVM_DEBUG(llvm::errs() << "rewrite " << signature << " for target\n"); + LLVM_DEBUG(llvm::dbgs() << "rewrite " << signature << " for target\n"); return false; } for (auto ty : func.getInputs()) if ((ty.isa() && !noCharacterConversion) || (isa_complex(ty) && !noComplexConversion)) { - LLVM_DEBUG(llvm::errs() << "rewrite " << signature << " for target\n"); + LLVM_DEBUG(llvm::dbgs() << "rewrite " << signature << " for target\n"); return false; } return true; @@ -752,7 +752,7 @@ class TargetRewrite : public TargetRewriteBase { mlir::Value load = rewriter->create(loc, cast); func.getArgument(fixup.index + 1).replaceAllUsesWith(load); func.front().eraseArgument(fixup.index + 1); - LLVM_DEBUG(llvm::errs() + LLVM_DEBUG(llvm::dbgs() << "old argument: " << oldArgTy.getEleTy() << ", repl: " << load << ", new argument: " << func.getArgument(fixup.index).getType() << '\n'); @@ -851,7 +851,7 @@ class TargetRewrite : public TargetRewriteBase { newInTys.insert(newInTys.end(), trailingTys.begin(), trailingTys.end()); auto newFuncTy = mlir::FunctionType::get(newInTys, newResTys, func.getContext()); - LLVM_DEBUG(llvm::errs() << "new func: " << newFuncTy << '\n'); + LLVM_DEBUG(llvm::dbgs() << "new func: " << newFuncTy << '\n'); func.setType(newFuncTy); for (auto &fixup : fixups) diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index 494e16a853f6a..1a54bda63af64 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -21,7 +21,7 @@ subroutine assign1(lhs, rhs) ! Copy of rhs into temp ! CHECK: fir.do_loop %[[i:.*]] = - ! CHECK: %[[rhs_addr2:.*]] = fir.convert %[[rhs]]#0 + ! CHECK: %[[rhs_addr2:.*]] = fir.convert %{{[0-9]+}}#0 ! CHECK-DAG: %[[rhs_addr:.*]] = fir.coordinate_of %[[rhs_addr2]], %[[i]] ! CHECK-DAG: %[[rhs_elt:.*]] = fir.load %[[rhs_addr]] ! CHECK-DAG: %[[tmp2:.*]] = fir.convert %[[tmp]] From 186cfc91e4ba2c3e3b9af6125409eb56210d0715 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Wed, 26 Aug 2020 15:47:36 +0530 Subject: [PATCH 0252/1017] [OpenMP][flang]Lower NUM_THREADS clause for parallel construct --- .../test/Lower/OpenMP/empty-omp-parallel.f90 | 30 ++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/flang/test/Lower/OpenMP/empty-omp-parallel.f90 b/flang/test/Lower/OpenMP/empty-omp-parallel.f90 index dd05c543669bb..e609a30d80754 100644 --- a/flang/test/Lower/OpenMP/empty-omp-parallel.f90 +++ b/flang/test/Lower/OpenMP/empty-omp-parallel.f90 @@ -10,6 +10,7 @@ program parallel integer :: a,b,c + integer :: num_threads ! This and last statements are just for the sake ensuring that the ! operation is created/inserted correctly and does not break/interfere with ! other pieces which may be present before/after the operation. @@ -17,6 +18,7 @@ program parallel ! statment. c = a + b !$OMP PARALLEL +!$OMP END PARALLEL !FIRDialect: omp.parallel { !FIRDialect-NEXT: omp.terminator !FIRDialect-NEXT: } @@ -25,9 +27,35 @@ program parallel !LLVMIRDialect-NEXT: omp.terminator !LLVMIRDialect-NEXT: } +!$OMP PARALLEL NUM_THREADS(16) +!$OMP END PARALLEL + num_threads = 4 +!$OMP PARALLEL NUM_THREADS(num_threads) +!$OMP END PARALLEL + +!FIRDialect: omp.parallel num_threads(%{{.*}} : i32) { +!FIRDialect-NEXT: omp.terminator +!FIRDialect-NEXT: } + +!LLVMIRDialect: omp.parallel num_threads(%{{.*}} : !llvm.i32) { +!LLVMIRDialect-NEXT: omp.terminator +!LLVMIRDialect-NEXT: } + + +!LLVMIR-LABEL: call i32 @__kmpc_global_thread_num(%struct.ident_t* @{{.*}}) !LLVMIR: call void{{.*}}@__kmpc_fork_call{{.*}}@[[OMP_OUTLINED_FN:.*]] to {{.*}} + +!LLVMIR: %[[GLOBAL_THREAD_NUM1:.*]] = call i32 @__kmpc_global_thread_num(%struct.ident_t* @{{.*}}) +!LLVMIR: call void @__kmpc_push_num_threads(%struct.ident_t* @{{.*}}, i32 %[[GLOBAL_THREAD_NUM1]], i32 16) +!LLVMIR: call void{{.*}}@__kmpc_fork_call{{.*}}@[[OMP_OUTLINED_FN1:.*]] to {{.*}} + +!LLVMIR: %[[GLOBAL_THREAD_NUM2:.*]] = call i32 @__kmpc_global_thread_num(%struct.ident_t* @{{.*}}) +!LLVMIR: call void @__kmpc_push_num_threads(%struct.ident_t* @{{.*}}, i32 %[[GLOBAL_THREAD_NUM2]], i32 %{{.*}}) +!LLVMIR: call void{{.*}}@__kmpc_fork_call{{.*}}@[[OMP_OUTLINED_FN2:.*]] to {{.*}} + +!LLVMIR: define internal void @[[OMP_OUTLINED_FN2]] +!LLVMIR: define internal void @[[OMP_OUTLINED_FN1]] !LLVMIR: define internal void @[[OMP_OUTLINED_FN]] -!$OMP END PARALLEL b = a + c end program From bcf10008544b0b571df443961127b7c5cc918454 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 14 Sep 2020 14:37:53 -0700 Subject: [PATCH 0253/1017] rebase and merge fallout defeat the broken fp type check in LLVMOpBase.td --- flang/include/flang/Lower/Bridge.h | 6 +++--- flang/lib/Lower/Bridge.cpp | 2 +- flang/test/lit.cfg.py | 5 +++-- flang/tools/bbc/bbc.cpp | 11 ++++++----- 4 files changed, 13 insertions(+), 11 deletions(-) diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h index af31b95ed1083..357ffdb281eea 100644 --- a/flang/include/flang/Lower/Bridge.h +++ b/flang/include/flang/Lower/Bridge.h @@ -55,7 +55,7 @@ class LoweringBridge { create(mlir::MLIRContext &ctx, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, - const Fortran::parser::AllCookedSource &allCooked, + const Fortran::parser::AllCookedSources &allCooked, llvm::Triple &triple, fir::NameUniquer &uniquer, fir::KindMapping &kindMap) { return LoweringBridge(ctx, defaultKinds, intrinsics, allCooked, triple, @@ -103,7 +103,7 @@ class LoweringBridge { mlir::MLIRContext &ctx, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, - const Fortran::parser::AllCookedSource &cooked, llvm::Triple &triple, + const Fortran::parser::AllCookedSources &cooked, llvm::Triple &triple, fir::NameUniquer &uniquer, fir::KindMapping &kindMap); LoweringBridge() = delete; LoweringBridge(const LoweringBridge &) = delete; @@ -111,7 +111,7 @@ class LoweringBridge { const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds; const Fortran::evaluate::IntrinsicProcTable &intrinsics; const Fortran::parser::AllCookedSources *cooked; - std::unique_ptr context; + mlir::MLIRContext &context; std::unique_ptr module; fir::KindMapping &kindMap; }; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 0c011a642495c..0634906ec456f 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2458,7 +2458,7 @@ Fortran::lower::LoweringBridge::LoweringBridge( mlir::MLIRContext &context, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, - const Fortran::parser::CookedSource &cooked, llvm::Triple &triple, + const Fortran::parser::AllCookedSources &cooked, llvm::Triple &triple, fir::NameUniquer &uniquer, fir::KindMapping &kindMap) : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked}, context{context}, kindMap{kindMap} { diff --git a/flang/test/lit.cfg.py b/flang/test/lit.cfg.py index c65274f1571c5..953255e62b84e 100644 --- a/flang/test/lit.cfg.py +++ b/flang/test/lit.cfg.py @@ -25,9 +25,10 @@ config.test_format = lit.formats.ShTest(not llvm_config.use_lit_shell) # suffixes: A list of file extensions to treat as test files. -config.suffixes = ['.c', '.cpp', '.f', '.F', '.ff', '.FOR', '.for', '.f77', '.f90', '.F90', +config.suffixes = ['.f', '.F', '.ff', '.FOR', '.for', '.f77', '.f90', '.F90', '.ff90', '.f95', '.F95', '.ff95', '.fpp', '.FPP', '.cuf' - '.CUF', '.f18', '.F18', '.fir', '.f03', '.F03', '.f08', '.F08'] + '.CUF', '.f18', '.F18', '.fir', '.f03', '.F03', '.f08', + '.F08'] # test_source_root: The root path where tests are located. config.test_source_root = os.path.dirname(__file__) diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index ec6958e7243fd..c623d51b48ee6 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -189,18 +189,18 @@ static mlir::LogicalResult convertFortranSourceToMLIR( // prep for prescan and parse options.searchDirectories = includeDirs; - Fortran::parser::Parsing parsing{semanticsContext.allSources()}; + Fortran::parser::Parsing parsing{semanticsContext.allCookedSources()}; parsing.Prescan(path, options); if (!parsing.messages().empty() && (warnIsError || parsing.messages().AnyFatalError())) { llvm::errs() << programPrefix << "could not scan " << path << '\n'; - parsing.messages().Emit(llvm::errs(), parsing.cooked()); + parsing.messages().Emit(llvm::errs(), parsing.allCooked()); return mlir::failure(); } // parse the input Fortran parsing.Parse(llvm::outs()); - parsing.messages().Emit(llvm::errs(), parsing.cooked()); + parsing.messages().Emit(llvm::errs(), parsing.allCooked()); if (!parsing.consumedWholeFile()) { parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(), "parser FAIL (final position)"); @@ -244,7 +244,7 @@ static mlir::LogicalResult convertFortranSourceToMLIR( fir::KindMapping kindMap( &ctx, llvm::ArrayRef{fromDefaultKinds(defKinds)}); auto burnside = Fortran::lower::LoweringBridge::create( - ctx, defKinds, semanticsContext.intrinsics(), parsing.cooked(), triple, + ctx, defKinds, semanticsContext.intrinsics(), parsing.allCooked(), triple, nameUniquer, kindMap); burnside.lower(parseTree, semanticsContext); mlir::ModuleOp mlirModule = burnside.getModule(); @@ -352,8 +352,9 @@ int main(int argc, char **argv) { Fortran::common::IntrinsicTypeDefaultKinds defaultKinds; Fortran::parser::AllSources allSources; + Fortran::parser::AllCookedSources allCookedSources(allSources); Fortran::semantics::SemanticsContext semanticsContext{ - defaultKinds, options.features, allSources}; + defaultKinds, options.features, allCookedSources}; semanticsContext.set_moduleDirectory(moduleDir) .set_moduleFileSuffix(moduleSuffix) .set_searchDirectories(includeDirs) From fbe848b1a8c5a856d215d3c6fdbddd3e1a7dd327 Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 14 Sep 2020 14:11:12 -0700 Subject: [PATCH 0254/1017] Fixes the CFG bug with explicit (trivially dominating) terminator. --- flang/lib/Lower/Bridge.cpp | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 0634906ec456f..c1c24df4c32f6 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -544,14 +544,17 @@ class FirConverter : public Fortran::lower::AbstractConverter { genFIRConditionalBranch(cond, trueTarget->block, falseTarget->block); } - // + //===----------------------------------------------------------------------===// // Termination of symbolically referenced execution units - // + //===----------------------------------------------------------------------===// /// END of program /// /// Generate the cleanup block before the program exits - void genExitRoutine() { builder->create(toLocation()); } + void genExitRoutine() { + if (blockIsUnterminated()) + builder->create(toLocation()); + } void genFIR(const Fortran::parser::EndProgramStmt &) { genExitRoutine(); } /// END of procedure-like constructs From b0537c471880c636ce127f1a1bab63f06232669e Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Tue, 15 Sep 2020 13:49:24 -0700 Subject: [PATCH 0255/1017] Fix some problems on macos `timeval.tv_usec` is int on macos, not long, so there was a warning about using `snprintf` with %03ld format conversion. Use an explicit type of std::maxint_t and %03jd to avoid warnings regardless of the type. `OSType::Darwin` was an unknown target. Do the same thing for it as for Linux. --- flang/lib/Optimizer/CodeGen/Target.cpp | 2 ++ flang/runtime/clock.cpp | 5 +++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/Target.cpp b/flang/lib/Optimizer/CodeGen/Target.cpp index bab10e5bee6ec..dfda81ac9924d 100644 --- a/flang/lib/Optimizer/CodeGen/Target.cpp +++ b/flang/lib/Optimizer/CodeGen/Target.cpp @@ -173,6 +173,7 @@ fir::CodeGenSpecifics::get(mlir::MLIRContext *ctx, llvm::Triple &trp, default: break; case llvm::Triple::OSType::Linux: + case llvm::Triple::OSType::Darwin: return std::make_unique(ctx, trp, kindMap); } break; @@ -181,6 +182,7 @@ fir::CodeGenSpecifics::get(mlir::MLIRContext *ctx, llvm::Triple &trp, default: break; case llvm::Triple::OSType::Linux: + case llvm::Triple::OSType::Darwin: return std::make_unique(ctx, trp, kindMap); } break; diff --git a/flang/runtime/clock.cpp b/flang/runtime/clock.cpp index 8861fe0591d28..9f5b04b6f62fe 100644 --- a/flang/runtime/clock.cpp +++ b/flang/runtime/clock.cpp @@ -10,6 +10,7 @@ #include "clock.h" #include +#include #include #include #include @@ -43,8 +44,8 @@ void RTNAME(DateAndTime)(char *date, char *time, char *zone, copyBufferAndPad(date, dateChars, len); } if (time) { - auto ms{t.tv_usec / 1000}; - auto len{::snprintf(buffer, buffSize, "%02d%02d%02d.%03ld", + std::intmax_t ms{t.tv_usec / 1000}; + auto len{::snprintf(buffer, buffSize, "%02d%02d%02d.%03jd", localTime.tm_hour, localTime.tm_min, localTime.tm_sec, ms)}; copyBufferAndPad(time, timeChars, len); } From a7af6ada60120ac51472bf51d967e1632b3da877 Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 15 Sep 2020 12:56:01 -0700 Subject: [PATCH 0256/1017] Finish a TODO in IO lowering for generating unreachable op. Fixes regressions introduced in lowering runtime calls that do not return. [NFC] tweak comment to reflect the fix --- flang/lib/Lower/Runtime.cpp | 23 +++++++++++++++++------ flang/test/Lower/format.f90 | 33 +++++++++++++++++---------------- flang/test/Lower/stop.f90 | 5 +++++ 3 files changed, 39 insertions(+), 22 deletions(-) diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index 93ba4356dc9ab..d3e6381866f6b 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -57,6 +57,15 @@ static void noRuntimeSupport(mlir::Location loc, llvm::StringRef stmt) { std::exit(1); } +/// Runtime calls that do not return to the caller indicate this condition by +/// terminating the current basic block with an unreachable op. +static void genUnreachable(Fortran::lower::FirOpBuilder &builder, + mlir::Location loc) { + builder.create(loc); + auto *newBlock = builder.getBlock()->splitBlock(builder.getInsertionPoint()); + builder.setInsertionPointToStart(newBlock); +} + //===----------------------------------------------------------------------===// // Misc. Fortran statements that lower to runtime calls //===----------------------------------------------------------------------===// @@ -106,14 +115,16 @@ void Fortran::lower::genStopStatement( op = builder.createConvert(loc, type, op); } builder.create(loc, callee, operands); + genUnreachable(builder, loc); } void Fortran::lower::genFailImageStatement( Fortran::lower::AbstractConverter &converter) { - auto &bldr = converter.getFirOpBuilder(); + auto &builder = converter.getFirOpBuilder(); auto loc = converter.getCurrentLocation(); - auto callee = genRuntimeFunction(loc, bldr); - bldr.create(loc, callee, llvm::None); + auto callee = genRuntimeFunction(loc, builder); + builder.create(loc, callee, llvm::None); + genUnreachable(builder, loc); } void Fortran::lower::genEventPostStatement( @@ -175,10 +186,10 @@ void Fortran::lower::genSyncTeamStatement( void Fortran::lower::genPauseStatement( Fortran::lower::AbstractConverter &converter, const Fortran::parser::PauseStmt &) { - auto &bldr = converter.getFirOpBuilder(); + auto &builder = converter.getFirOpBuilder(); auto loc = converter.getCurrentLocation(); - auto callee = genRuntimeFunction(loc, bldr); - bldr.create(loc, callee, llvm::None); + auto callee = genRuntimeFunction(loc, builder); + builder.create(loc, callee, llvm::None); } void Fortran::lower::genDateAndTime(Fortran::lower::FirOpBuilder &builder, diff --git a/flang/test/Lower/format.f90 b/flang/test/Lower/format.f90 index ce0f736e1056f..898fdf3de9d5d 100644 --- a/flang/test/Lower/format.f90 +++ b/flang/test/Lower/format.f90 @@ -6,28 +6,29 @@ function formatAssign() integer :: label logical :: flag - ! CHECK: select + ! CHECK-DAG: %[[ONE:.*]] = constant 100 : i32 + ! CHECK-DAG: %[[TWO:.*]] = constant 200 : i32 + ! CHECK: %{{.*}} = select %{{.*}}, %[[ONE]], %[[TWO]] : i32 if (flag) then assign 100 to label else assign 200 to label end if - ! CHECK: fir.select {{.*\[100, \^bb[0-9]+, 200, \^bb[0-9]+, unit, \^bb[0-9]+\]}} - ! CHECK-LABEL: ^bb{{[0-9]+}}: - ! CHECK: fir.address_of - ! CHECK: br [[END_BLOCK:\^bb[0-9]+]]{{(.*)}} - ! CHECK-LABEL: ^bb{{[0-9]+}}: // - ! CHECK: fir.address_of - ! CHECK: br [[END_BLOCK]] - ! CHECK-LABEL: ^bb{{[0-9]+}}: // - ! CHECK: fir.address_of - ! CHECK: br [[END_BLOCK]] - ! CHECK-LABEL: ^bb{{[0-9]+(.*)}}: // - ! CHECK: call{{.*}}BeginExternalFormattedOutput - ! CHECK-DAG: call{{.*}}OutputAscii - ! CHECK-DAG: call{{.*}}OutputReal32 - ! CHECK: call{{.*}}EndIoStatement + ! CHECK: fir.select %{{.*}} [100, ^bb[[BLK1:.*]], 200, ^bb[[BLK2:.*]], unit, ^bb[[BLK3:.*]]] + ! CHECK: ^bb[[BLK1]]: + ! CHECK: fir.address_of(@_QQcl + ! CHECK: br ^bb[[END_BLOCK:.*]]( + ! CHECK: ^bb[[BLK2]]: + ! CHECK: fir.address_of(@_QQcl + ! CHECK: br ^bb[[END_BLOCK]]( + ! CHECK: ^bb[[BLK3]]: + ! CHECK-NEXT: fir.unreachable + ! CHECK: ^bb[[END_BLOCK]]( + ! CHECK: fir.call @{{.*}}BeginExternalFormattedOutput + ! CHECK: fir.call @{{.*}}OutputAscii + ! CHECK: fir.call @{{.*}}OutputReal32 + ! CHECK: fir.call @{{.*}}EndIoStatement pi = 3.141592653589 write(*, label) "PI=", pi diff --git a/flang/test/Lower/stop.f90 b/flang/test/Lower/stop.f90 index 3643d8a0e8e2f..b708da8a44ef5 100644 --- a/flang/test/Lower/stop.f90 +++ b/flang/test/Lower/stop.f90 @@ -5,6 +5,7 @@ subroutine stop_test(b) ! CHECK-DAG: %[[c0:.*]] = constant 0 : i32 ! CHECK-DAG: %[[false:.*]] = constant false ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[false]]) + ! CHECK-NEXT: fir.unreachable stop end subroutine @@ -14,6 +15,7 @@ subroutine stop_code() ! CHECK-DAG: %[[c42:.*]] = constant 42 : i32 ! CHECK-DAG: %[[false:.*]] = constant false ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c42]], %[[false]], %[[false]]) + ! CHECK-NEXT: fir.unreachable end subroutine ! CHECK-LABEL stop_error @@ -23,6 +25,7 @@ subroutine stop_error() ! CHECK-DAG: %[[true:.*]] = constant true ! CHECK-DAG: %[[false:.*]] = constant false ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[true]], %[[false]]) + ! CHECK-NEXT: fir.unreachable end subroutine ! CHECK-LABEL stop_quiet @@ -34,6 +37,7 @@ subroutine stop_quiet(b) ! CHECK-DAG: %[[b:.*]] = fir.load %arg0 ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[bi1]]) + ! CHECK-NEXT: fir.unreachable end subroutine ! CHECK-LABEL stop_error_code_quiet @@ -45,6 +49,7 @@ subroutine stop_error_code_quiet(b) ! CHECK-DAG: %[[b:.*]] = fir.load %arg0 ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c66]], %[[true]], %[[bi1]]) + ! CHECK-NEXT: fir.unreachable end subroutine ! CHECK: func @_Fortran{{.*}}StopStatement(i32, i1, i1) -> none From 8be4542557895a23635cdea823f69eba68cdf6b3 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 10 Sep 2020 10:51:34 -0700 Subject: [PATCH 0257/1017] Update the lowering of COMMON blocks to match changes in the front-end. Update the handling of EQUIVALENCE alias groups for correctness. Fix fm302 --- flang/include/flang/Lower/PFTBuilder.h | 38 +-- flang/lib/Lower/Bridge.cpp | 371 +++++++++++++++++-------- flang/lib/Lower/IntervalSet.h | 43 +++ flang/lib/Lower/PFTBuilder.cpp | 201 ++++++-------- flang/unittests/Lower/CMakeLists.txt | 3 +- flang/unittests/Lower/IntervalSet.cpp | 67 +++++ 6 files changed, 479 insertions(+), 244 deletions(-) create mode 100644 flang/unittests/Lower/IntervalSet.cpp diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index f0c80fb11fdea..0ea0ea49cb88f 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -34,9 +34,7 @@ class Scope; } // namespace semantics namespace lower { -/// Disambiguate between variables that are declared inside a COMMON block and -/// variables that slide into a COMMON block by EQUIVALENCE. -bool declaredInCommonBlock(const semantics::Symbol &sym); +bool definedInCommonBlock(const semantics::Symbol &sym); namespace pft { @@ -117,8 +115,8 @@ using ActionStmts = std::tuple< parser::ComputedGotoStmt, parser::ForallStmt, parser::ArithmeticIfStmt, parser::AssignStmt, parser::AssignedGotoStmt, parser::PauseStmt>; -using OtherStmts = std::tuple; +using OtherStmts = + std::tuple; using ConstructStmts = std::tuple< parser::AssociateStmt, parser::EndAssociateStmt, parser::BlockStmt, @@ -383,6 +381,9 @@ struct Variable { Nominal(const semantics::Symbol *symbol, int depth, bool global) : symbol{symbol}, depth{depth}, global{global} {} const semantics::Symbol *symbol{}; + + bool isGlobal() const { return global; } + int depth{}; bool global{}; bool heapAlloc{}; // variable needs deallocation on exit @@ -395,31 +396,30 @@ struct Variable { using Interval = std::tuple; /// An interval of storage is a contiguous block of memory to be allocated or - /// mapped onto another variable. Aliaser variables will be pointers into + /// mapped onto another variable. Aliasing variables will be pointers into /// interval stores and may overlap each other. struct IntervalStore { - IntervalStore(Interval &&interval, bool global) - : interval{std::move(interval)}, global{global} {} - IntervalStore(Interval &&interval, bool global, - const semantics::Symbol *obj, std::size_t offset) - : interval{std::move(interval)}, global{global}, obj{obj}, - offset{offset} {} + IntervalStore(Interval &&interval) : interval{std::move(interval)} {} + IntervalStore(Interval &&interval, + const llvm::SmallVector &vars) + : interval{std::move(interval)}, vars{vars} {} + + bool isGlobal() const { return vars.size() > 0; } + Interval interval{}; - bool global{}; - const semantics::Symbol *obj{}; - std::size_t offset{}; // offset of obj relative to interval + llvm::SmallVector vars{}; }; explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false, int depth = 0) : var{Nominal(&sym, depth, global)} {} - explicit Variable(Interval &&interval, bool global = false) - : var{IntervalStore(std::move(interval), global)} {} + explicit Variable(Interval &&interval) + : var{IntervalStore(std::move(interval))} {} explicit Variable(IntervalStore &&istore) : var{std::move(istore)} {} /// Return the front-end symbol for a nominal variable. const Fortran::semantics::Symbol &getSymbol() const { - assert(hasSymbol()); + assert(hasSymbol() && "variable is not nominal"); return *std::get(var).symbol; } @@ -445,7 +445,7 @@ struct Variable { /// Is this variable a global? bool isGlobal() const { - return std::visit([](const auto &x) { return x.global; }, var); + return std::visit([](const auto &x) { return x.isGlobal(); }, var); } bool isHeapAlloc() const { diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index c1c24df4c32f6..2e4fcbbe21922 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -385,6 +385,22 @@ class FirConverter : public Fortran::lower::AbstractConverter { bridge.getDefaultKinds(), tc); } + // FIXME: Should we fold the CHARACTER fixup into genType itself? + mlir::Type genTypeWithCharFixup(Fortran::lower::SymbolRef sym) { + auto symTy = genType(sym); + if (symTy.isa()) { + auto paramVal = sym->GetType()->characterTypeSpec().length(); + auto expr = paramVal.GetExplicit(); + assert(expr); + auto eval = Fortran::evaluate::AsGenericExpr(std::move(*expr)); + auto lenVal = Fortran::evaluate::ToInt64(eval); + assert(lenVal); + fir::SequenceType::Shape len = {*lenVal}; + symTy = fir::SequenceType::get(len, symTy); + } + return symTy; + } + mlir::Location getCurrentLocation() override final { return toLocation(); } /// Generate a dummy location. @@ -1743,91 +1759,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto addrOf = builder->create(loc, global.resultType(), global.getSymbol()); mapSymbolAttributes(var, storeMap, addrOf); - } else if (const auto *details = - sym.detailsIf()) { - //===----------------------------------------------------------------===// - // COMMON blocks - //===----------------------------------------------------------------===// - const int64_t sz = static_cast(sym.size()); - bool hasInit = [&]() { - for (const auto &obj : details->objects()) - if (const auto *objDet = - obj->detailsIf()) - if (objDet->init()) - return true; - return false; - }(); - if (!sym.name().size() || !hasInit) { - // anonymous COMMON must always be initialized to zero - // a named COMMON sans initializers is also initialized to zero - auto linkage = builder->createCommonLinkage(); - fir::SequenceType::Shape shape = {sz}; - auto i8Ty = builder->getIntegerType(8); - auto commonTy = fir::SequenceType::get(shape, i8Ty); - auto vecTy = mlir::VectorType::get(sz, i8Ty); - mlir::Attribute zero = builder->getIntegerAttr(i8Ty, 0); - auto init = - mlir::DenseElementsAttr::get(vecTy, llvm::makeArrayRef(zero)); - global = - builder->createGlobal(loc, commonTy, globalName, linkage, init); - } else { - // FIXME? For now let the layout be determined by the target data - // layout. This may need to be revisited if the target data layout is - // insufficient to layout Fortran COMMON blocks. - // The target data layout is the better solution because it is selected - // by the instance of flang's chosen target rather than by properties of - // the build machine. - mlir::TupleType commonTy = [&]() { - llvm::SmallVector members; - for (const auto &obj : details->objects()) { - auto memTy = genType(*obj); - if (memTy.isa()) { - auto paramVal = obj->GetType()->characterTypeSpec().length(); - auto expr = paramVal.GetExplicit(); - assert(expr); - auto eval = Fortran::evaluate::AsGenericExpr(std::move(*expr)); - auto lenVal = Fortran::evaluate::ToInt64(eval); - assert(lenVal); - fir::SequenceType::Shape len; - len.push_back(*lenVal); - memTy = fir::SequenceType::get(len, memTy); - } - members.push_back(memTy); - } - return mlir::TupleType::get(members, builder->getContext()); - }(); - auto linkage = builder->createLinkOnceLinkage(); - auto initFunc = [&](Fortran::lower::FirOpBuilder &builder) { - mlir::Value cb = builder.create(loc, commonTy); - unsigned offset = 0; - // Assume that the members of the COMMON block will appear in an order - // that is sorted by offset. - [[maybe_unused]] std::int64_t lastByteOff = -1; - LLVM_DEBUG(llvm::dbgs() << "block {\n"); - for (const auto &obj : details->objects()) { - assert(lastByteOff < static_cast(obj->offset())); - lastByteOff = static_cast(obj->offset()); - LLVM_DEBUG(llvm::dbgs() << "offset: " << obj->offset() << '\n'); - if (const auto *objDet = - obj->detailsIf()) - if (objDet->init()) { - auto initVal = genInitializerExprValue(objDet->init().value()); - auto off = builder.createIntegerConstant(loc, idxTy, offset); - auto castVal = builder.createConvert( - loc, commonTy.getType(offset++), fir::getBase(initVal)); - cb = builder.create(loc, commonTy, cb, - castVal, off); - } - } - LLVM_DEBUG(llvm::dbgs() << "}\n"); - builder.create(loc, cb); - }; - global = builder->createGlobal(loc, commonTy, globalName, - /*isConstant=*/false, initFunc, linkage); - } - auto addrOf = builder->create(loc, global.resultType(), - global.getSymbol()); - addSymbol(sym, addrOf); + } else if (sym.has()) { + llvm_unreachable("COMMON symbol processed elsewhere"); } else { TODO(); // Procedure pointer or something else } @@ -1871,25 +1804,88 @@ class FirConverter : public Fortran::lower::AbstractConverter { void instantiateAggregateStore( const Fortran::lower::pft::Variable &var, llvm::DenseMap &storeMap) { - assert(var.isAggregateStore()); + assert(var.isAggregateStore() && "not an interval"); auto off = std::get<0>(var.getInterval()); auto i8Ty = builder->getIntegerType(8); auto loc = toLocation(); auto idxTy = builder->getIndexType(); if (var.isGlobal()) { + //===----------------------------------------------------------------===// + // Aliased (EQUIVALENCE) variables with initializers + //===----------------------------------------------------------------===// auto &st = var.getAggregateStore(); - // global address must already be in the map - auto addr = lookupSymbol(*st.obj); - assert(addr && "global variable must already be in map"); - auto i8PtrTy = builder->getRefType(builder->getVarLenSeqTy(i8Ty)); - auto i8Addr = builder->createConvert(loc, i8PtrTy, addr); - // adjust for displacement of the global variable relative to the - // aggregate interval - llvm::SmallVector offs = { - builder->createIntegerConstant(loc, idxTy, off - st.offset)}; - auto stAddr = - builder->create(loc, i8PtrTy, i8Addr, offs); - storeMap[off] = stAddr; + // The scope of this aggregate is this procedure. + auto aggName = mangleName(*st.vars[0]); + mlir::TupleType aggTy = [&]() { + llvm::SmallVector members; + std::size_t counter = std::get<0>(st.interval); + for (const auto *mem : st.vars) { + if (const auto *memDet = + mem->detailsIf()) { + if (mem->offset() > counter) { + fir::SequenceType::Shape len = { + static_cast(mem->offset() - + counter)}; + auto byteTy = builder->getIntegerType(8); + auto memTy = fir::SequenceType::get(len, byteTy); + members.push_back(memTy); + counter = mem->offset(); + } + if (memDet->init()) { + auto memTy = genTypeWithCharFixup(*mem); + members.push_back(memTy); + counter = mem->offset() + mem->size(); + } + } + } + if (counter < std::get<0>(st.interval) + std::get<1>(st.interval)) { + fir::SequenceType::Shape len = { + static_cast(std::get<0>(st.interval) + + std::get<1>(st.interval) - + counter)}; + auto memTy = fir::SequenceType::get(len, i8Ty); + members.push_back(memTy); + } + return mlir::TupleType::get(members, builder->getContext()); + }(); + auto initFunc = [&](Fortran::lower::FirOpBuilder &builder) { + mlir::Value cb = builder.create(loc, aggTy); + unsigned tupIdx = 0; + std::size_t offset = std::get<0>(st.interval); + LLVM_DEBUG(llvm::dbgs() << "equivalence {\n"); + for (const auto *mem : st.vars) { + if (const auto *memDet = + mem->detailsIf()) { + if (mem->offset() > offset) { + ++tupIdx; + offset = mem->offset(); + } + if (memDet->init()) { + LLVM_DEBUG(llvm::dbgs() << "offset: " << mem->offset() << " is " + << *mem << '\n'); + auto initVal = genInitializerExprValue(memDet->init().value()); + auto offVal = builder.createIntegerConstant(loc, idxTy, tupIdx); + auto castVal = builder.createConvert(loc, aggTy.getType(tupIdx), + fir::getBase(initVal)); + cb = builder.create(loc, aggTy, cb, castVal, + offVal); + ++tupIdx; + offset = mem->offset() + mem->size(); + } + } + } + LLVM_DEBUG(llvm::dbgs() << "}\n"); + builder.create(loc, cb); + }; + auto linkage = builder->createInternalLinkage(); + auto agg = builder->createGlobal(loc, aggTy, aggName, + /*isConstant=*/false, initFunc, linkage); + auto addr = builder->create(loc, agg.resultType(), + agg.getSymbol()); + auto varTy = builder->getRefType(genType(*st.vars[0])); + auto result = builder->createConvert(loc, varTy, addr); + storeMap[off] = result; + addSymbol(*st.vars[0], result); return; } // Allocate an anonymous block of memory. @@ -2141,19 +2137,139 @@ class FirConverter : public Fortran::lower::AbstractConverter { addSymbol(sym, local); } + using CommonBlockMap = + llvm::DenseMap>; + /// The COMMON block is a global structure. `var` will be at some offset /// within the COMMON block. Adds the address of `var` (COMMON + offset) to /// the symbol map. void instantiateCommon(const Fortran::semantics::Symbol &common, const Fortran::lower::pft::Variable &var, - llvm::DenseMap &storeMap) { + llvm::DenseMap &storeMap, + const CommonBlockMap &cmnBlkMap) { auto commonName = mangleName(common); auto global = builder->getNamedGlobal(commonName); - if (!global) - instantiateGlobal(Fortran::lower::pft::Variable{common, true}, storeMap); - auto commonAddr = lookupSymbol(common); const auto &varSym = var.getSymbol(); auto loc = genLocation(varSym.name()); + if (!global) { + if (common.has()) { + //===--------------------------------------------------------------===// + // COMMON blocks + //===--------------------------------------------------------------===// + auto idxTy = builder->getIndexType(); + const auto sz = static_cast(common.size()); + auto cmnBlkMems = cmnBlkMap.lookup(&common); + std::sort(cmnBlkMems.begin(), cmnBlkMems.end(), [](auto *s1, auto *s2) { + return s1->offset() < s2->offset(); + }); + bool hasInit = [&]() { + for (const auto *mem : cmnBlkMems) { + LLVM_DEBUG(llvm::dbgs() << "common member: " << *mem << '\n'); + if (const auto *memDet = + mem->detailsIf()) + if (memDet->init()) + return true; + } + return false; + }(); + if (!common.name().size() || !hasInit) { + // anonymous COMMON must always be initialized to zero + // a named COMMON sans initializers is also initialized to zero + auto linkage = builder->createCommonLinkage(); + fir::SequenceType::Shape shape = {sz}; + auto i8Ty = builder->getIntegerType(8); + auto commonTy = fir::SequenceType::get(shape, i8Ty); + auto vecTy = mlir::VectorType::get(sz, i8Ty); + mlir::Attribute zero = builder->getIntegerAttr(i8Ty, 0); + auto init = + mlir::DenseElementsAttr::get(vecTy, llvm::makeArrayRef(zero)); + global = + builder->createGlobal(loc, commonTy, commonName, linkage, init); + } else { + // COMMON has some initial values + // determine a type compatible with the initializers presented + mlir::TupleType commonTy = [&]() { + llvm::SmallVector members; + std::size_t counter = 0; + for (const auto *mem : cmnBlkMems) { + if (const auto *memDet = + mem->detailsIf< + Fortran::semantics::ObjectEntityDetails>()) { + if (mem->offset() > counter) { + fir::SequenceType::Shape len = { + static_cast(mem->offset() - + counter)}; + auto byteTy = builder->getIntegerType(8); + auto memTy = fir::SequenceType::get(len, byteTy); + members.push_back(memTy); + counter = mem->offset(); + } + if (memDet->init()) { + auto memTy = genTypeWithCharFixup(*mem); + members.push_back(memTy); + counter = mem->offset() + mem->size(); + } + } + } + if (counter < common.size()) { + fir::SequenceType::Shape len = { + static_cast(common.size() - + counter)}; + auto byteTy = builder->getIntegerType(8); + auto memTy = fir::SequenceType::get(len, byteTy); + members.push_back(memTy); + } + return mlir::TupleType::get(members, builder->getContext()); + }(); + // lambda to initialize the body of the global with the initial values + auto initFunc = [&](Fortran::lower::FirOpBuilder &builder) { + mlir::Value cb = builder.create(loc, commonTy); + unsigned tupIdx = 0; + std::size_t offset = 0; + LLVM_DEBUG(llvm::dbgs() << "block {\n"); + for (const auto *mem : cmnBlkMems) { + if (const auto *memDet = + mem->detailsIf< + Fortran::semantics::ObjectEntityDetails>()) { + if (mem->offset() > offset) { + ++tupIdx; + offset = mem->offset(); + } + if (memDet->init()) { + LLVM_DEBUG(llvm::dbgs() << "offset: " << mem->offset() + << " is " << *mem << '\n'); + auto initVal = + genInitializerExprValue(memDet->init().value()); + auto offVal = + builder.createIntegerConstant(loc, idxTy, tupIdx); + auto castVal = builder.createConvert( + loc, commonTy.getType(tupIdx), fir::getBase(initVal)); + cb = builder.create(loc, commonTy, cb, + castVal, offVal); + ++tupIdx; + offset = mem->offset() + mem->size(); + } + } + } + LLVM_DEBUG(llvm::dbgs() << "}\n"); + builder.create(loc, cb); + }; + auto linkage = builder->createLinkOnceLinkage(); + // create the global object + global = + builder->createGlobal(loc, commonTy, commonName, + /*isConstant=*/false, initFunc, linkage); + } + // introduce a local AddrOf and add it to the map + auto addrOf = builder->create(loc, global.resultType(), + global.getSymbol()); + addSymbol(common, addrOf); + } else { + llvm_unreachable("must be a common symbol"); + } + } + auto commonAddr = lookupSymbol(common); if (!commonAddr) { commonAddr = builder->create(loc, global.resultType(), global.getSymbol()); @@ -2167,23 +2283,26 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::SmallVector offs{builder->createIntegerConstant( loc, builder->getIndexType(), byteOffset)}; auto varAddr = builder->create(loc, i8Ptr, base, offs); - auto localTy = builder->getRefType(genType(var)); + auto localTy = builder->getRefType(genTypeWithCharFixup(var.getSymbol())); mlir::Value local = builder->createConvert(loc, localTy, varAddr); mapSymbolAttributes(var, storeMap, local); } void instantiateVar(const Fortran::lower::pft::Variable &var, - llvm::DenseMap &storeMap) { - if (var.isAggregateStore()) + llvm::DenseMap &storeMap, + CommonBlockMap *cmnBlkMap = nullptr) { + if (var.isAggregateStore()) { instantiateAggregateStore(var, storeMap); - else if (Fortran::lower::declaredInCommonBlock(var.getSymbol())) + } else if (Fortran::lower::definedInCommonBlock(var.getSymbol())) { + assert(cmnBlkMap); instantiateCommon( *Fortran::semantics::FindCommonBlockContaining(var.getSymbol()), var, - storeMap); - else if (var.isGlobal()) + storeMap, *cmnBlkMap); + } else if (var.isGlobal()) { instantiateGlobal(var, storeMap); - else + } else { instantiateLocal(var, storeMap); + } } void mapDummiesAndResults(const Fortran::lower::pft::FunctionLikeUnit &funit, @@ -2236,6 +2355,21 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Value primaryFuncResult; llvm::SmallVector deferredFuncResultList; + + CommonBlockMap commonBlockMap; + for (const auto &var : funit.getOrderedSymbolTable()) { + if (var.isAggregateStore()) + continue; + const Fortran::semantics::Symbol *sym = &var.getSymbol(); + if (const auto *cmnBlk = + Fortran::semantics::FindCommonBlockContaining(*sym)) { + LLVM_DEBUG(llvm::dbgs() + << "adding " << toStringRef(sym->name()) << " to /" + << toStringRef(cmnBlk->name()) << "/\n"); + commonBlockMap[cmnBlk].push_back(sym); + } + } + llvm::DenseMap storeMap; for (const auto &var : funit.getOrderedSymbolTable()) { if (var.isAggregateStore()) { @@ -2244,7 +2378,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } const Fortran::semantics::Symbol &sym = var.getSymbol(); if (!sym.IsFuncResult() || !funit.primaryResult) { - instantiateVar(var, storeMap); + instantiateVar(var, storeMap, &commonBlockMap); } else if (&sym == funit.primaryResult) { instantiateVar(var, storeMap); primaryFuncResult = lookupSymbol(sym); @@ -2353,8 +2487,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// Instantiate the data from a BLOCK DATA unit. void lowerBlockData(Fortran::lower::pft::BlockDataUnit &bdunit) { - // FIXME: get rid of the bogus function context and instantiate the globals - // directly into the module. + // FIXME: get rid of the bogus function context and instantiate the + // globals directly into the module. auto *context = &getMLIRContext(); auto func = Fortran::lower::FirOpBuilder::createFunction( mlir::UnknownLoc::get(context), getModuleOp(), @@ -2362,9 +2496,20 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::FunctionType::get(llvm::None, llvm::None, context)); builder = new Fortran::lower::FirOpBuilder(func, bridge.getKindMap()); llvm::DenseMap fakeMap; + CommonBlockMap commonBlockMap; + for (const auto &pair : bdunit.symTab) { + const auto sym = pair.second; + if (const auto *cmnBlk = + Fortran::semantics::FindCommonBlockContaining(*sym)) { + LLVM_DEBUG(llvm::dbgs() + << "adding " << toStringRef(sym->name()) << " to /" + << toStringRef(cmnBlk->name()) << "/\n"); + commonBlockMap[cmnBlk].push_back(&*sym); + } + } for (const auto &[_, sym] : bdunit.symTab) { Fortran::lower::pft::Variable var(*sym, true); - instantiateVar(var, fakeMap); + instantiateVar(var, fakeMap, &commonBlockMap); } if (auto *region = func.getCallableRegion()) region->dropAllReferences(); diff --git a/flang/lib/Lower/IntervalSet.h b/flang/lib/Lower/IntervalSet.h index fddeea3831731..89c9489eddd7b 100644 --- a/flang/lib/Lower/IntervalSet.h +++ b/flang/lib/Lower/IntervalSet.h @@ -19,8 +19,12 @@ namespace Fortran::lower { //===----------------------------------------------------------------------===// /// Interval set to keep track of intervals, merging them when they overlap one +<<<<<<< HEAD /// another. Used to refine the pseudo-offset ranges of the front-end symbols /// into groups of aliasing variables. +======= +/// another. Used to refine ranges of offsets. +>>>>>>> Update the lowering of COMMON blocks to match changes in the front-end. struct IntervalSet { using MAP = std::map; using Iterator = MAP::const_iterator; @@ -38,6 +42,7 @@ struct IntervalSet { if (up < i->first) { // [lo..up] < i->first m.insert({lo, up}); +<<<<<<< HEAD return; } // up >= i->first @@ -68,6 +73,41 @@ struct IntervalSet { lo = i->first; } fuse(lo, up, i); +======= + } else { + // up >= i->first + if (i->second > up) + up = i->second; + m.erase(i); + // merge i with [lo..max(up,i->second)] + m.insert({lo, up}); + } + } else { + if (i == end() || i->first > lo) + i = std::prev(i); + // i->first <= lo + if (i->second >= up) { + // i->first <= lo && up <= i->second, keep i + return; + } + // i->second < up + if (i->second < lo) { + // i < [lo..up] + m.insert({lo, up}); + return; + } + lo = i->first; + auto j = m.upper_bound(up); + // up < j->first + auto cu = std::prev(j)->second; + // cu < j->first + if (cu > up) + up = cu; + m.erase(i, j); + // merge [i .. j) with [i->first, max(up, cu)] + m.insert({lo, up}); + } +>>>>>>> Update the lowering of COMMON blocks to match changes in the front-end. } Iterator find(std::size_t pt) const { @@ -88,6 +128,7 @@ struct IntervalSet { std::size_t size() const { return m.size(); } private: +<<<<<<< HEAD // Find and fuse overlapping sets. void fuse(std::size_t lo, std::size_t up, Iterator i) { auto j = m.upper_bound(up); @@ -101,6 +142,8 @@ struct IntervalSet { m.insert({lo, up}); } +======= +>>>>>>> Update the lowering of COMMON blocks to match changes in the front-end. MAP m{}; }; diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index dd73c593fd28d..41e5aef4a36a0 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -7,6 +7,7 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/PFTBuilder.h" +#include "IntervalSet.h" #include "flang/Lower/Utils.h" #include "flang/Parser/dump-parse-tree.h" #include "flang/Parser/parse-tree-visitor.h" @@ -16,6 +17,8 @@ #include "llvm/ADT/IntervalMap.h" #include "llvm/Support/CommandLine.h" +#define DEBUG_TYPE "flang-pft" + static llvm::cl::opt clDisableStructuredFir( "no-structured-fir", llvm::cl::desc("disable generation of structured FIR"), llvm::cl::init(false), llvm::cl::Hidden); @@ -1021,42 +1024,8 @@ Fortran::lower::pft::Evaluation::getOwningProcedure() const { }); } -namespace { -/// Interval set to keep track of intervals, merging them when they overlap or -/// abut one another. Used to refine ranges of offsets. -struct IntervalSet : public llvm::IntervalMap { - using IntervalMap::IntervalMap; - using Allocator = IntervalMap::Allocator; - - // Handles the merging of overlapping intervals correctly, efficiently. - bool merge(std::size_t lo, std::size_t up) { - assert(lo < up); - auto first = lookup(lo); - auto last = lookup(up); - if (!first && !last) - insert(lo, up, 1); - else if (!first) - find(up).setStart(lo); - else if (!last) - find(lo).setStop(up); - else - return false; - return true; - } -}; -} // namespace - -// A variable with an offset relative to the subprogram stack but equivalence -// aliasing a variable in a common will also be marked as contained in a common -// block. We have to filter this out so that we can correctly map the offsets. -bool Fortran::lower::declaredInCommonBlock(const semantics::Symbol &sym) { - if (auto *common = semantics::FindCommonBlockContaining(sym)) { - auto &details = common->get(); - for (auto &s : details.objects()) - if (&*s == &sym) - return true; - } - return false; +bool Fortran::lower::definedInCommonBlock(const semantics::Symbol &sym) { + return semantics::FindCommonBlockContaining(sym); } /// Is the symbol `sym` a global? @@ -1064,7 +1033,7 @@ static bool symbolIsGlobal(const semantics::Symbol &sym) { if (const auto *details = sym.detailsIf()) if (details->init()) return true; - return semantics::IsSaved(sym) || lower::declaredInCommonBlock(sym); + return semantics::IsSaved(sym) || lower::definedInCommonBlock(sym); } namespace { @@ -1077,80 +1046,75 @@ struct SymbolDependenceDepth { std::vector> &vars) : vars{vars} {} - const semantics::Symbol *setHasGlobalParticipant( - const std::vector &set, - const llvm::DenseSet &globals) { - for (const auto &eqv : set) - if (globals.find(&eqv.symbol) != globals.end()) - return &eqv.symbol; - return nullptr; - } - - std::pair - getIntervalForSet(IntervalSet &intervals, - const std::vector &set, - const llvm::DenseSet &globals) { - for (const auto &eqv : set) - if (globals.find(&eqv.symbol) == globals.end()) { - auto off = eqv.symbol.offset(); - return {intervals.find(off), off}; - } - return {intervals.end(), 0}; - } - // Analyze the equivalence sets. This analysis need not be performed when the // scope has no equivalence sets. void analyzeAliases(const semantics::Scope &scope) { - IntervalSet::Allocator allocator; - IntervalSet intervals(allocator); - llvm::DenseSet globals; - - // 1. Collect the offset ranges which have aliasing. - for (const auto &set : scope.equivalenceSets()) - for (const auto &eqv : set) { - const auto &sym = eqv.symbol; - if (symbolIsGlobal(sym)) { - // This symbol's offset is into a COMMON block rather than the stack - // frame proxy, so do not add it to the interval map. Reprocess the - // sets in step 2. - globals.insert(&sym); - continue; - } - aliasSyms.insert(&sym); - intervals.merge(sym.offset(), sym.offset() + sym.size() - 1); + Fortran::lower::IntervalSet intervals; + llvm::DenseMap> + aliasSets; + llvm::DenseMap setIsGlobal; + + // 1. Construct the intervals. Determine each entity's interval, merging + // overlapping intervals into aggregates. + for (const auto &pair : scope) { + const auto &sym = pair.second.get(); + if (skipSymbol(sym)) + continue; + LLVM_DEBUG(llvm::dbgs() << "symbol: " << sym << '\n'); + intervals.merge(sym.offset(), sym.offset() + sym.size() - 1); + } + + // 2. Compute alias sets. Adds each entity to a set for the interval it + // appears to be mapped into. + for (const auto &pair : scope) { + const auto &sym = pair.second.get(); + if (skipSymbol(sym)) + continue; + auto iter = intervals.find(sym.offset()); + if (iter != intervals.end()) { + LLVM_DEBUG(llvm::dbgs() + << "symbol: " << toStringRef(sym.name()) << " on [" + << iter->first << ".." << iter->second << "]\n"); + aliasSets[iter->first].push_back(&sym); + if (symbolIsGlobal(sym)) + setIsGlobal.insert({iter->first, &sym}); } + } - // 2. If we saw a global in an equivalence set, we want to map the - // corresponding interval to a global alias, possibly with an offset - // internal to that global. We assume that the front-end has already handled - // all error cases, such as two distinct common blocks being equivalenced. - if (!globals.empty()) - for (const auto &set : scope.equivalenceSets()) - if (const auto *gsym = setHasGlobalParticipant(set, globals)) { - auto [iter, off] = getIntervalForSet(intervals, set, globals); - if (iter != intervals.end()) { - // record the global that's aliased (?) - stores.emplace_back( - lower::pft::Variable::Interval{iter.start(), - iter.stop() - iter.start() + 1}, - /*isGlobal=*/true, gsym, off); - // reset this interval and don't create an aggregate store on stack - iter.setValue(0); - } + // 3. For each alias set with more than 1 member, add an Interval to the + // stores. The Interval will be lowered into a single memory allocation, + // with the co-located, overlapping variables mapped into that memory range. + for (const auto &pair : aliasSets) { + if (pair.second.size() > 1) { + // Set contains more than 1 aliasing variable. + // 1. Mark the symbols as aliasing for lowering. + for (auto *sym : pair.second) + aliasSyms.insert(sym); + auto gvarIter = setIsGlobal.find(pair.first); + auto iter = intervals.find(pair.first); + auto ibgn = iter->first; + auto ilen = iter->second - ibgn + 1; + // 2. Add an Interval to the list of stores allocated for this unit. + lower::pft::Variable::Interval interval(ibgn, ilen); + if (gvarIter != setIsGlobal.end()) { + auto *gsym = gvarIter->second; + LLVM_DEBUG(llvm::dbgs() << "interval [" << ibgn << ".." << ibgn + ilen + << ") added as global " << *gsym << '\n'); + stores.emplace_back(std::move(interval), pair.second); + } else { + LLVM_DEBUG(llvm::dbgs() << "interval [" << ibgn << ".." << ibgn + ilen + << ") added\n"); + stores.emplace_back(std::move(interval)); } - - // 3. Create a aggregate store for each aliased interval. - for (auto i = intervals.begin(), end = intervals.end(); i != end; ++i) - if (i.value()) - stores.emplace_back( - lower::pft::Variable::Interval{i.start(), i.stop() - i.start() + 1}, - /*isGlobal=*/false); + } + } } // Recursively visit each symbol to determine the height of its dependence on // other symbols. int analyze(const semantics::Symbol &sym) { auto done = seen.insert(&sym); + LLVM_DEBUG(llvm::dbgs() << "analyze symbol: " << sym << '\n'); if (!done.second) return 0; if (semantics::IsProcedure(sym)) { @@ -1225,8 +1189,6 @@ struct SymbolDependenceDepth { // aggregate stores when constructing the new variable on the list. if (!aliasSyms.empty()) if (aliasSyms.find(&sym) != aliasSyms.end()) { - if (global) - llvm::report_fatal_error("TODO: EQUIVALENCE on global"); // Expect the total number of EQUIVALENCE sets to be small for a typical // Fortran program. auto findStore = [&](std::size_t off) -> std::size_t { @@ -1235,8 +1197,19 @@ struct SymbolDependenceDepth { if (off >= bot && off < bot + std::get<1>(v.interval)) return bot; } + // clang-format off + LLVM_DEBUG( + llvm::dbgs() << "looking for " << off << "\n{\n"; + for (auto v : stores) { + llvm::dbgs() << " i = [" << std::get<0>(v.interval) << ".." + << std::get<0>(v.interval) + std::get<1>(v.interval) + << "]\n"; + } + llvm::dbgs() << "}\n"); + // clang-format on llvm_unreachable("the store must be present"); }; + LLVM_DEBUG(llvm::dbgs() << "symbol: " << sym << '\n'); vars[depth].back().setAlias(findStore(sym.offset())); } return depth; @@ -1244,13 +1217,10 @@ struct SymbolDependenceDepth { /// Process the stores built for overlapping nominal variables. void prepareStores() { - for (auto st : stores) { - int depth = 0; - if (st.global) - depth = analyze(*st.obj); - adjustSize(depth + 1); - vars[depth].emplace_back(std::move(st)); - } + // add all aggregate stores to the front of the work list + adjustSize(1); + for (auto st : stores) + vars[0].emplace_back(std::move(st)); } /// Save the final list of variable allocations as a single vector and free @@ -1262,6 +1232,11 @@ struct SymbolDependenceDepth { } private: + bool skipSymbol(const semantics::Symbol &sym) { + return !sym.has() || + lower::definedInCommonBlock(sym); + } + // Make sure the table is of appropriate size. void adjustSize(std::size_t size) { if (vars.size() < size) @@ -1407,10 +1382,14 @@ void Fortran::lower::pft::Variable::dump() const { } else if (auto *s = std::get_if(&var)) { llvm::errs() << "interval[" << std::get<0>(s->interval) << ", " << std::get<1>(s->interval) << "]:"; - if (s->global) + if (s->isGlobal()) llvm::errs() << ", global"; - if (s->obj) - llvm::errs() << ", object:(" << *s->obj << "), offset: " << s->offset; + if (s->vars.size()) { + llvm::errs() << ", vars: {"; + llvm::interleaveComma(s->vars, llvm::errs(), + [](auto *y) { llvm::errs() << *y; }); + llvm::errs() << '}'; + } } else { llvm_unreachable("not a Variable"); } diff --git a/flang/unittests/Lower/CMakeLists.txt b/flang/unittests/Lower/CMakeLists.txt index 9843eebf34433..6bc88a6c89eed 100644 --- a/flang/unittests/Lower/CMakeLists.txt +++ b/flang/unittests/Lower/CMakeLists.txt @@ -7,7 +7,8 @@ set(LIBS ) add_flang_unittest(FlangLoweringOpenMPTests - OpenMPLoweringTest.cpp + IntervalSet.cpp + OpenMPLoweringTest.cpp RTBuilder.cpp ) target_link_libraries(FlangLoweringOpenMPTests diff --git a/flang/unittests/Lower/IntervalSet.cpp b/flang/unittests/Lower/IntervalSet.cpp new file mode 100644 index 0000000000000..9624c71185136 --- /dev/null +++ b/flang/unittests/Lower/IntervalSet.cpp @@ -0,0 +1,67 @@ +//===- IntervalSet.cpp -- interval set unit tests -------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "../../lib/Lower/IntervalSet.h" +#include "gtest/gtest.h" + +struct IntervalSetTest : public testing::Test { + void SetUp() { iset = new Fortran::lower::IntervalSet; } + void TearDown() { delete iset; } + + Fortran::lower::IntervalSet *iset; +}; + +// Test for creating an interval set +TEST_F(IntervalSetTest, TrivialCreation) { + iset->merge(0, 9); + iset->merge(10, 13); + iset->merge(400, 449); + + // expect 3 non-overlapping members in the set + EXPECT_NE(iset->empty(), true); + EXPECT_EQ(iset->size(), 3u); +} + +TEST_F(IntervalSetTest, TrivialMerge) { + iset->merge(4, 9); + iset->merge(8, 11); + iset->merge(0, 12); + + // expect 1 member in the set as all 3 intervals overlap + EXPECT_NE(iset->empty(), true); + EXPECT_EQ(iset->size(), 1u); +} + +TEST_F(IntervalSetTest, TrivialProbe) { + iset->merge(0, 9); + iset->merge(8, 11); + iset->merge(20, 23); + iset->merge(21, 21); + + // expect 2 members in the set as there are 2 pairs of overlapping intervals + EXPECT_EQ(iset->size(), 2u); + + // test that find correctly determines if a point is a member of the set + // `== end()` means not a member here + EXPECT_NE(iset->find(0), iset->end()); + EXPECT_NE(iset->find(5), iset->end()); + EXPECT_NE(iset->find(11), iset->end()); + EXPECT_EQ(iset->find(12), iset->end()); + EXPECT_EQ(iset->find(19), iset->end()); + EXPECT_NE(iset->find(20), iset->end()); + EXPECT_NE(iset->find(23), iset->end()); + EXPECT_EQ(iset->find(24), iset->end()); + + // test that the two interval bounds are correct + auto iter1 = iset->find(6); + EXPECT_EQ(iter1->first, 0u); + EXPECT_EQ(iter1->second, 11u); + auto iter2 = iset->find(21); + EXPECT_EQ(iter2->first, 20u); + EXPECT_EQ(iter2->second, 23u); +} From 54fb604ef57480187358bb05a63dd971e4daea98 Mon Sep 17 00:00:00 2001 From: Eric Date: Tue, 15 Sep 2020 14:53:25 -0700 Subject: [PATCH 0258/1017] Code cleanup for fir.embox op. Use some of MLIR's new facilities, etc. This is prep work for creating descriptors... [NFC] remove trailing whitespace in .td file --- flang/include/flang/Lower/Support/BoxValue.h | 3 - .../include/flang/Optimizer/Support/Matcher.h | 3 +- flang/lib/Lower/ConvertExpr.cpp | 142 ++++++++---------- flang/lib/Lower/SymbolMap.h | 73 ++++----- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 4 +- 5 files changed, 98 insertions(+), 127 deletions(-) diff --git a/flang/include/flang/Lower/Support/BoxValue.h b/flang/include/flang/Lower/Support/BoxValue.h index f1e85f2d9e7ee..69ba857403b83 100644 --- a/flang/include/flang/Lower/Support/BoxValue.h +++ b/flang/include/flang/Lower/Support/BoxValue.h @@ -250,9 +250,6 @@ class ExtendedValue : public details::matcher { friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ExtendedValue &); - friend mlir::Value getBase(const ExtendedValue &exv); - friend mlir::Value getLen(const ExtendedValue &exv); - friend ExtendedValue substBase(const ExtendedValue &exv, mlir::Value base); const VT &matchee() const { return box; } diff --git a/flang/include/flang/Optimizer/Support/Matcher.h b/flang/include/flang/Optimizer/Support/Matcher.h index e8b62ae7f37e0..a7032dcdc5905 100644 --- a/flang/include/flang/Optimizer/Support/Matcher.h +++ b/flang/include/flang/Optimizer/Support/Matcher.h @@ -15,7 +15,8 @@ #include -// Boilerplate CRTP class for a simplified type-casing syntactic sugar. +// Boilerplate CRTP class for a simplified type-casing syntactic sugar. This +// lets one write pattern matchers using a more compact syntax. namespace fir::details { // clang-format off template struct matches : Ts... { using Ts::operator()...; }; diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 25017367f4fbe..d2ef5375050c9 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -273,16 +273,14 @@ class ExprLowering { fir::ExtendedValue getExValue(const Fortran::lower::SymbolBox &symBox) { using T = fir::ExtendedValue; - return std::visit( - Fortran::common::visitors{ - [](const Fortran::lower::SymbolBox::Intrinsic &box) -> T { - return box.getAddr(); - }, - [](const auto &box) -> T { return box; }, - [](const Fortran::lower::SymbolBox::None &) -> T { - llvm_unreachable("symbol not mapped"); - }}, - symBox.box); + return symBox.match( + [](const Fortran::lower::SymbolBox::Intrinsic &box) -> T { + return box.getAddr(); + }, + [](const Fortran::lower::SymbolBox::None &) -> T { + llvm_unreachable("symbol not mapped"); + }, + [](const auto &box) -> T { return box; }); } /// Returns a reference to a symbol or its box/boxChar descriptor if it has @@ -1098,25 +1096,23 @@ class ExprLowering { // We need some context here, since we could also box as an argument llvm::report_fatal_error("TODO: array slice not supported"); }; - return std::visit( - Fortran::common::visitors{ - [&](const Fortran::lower::SymbolBox::FullDim &arr) { - if (!inArrayContext() && isSlice(aref)) - return genArraySlice(arr); - return genFullDim(arr, one); - }, - [&](const Fortran::lower::SymbolBox::CharFullDim &arr) { - return genFullDim(arr, arr.getLen()); - }, - [&](const Fortran::lower::SymbolBox::Derived &arr) { - TODO(); - return mlir::Value{}; - }, - [&](const auto &) { - TODO(); - return mlir::Value{}; - }}, - si.box); + return si.match( + [&](const Fortran::lower::SymbolBox::FullDim &arr) { + if (!inArrayContext() && isSlice(aref)) + return genArraySlice(arr); + return genFullDim(arr, one); + }, + [&](const Fortran::lower::SymbolBox::CharFullDim &arr) { + return genFullDim(arr, arr.getLen()); + }, + [&](const Fortran::lower::SymbolBox::Derived &arr) { + TODO(); + return mlir::Value{}; + }, + [&](const auto &) { + TODO(); + return mlir::Value{}; + }); } fir::ExtendedValue genArrayCoorOp(const Fortran::lower::SymbolBox &si, @@ -1163,28 +1159,26 @@ class ExprLowering { return builder.create( loc, refTy, addr, shape, mlir::Value{}, arrayCoorArgs, ValueRange()); }; - return std::visit( - Fortran::common::visitors{ - [&](const Fortran::lower::SymbolBox::FullDim &arr) { - if (!inArrayContext() && isSlice(aref)) { - TODO(); - return mlir::Value{}; - } - return genWithShape(arr); - }, - [&](const Fortran::lower::SymbolBox::CharFullDim &arr) { - TODO(); - return mlir::Value{}; - }, - [&](const Fortran::lower::SymbolBox::Derived &arr) { - TODO(); - return mlir::Value{}; - }, - [&](const auto &) { - TODO(); - return mlir::Value{}; - }}, - si.box); + return si.match( + [&](const Fortran::lower::SymbolBox::FullDim &arr) { + if (!inArrayContext() && isSlice(aref)) { + TODO(); + return mlir::Value{}; + } + return genWithShape(arr); + }, + [&](const Fortran::lower::SymbolBox::CharFullDim &arr) { + TODO(); + return mlir::Value{}; + }, + [&](const Fortran::lower::SymbolBox::Derived &arr) { + TODO(); + return mlir::Value{}; + }, + [&](const auto &) { + TODO(); + return mlir::Value{}; + }); } // Return the coordinate of the array reference @@ -1643,31 +1637,22 @@ fir::ExtendedValue Fortran::lower::createStringLiteral( //===----------------------------------------------------------------------===// mlir::Value fir::getBase(const fir::ExtendedValue &exv) { - return std::visit(Fortran::common::visitors{ - [](const fir::UnboxedValue &x) { return x; }, - [](const auto &x) { return x.getAddr(); }, - }, - exv.box); + return exv.match([](const fir::UnboxedValue &x) { return x; }, + [](const auto &x) { return x.getAddr(); }); } mlir::Value fir::getLen(const fir::ExtendedValue &exv) { - return std::visit( - Fortran::common::visitors{ - [](const fir::CharBoxValue &x) { return x.getLen(); }, - [](const fir::CharArrayBoxValue &x) { return x.getLen(); }, - [](const fir::BoxValue &x) { return x.getLen(); }, - [](const auto &) { return mlir::Value{}; }}, - exv.box); + return exv.match([](const fir::CharBoxValue &x) { return x.getLen(); }, + [](const fir::CharArrayBoxValue &x) { return x.getLen(); }, + [](const fir::BoxValue &x) { return x.getLen(); }, + [](const auto &) { return mlir::Value{}; }); } -fir::ExtendedValue fir::substBase(const fir::ExtendedValue &ex, +fir::ExtendedValue fir::substBase(const fir::ExtendedValue &exv, mlir::Value base) { - return std::visit( - Fortran::common::visitors{ - [&](const fir::UnboxedValue &x) { return fir::ExtendedValue(base); }, - [&](const auto &x) { return fir::ExtendedValue(x.clone(base)); }, - }, - ex.box); + return exv.match( + [=](const fir::UnboxedValue &x) { return fir::ExtendedValue(base); }, + [=](const auto &x) { return fir::ExtendedValue(x.clone(base)); }); } llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os, @@ -1750,14 +1735,13 @@ void Fortran::lower::SymMap::dump() const { auto &os = llvm::errs(); for (auto iter : symbolMap) { os << "symbol [" << *iter.first << "] ->\n\t"; - std::visit(Fortran::common::visitors{ - [&](const Fortran::lower::SymbolBox::None &box) { - os << "** symbol not properly mapped **\n"; - }, - [&](const Fortran::lower::SymbolBox::Intrinsic &val) { - os << val.getAddr() << '\n'; - }, - [&](const auto &box) { os << box << '\n'; }}, - iter.second.box); + iter.second.match( + [&](const Fortran::lower::SymbolBox::None &box) { + os << "** symbol not properly mapped **\n"; + }, + [&](const Fortran::lower::SymbolBox::Intrinsic &val) { + os << val.getAddr() << '\n'; + }, + [&](const auto &box) { os << box << '\n'; }); } } diff --git a/flang/lib/Lower/SymbolMap.h b/flang/lib/Lower/SymbolMap.h index 135e77e3a9dd9..8bf591d4e20d9 100644 --- a/flang/lib/Lower/SymbolMap.h +++ b/flang/lib/Lower/SymbolMap.h @@ -9,10 +9,10 @@ #ifndef FORTRAN_LOWER_SYMBOLMAP_H #define FORTRAN_LOWER_SYMBOLMAP_H -#include "flang/Common/idioms.h" #include "flang/Common/reference.h" #include "flang/Lower/Support/BoxValue.h" #include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/Matcher.h" #include "flang/Semantics/symbol.h" #include "mlir/IR/Value.h" #include "llvm/ADT/ArrayRef.h" @@ -39,7 +39,7 @@ namespace Fortran::lower { /// /// The lowering bridge needs to be able to record all four of these ssa-values /// in the lookup table to be able to correctly lower Fortran to FIR. -struct SymbolBox { +struct SymbolBox : public fir::details::matcher { // For lookups that fail, have a monostate using None = std::monostate; @@ -58,6 +58,8 @@ struct SymbolBox { // Generalized derived type variable using Derived = fir::BoxValue; + using VT = std::variant; + //===--------------------------------------------------------------------===// // Constructors //===--------------------------------------------------------------------===// @@ -80,55 +82,42 @@ struct SymbolBox { /// scalar. For an array, this is the address of the first element in the /// array, etc. mlir::Value getAddr() const { - return std::visit(common::visitors{ - [](const None &) { return mlir::Value{}; }, - [](const auto &x) { return x.getAddr(); }, - }, - box); + return match([](const None &) { return mlir::Value{}; }, + [](const auto &x) { return x.getAddr(); }); } /// Get the LEN type parameter of a CHARACTER boxed value. llvm::Optional getCharLen() const { using T = llvm::Optional; - return std::visit(common::visitors{ - [](const Char &x) { return T{x.getLen()}; }, - [](const CharFullDim &x) { return T{x.getLen()}; }, - [](const auto &) { return T{}; }, - }, - box); + return match([](const Char &x) { return T{x.getLen()}; }, + [](const CharFullDim &x) { return T{x.getLen()}; }, + [](const auto &) { return T{}; }); } /// Does the boxed value have an intrinsic type? bool isIntrinsic() const { - return std::visit(common::visitors{ - [](const Intrinsic &) { return true; }, - [](const Char &) { return true; }, - [](const auto &x) { return false; }, - }, - box); + return match([](const Intrinsic &) { return true; }, + [](const Char &) { return true; }, + [](const auto &x) { return false; }); } /// Does the boxed value have a rank greater than zero? bool hasRank() const { - return std::visit( - common::visitors{ - [](const Intrinsic &) { return false; }, - [](const Char &) { return false; }, - [](const None &) { return false; }, - [](const auto &x) { return x.getExtents().size() > 0; }, - }, - box); + return match([](const Intrinsic &) { return false; }, + [](const Char &) { return false; }, + [](const None &) { return false; }, + [](const auto &x) { return x.getExtents().size() > 0; }); } /// Does the boxed value have trivial lower bounds (== 1)? bool hasSimpleLBounds() const { - if (auto *arr = std::get_if(&box)) - return arr->getLBounds().empty(); - if (auto *arr = std::get_if(&box)) - return arr->getLBounds().empty(); - if (auto *arr = std::get_if(&box)) - return (arr->getExtents().size() > 0) && arr->getLBounds().empty(); - return false; + return match( + [](const FullDim &arr) { return arr.getLBounds().empty(); }, + [](const CharFullDim &arr) { return arr.getLBounds().empty(); }, + [](const Derived &arr) { + return (arr.getExtents().size() > 0) && arr.getLBounds().empty(); + }, + [](const auto &) { return false; }); } /// Does the boxed value have a constant shape? @@ -141,13 +130,10 @@ struct SymbolBox { /// Get the lbound if the box explicitly contains it. mlir::Value getLBound(unsigned dim) const { - return std::visit( - common::visitors{ - [&](const FullDim &box) { return box.getLBounds()[dim]; }, - [&](const CharFullDim &box) { return box.getLBounds()[dim]; }, - [&](const Derived &box) { return box.getLBounds()[dim]; }, - [](const auto &) { return mlir::Value{}; }}, - box); + return match([&](const FullDim &box) { return box.getLBounds()[dim]; }, + [&](const CharFullDim &box) { return box.getLBounds()[dim]; }, + [&](const Derived &box) { return box.getLBounds()[dim]; }, + [](const auto &) { return mlir::Value{}; }); } /// Apply the lambda `func` to this box value. @@ -158,7 +144,10 @@ struct SymbolBox { return RT{}; } - std::variant box; + const VT &matchee() const { return box; } + +private: + VT box; }; //===----------------------------------------------------------------------===// diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index 78861d5c98620..9e308ecb42cbb 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -121,7 +121,7 @@ class EmboxConversion : public mlir::OpRewritePattern { auto rank = shapeOp.getType().cast().getRank(); auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); attrs.push_back(rewriter.getNamedAttr(XEmboxOp::rankAttrName(), rankAttr)); - auto lenParamSize = embox.getLenParams().size(); + auto lenParamSize = embox.lenParams().size(); auto lenParamAttr = rewriter.getIntegerAttr(idxTy, lenParamSize); attrs.push_back( rewriter.getNamedAttr(XEmboxOp::lenParamAttrName(), lenParamAttr)); @@ -140,7 +140,7 @@ class EmboxConversion : public mlir::OpRewritePattern { rewriter.getNamedAttr(XEmboxOp::sliceAttrName(), sliceAttr)); auto xbox = rewriter.create(loc, embox.getType(), embox.memref(), shapeOpers, shiftOpers, sliceOpers, - embox.getLenParams(), attrs); + embox.lenParams(), attrs); LLVM_DEBUG(llvm::dbgs() << "rewriting " << embox << " to " << xbox << '\n'); rewriter.replaceOp(embox, xbox.getOperation()->getResults()); return mlir::success(); From a8c925c7b6b0e3954db894803617b0847c409fdf Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Thu, 17 Sep 2020 16:29:58 -0700 Subject: [PATCH 0259/1017] Implement real-valued do loops and do concurrent loops. (#427) * Implement real-valued do loops and do concurrent loops. do concurrent local and local_init locality variables require support for nested scopes, which is not yet implemented. --- flang/lib/Lower/Bridge.cpp | 435 +++++++++++++++---------- flang/lib/Lower/PFTBuilder.cpp | 126 ++++--- flang/test/Lower/loops.f90 | 62 ++++ flang/test/Lower/unstructured-loop.f90 | 9 +- 4 files changed, 392 insertions(+), 240 deletions(-) create mode 100644 flang/test/Lower/loops.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 2e4fcbbe21922..16344e19b6d6f 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -62,36 +62,38 @@ static llvm::cl::opt namespace { /// Information for generating a structured or unstructured increment loop. struct IncrementLoopInfo { - explicit IncrementLoopInfo( - Fortran::semantics::Symbol *sym, - const Fortran::parser::ScalarExpr &lowerExpr, - const Fortran::parser::ScalarExpr &upperExpr, - const std::optional &stepExpr, - mlir::Type type) - : loopVariableSym{sym}, lowerExpr{lowerExpr}, upperExpr{upperExpr}, - stepExpr{stepExpr}, loopVariableType{type} {} + template + explicit IncrementLoopInfo(Fortran::semantics::Symbol &sym, const T &lower, + const T &upper, const std::optional &step) + : loopVariableSym{sym}, lowerExpr{Fortran::semantics::GetExpr(lower)}, + upperExpr{Fortran::semantics::GetExpr(upper)}, + stepExpr{Fortran::semantics::GetExpr(step)} {} bool isStructured() const { return !headerBlock; } - // Data members for both structured and unstructured loops. - Fortran::semantics::Symbol *loopVariableSym; - const Fortran::parser::ScalarExpr &lowerExpr; - const Fortran::parser::ScalarExpr &upperExpr; - const std::optional &stepExpr; - mlir::Type loopVariableType; - - mlir::Value loopVariable{}; - mlir::Value stepValue{}; // possible uses in multiple blocks + // Data members common to both structured and unstructured loops. + const Fortran::semantics::Symbol &loopVariableSym; + const Fortran::semantics::SomeExpr *lowerExpr; + const Fortran::semantics::SomeExpr *upperExpr; + const Fortran::semantics::SomeExpr *stepExpr; + const Fortran::semantics::SomeExpr *maskExpr = nullptr; + bool isUnordered = false; + bool isOutermost = true; + bool isInnermost = true; + llvm::SmallVector localInitSymList; + mlir::Value loopVariable = nullptr; + mlir::Value stepValue = nullptr; // possible uses in multiple blocks // Data members for structured loops. - fir::DoLoopOp doLoop{}; - mlir::OpBuilder::InsertPoint insertionPoint{}; + fir::DoLoopOp doLoop = nullptr; // Data members for unstructured loops. - mlir::Value tripVariable{}; - mlir::Block *headerBlock{nullptr}; // loop entry and test block - mlir::Block *bodyBlock{nullptr}; // first loop body block - mlir::Block *successorBlock{nullptr}; // loop exit target block + bool hasRealControl = false; + mlir::Value tripVariable = nullptr; + mlir::Block *headerBlock = nullptr; // loop entry and test block + mlir::Block *maskBlock = nullptr; // concurrent loop mask block + mlir::Block *bodyBlock = nullptr; // first loop body block + mlir::Block *exitBlock = nullptr; // loop exit target block }; } // namespace @@ -330,9 +332,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::lower::pft::LabelSet &labelSet) override final { auto &owningProc = *getEval().getOwningProcedure(); auto iter = owningProc.assignSymbolLabelMap.find(sym); - if (iter == owningProc.assignSymbolLabelMap.end()) { + if (iter == owningProc.assignSymbolLabelMap.end()) return false; - } labelSet = iter->second; return true; } @@ -341,9 +342,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { lookupLabel(Fortran::lower::pft::Label label) override final { auto &owningProc = *getEval().getOwningProcedure(); auto iter = owningProc.labelEvaluationMap.find(label); - if (iter == owningProc.labelEvaluationMap.end()) { + if (iter == owningProc.labelEvaluationMap.end()) return nullptr; - } return iter->second; } @@ -538,24 +538,29 @@ class FirConverter : public Fortran::lower::AbstractConverter { return block; } - void genBranch(mlir::Block *targetBlock) { + void genFIRBranch(mlir::Block *targetBlock) { assert(targetBlock && "missing unconditional target block"); builder->create(toLocation(), targetBlock); } - void genFIRConditionalBranch(mlir::Value &cond, mlir::Block *trueTarget, + void genFIRConditionalBranch(mlir::Value cond, mlir::Block *trueTarget, mlir::Block *falseTarget) { + assert(trueTarget && "missing conditional branch true block"); + assert(falseTarget && "missing conditional branch false block"); auto loc = toLocation(); auto bcc = builder->createConvert(loc, builder->getI1Type(), cond); builder->create(loc, bcc, trueTarget, llvm::None, falseTarget, llvm::None); } - + void genFIRConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr, + mlir::Block *trueTarget, + mlir::Block *falseTarget) { + mlir::Value cond = genExprValue(*Fortran::semantics::GetExpr(expr)); + genFIRConditionalBranch(cond, trueTarget, falseTarget); + } void genFIRConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr, Fortran::lower::pft::Evaluation *trueTarget, Fortran::lower::pft::Evaluation *falseTarget) { - assert(trueTarget && "missing conditional branch true block"); - assert(falseTarget && "missing conditional branch true block"); mlir::Value cond = genExprValue(*Fortran::semantics::GetExpr(expr)); genFIRConditionalBranch(cond, trueTarget->block, falseTarget->block); } @@ -642,12 +647,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { return {insPt, ifOp}; } - mlir::Value genFIRLoopIndex(const Fortran::parser::ScalarExpr &x, - mlir::Type t) { - mlir::Value v = genExprValue(*Fortran::semantics::GetExpr(x)); - return builder->createConvert(toLocation(), t, v); - } - mlir::FuncOp getFunc(llvm::StringRef name, mlir::FunctionType ty) { if (auto func = builder->getNamedFunction(name)) { assert(func.getType() == ty); @@ -702,7 +701,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) { auto &eval = getEval(); - mlir::Value selectExpr = genExprValue(*Fortran::semantics::GetExpr( + auto selectExpr = genExprValue(*Fortran::semantics::GetExpr( std::get(stmt.t))); llvm::SmallVector indexList; llvm::SmallVector blockList; @@ -718,7 +717,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) { auto &eval = getEval(); - mlir::Value expr = genExprValue( + auto expr = genExprValue( *Fortran::semantics::GetExpr(std::get(stmt.t))); auto exprType = expr.getType(); auto loc = toLocation(); @@ -745,15 +744,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { // sum = expr + expr [ raise an exception if expr is a NaN ] // if (sum < 0.0) goto L1 else if (sum > 0.0) goto L3 else goto L2 assert(eval.localBlocks.size() == 1 && "missing arithmetic if block"); - mlir::Value sum = builder->create(loc, expr, expr); - mlir::Value zero = builder->create( + auto sum = builder->create(loc, expr, expr); + auto zero = builder->create( loc, exprType, builder->getFloatAttr(exprType, 0.0)); - mlir::Value cond1 = + auto cond1 = builder->create(loc, mlir::CmpFPredicate::OLT, sum, zero); genFIRConditionalBranch(cond1, blockOfLabel(eval, std::get<1>(stmt.t)), eval.localBlocks[0]); startBlock(eval.localBlocks[0]); - mlir::Value cond2 = + auto cond2 = builder->create(loc, mlir::CmpFPredicate::OGT, sum, zero); genFIRConditionalBranch(cond2, blockOfLabel(eval, std::get<3>(stmt.t)), blockOfLabel(eval, std::get<2>(stmt.t))); @@ -801,11 +800,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } // Absent an explicit list, add all possible label targets. - if (indexList.empty()) { - for (auto &label : labelSet) { + if (indexList.empty()) + for (auto &label : labelSet) addLabel(label); - } - } // Add a nop/fallthrough branch to the switch for a nonconforming program // unit that violates the program requirement above. blockList.push_back(eval.nonNopSuccessor().block); // default @@ -817,161 +814,270 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// - structured and unstructured increment loops /// - structured and unstructured concurrent loops void genFIR(const Fortran::parser::DoConstruct &) { + // Collect loop information. + // Generate begin loop code directly for infinite and while loops. auto &eval = getEval(); bool unstructuredContext = eval.lowerAsUnstructured(); - Fortran::lower::pft::Evaluation &doStmtEval = - eval.getFirstNestedEvaluation(); + auto &doStmtEval = eval.getFirstNestedEvaluation(); auto *doStmt = doStmtEval.getIf(); - assert(doStmt && "missing DO statement"); const auto &loopControl = std::get>(doStmt->t); - llvm::SmallVector incrementLoopInfo; + auto *preheaderBlock = doStmtEval.block; + auto *headerBlock = + unstructuredContext ? doStmtEval.localBlocks[0] : nullptr; + auto *bodyBlock = doStmtEval.lexicalSuccessor->block; + auto *exitBlock = doStmtEval.parentConstruct->constructExit->block; + llvm::SmallVector incrementLoopInfo; const Fortran::parser::ScalarLogicalExpr *whileCondition = nullptr; bool infiniteLoop = !loopControl.has_value(); if (infiniteLoop) { assert(unstructuredContext && "infinite loop must be unstructured"); - startBlock(doStmtEval.localBlocks[0]); // header block + startBlock(headerBlock); } else if ((whileCondition = std::get_if( &loopControl->u))) { assert(unstructuredContext && "while loop must be unstructured"); - startBlock(doStmtEval.localBlocks[0]); // header block - genFIRConditionalBranch(*whileCondition, doStmtEval.lexicalSuccessor, - doStmtEval.parentConstruct->constructExit); + startBlock(headerBlock); + genFIRConditionalBranch(*whileCondition, bodyBlock, exitBlock); } else if (const auto *bounds = std::get_if( &loopControl->u)) { - // "Normal" increment loop. - incrementLoopInfo.emplace_back(bounds->name.thing.symbol, bounds->lower, - bounds->upper, bounds->step, - genType(*bounds->name.thing.symbol)); + // Non-concurrent increment loop. + incrementLoopInfo.emplace_back(*bounds->name.thing.symbol, bounds->lower, + bounds->upper, bounds->step); if (unstructuredContext) { - maybeStartBlock(doStmtEval.block); // preheader block - incrementLoopInfo[0].headerBlock = doStmtEval.localBlocks[0]; - incrementLoopInfo[0].bodyBlock = doStmtEval.lexicalSuccessor->block; - incrementLoopInfo[0].successorBlock = - doStmtEval.parentConstruct->constructExit->block; + maybeStartBlock(preheaderBlock); + auto &info = incrementLoopInfo.back(); + info.hasRealControl = info.loopVariableSym.GetType()->IsNumeric( + Fortran::common::TypeCategory::Real); + info.headerBlock = headerBlock; + info.bodyBlock = bodyBlock; + info.exitBlock = exitBlock; } } else { - [[maybe_unused]] const auto *concurrentInfo = + const auto *concurrent = std::get_if( &loopControl->u); - assert(concurrentInfo && "DO loop variant is invalid"); - TODO(); - // Add entries to incrementLoopInfo. (Define extra members for a mask.) + assert(concurrent && "invalid DO loop variant"); + if (unstructuredContext) + maybeStartBlock(preheaderBlock); + const auto &header = + std::get(concurrent->t); + auto &concurrentControlList = + std::get>(header.t); + auto dims = concurrentControlList.size(); + auto &endDoStmtEval = *doStmtEval.controlSuccessor; + auto beginBlocks = doStmtEval.localBlocks.begin(); + auto endBlocks = endDoStmtEval.localBlocks.end(); + decltype(dims) d = 0; + for (const auto &control : concurrentControlList) { + incrementLoopInfo.emplace_back( + *std::get<0>(control.t).symbol, std::get<1>(control.t), + std::get<2>(control.t), std::get<3>(control.t)); + auto &info = incrementLoopInfo.back(); + info.isUnordered = true; + info.isOutermost = ++d == 1; + info.isInnermost = d == dims; + if (info.isInnermost) { + for (const auto &x : + std::get>( + concurrent->t)) { + if (const auto *localInitList = + std::get_if(&x.u)) + for (const auto &x : localInitList->v) + info.localInitSymList.push_back(x.symbol); + if (std::get_if(&x.u)) + llvm_unreachable("do concurrent locality specs not implemented"); + } + } + if (!unstructuredContext) + continue; + // Unstructured concurrent loop - The original loop body provides the + // body and latch blocks of the innermost dimension. The (first) body + // block of a non-innermost dimension is the preheader block of the + // immediately enclosed dimension. The latch block of a non-innermost + // dimension is the exit block of the immediately enclosed dimension. + // Blocks are generated "in order". + info.headerBlock = *beginBlocks++; + info.bodyBlock = info.isInnermost ? bodyBlock : *beginBlocks++; + info.exitBlock = info.isOutermost ? exitBlock : *--endBlocks; + } + if (auto *maskExpr = Fortran::semantics::GetExpr( + std::get>( + header.t))) { + auto &info = incrementLoopInfo.back(); + info.maskExpr = maskExpr; + if (unstructuredContext) { + assert(endDoStmtEval.block && + "missing masked concurrent loop latch block"); + info.maskBlock = *beginBlocks++; + } + } + assert(beginBlocks == doStmtEval.localBlocks.end() && + "concurrent header+body+mask block count mismatch"); + assert(endBlocks == endDoStmtEval.localBlocks.begin() && + "concurrent latch block count mismatch"); } - auto n = incrementLoopInfo.size(); - for (decltype(n) i = 0; i < n; ++i) - genFIRIncrementLoopBegin(incrementLoopInfo[i]); - // Generate loop body code. + // Generate increment loop begin code. + // (Infinite and while loop begin code has already been generated.) + for (auto &info : incrementLoopInfo) + genFIRIncrementLoopBegin(info); + + // Generate loop body code. The NonLabelDoStmt and EndDoStmt genFIR calls + // are nops, since their code is generated directly here. However, their + // genFIR wrapper calls are needed for block management in some cases. for (auto &e : eval.getNestedEvaluations()) genFIR(e, unstructuredContext); - setCurrentEval(eval); - // Generate end loop code. + // Generate loop end code. if (infiniteLoop || whileCondition) { - genBranch(doStmtEval.localBlocks[0]); + genFIRBranch(headerBlock); } else { - for (auto i = incrementLoopInfo.size(); i > 0;) - genFIRIncrementLoopEnd(incrementLoopInfo[--i]); + for (auto d = incrementLoopInfo.size(); d > 0;) + genFIRIncrementLoopEnd(incrementLoopInfo[--d]); } } /// Generate FIR to begin a structured or unstructured increment loop. void genFIRIncrementLoopBegin(IncrementLoopInfo &info) { auto loc = toLocation(); - mlir::Type type = - info.isStructured() ? builder->getIndexType() : info.loopVariableType; - auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); - auto upperValue = genFIRLoopIndex(info.upperExpr, type); - // clang-format off - info.stepValue = - info.stepExpr.has_value() ? genFIRLoopIndex(*info.stepExpr, type) - : info.isStructured() - ? builder->create(loc, 1) - : builder->createIntegerConstant(loc, info.loopVariableType, 1); - // clang-format on - assert(info.stepValue && "step value must be set"); - info.loopVariable = createTemp(loc, *info.loopVariableSym); + info.loopVariable = createTemp(loc, info.loopVariableSym); + auto controlType = info.isStructured() ? builder->getIndexType() + : genType(info.loopVariableSym); + auto genControlValue = [&](const Fortran::semantics::SomeExpr *expr) { + if (expr) + return builder->createConvert(loc, controlType, genExprValue(*expr)); + if (!info.hasRealControl) + return builder->createIntegerConstant(loc, controlType, 1); // step + auto one = + builder->createIntegerConstant(loc, builder->getIndexType(), 1); + return builder->createConvert(loc, controlType, one); // real step + }; + auto lowerValue = genControlValue(info.lowerExpr); + auto upperValue = genControlValue(info.upperExpr); + info.stepValue = genControlValue(info.stepExpr); + + auto genLocalInitAssignments = [&]() { + for (const auto *sym : info.localInitSymList) { + llvm_unreachable("do concurrent locality specs not implemented"); + const auto *hostDetails = + sym->detailsIf(); + assert(hostDetails && "missing local_init variable host variable"); + [[maybe_unused]] const Fortran::semantics::Symbol &hostSym = + hostDetails->symbol(); + // assign sym = hostSym + } + }; // Structured loop - generate fir.do_loop. if (info.isStructured()) { - // Perform the default initial assignment of the DO variable. - info.insertionPoint = builder->saveInsertionPoint(); info.doLoop = builder->create( - loc, lowerValue, upperValue, info.stepValue, /*unordered=*/false, - ArrayRef{lowerValue}); + loc, lowerValue, upperValue, info.stepValue, info.isUnordered, + ArrayRef{lowerValue}); // initial doLoop result value builder->setInsertionPointToStart(info.doLoop.getBody()); - // Always store iteration ssa-value to the DO variable to avoid missing - // any aliasing. Note that this assignment can only happen when executing - // an iteration of the loop. - auto lcv = builder->createConvert(loc, info.loopVariableType, - info.doLoop.getInductionVar()); - builder->create(loc, lcv, info.loopVariable); + // Update the loop variable value, as it may have non-index references. + auto value = builder->createConvert(loc, genType(info.loopVariableSym), + info.doLoop.getInductionVar()); + builder->create(loc, value, info.loopVariable); + if (info.maskExpr) { + auto ifOp = builder->create( + loc, genExprValue(*info.maskExpr), /*withOtherRegion=*/false); + builder->setInsertionPointToStart(&ifOp.whereRegion().front()); + } + genLocalInitAssignments(); return; } - // Unstructured loop preheader code - initialize tripVariable, loopVariable. - auto distance = builder->create(loc, upperValue, lowerValue); - auto adjusted = - builder->create(loc, distance, info.stepValue); - mlir::Value tripCount = - builder->create(loc, adjusted, info.stepValue); - // Unstructured loop - `--always-execute-loop-body`. - if (fir::isAlwaysExecuteLoopBody()) { - auto tripCountType = tripCount.getType(); - mlir::Value zero = builder->createIntegerConstant(loc, tripCountType, 0); - auto cond = builder->create(loc, CmpIPredicate::sle, - tripCount, zero); - auto one = builder->createIntegerConstant(loc, tripCountType, 1); + // Unstructured loop preheader - initialize tripVariable and loopVariable. + mlir::Value tripCount; + if (info.hasRealControl) { + auto delta1 = builder->create(loc, upperValue, lowerValue); + auto delta2 = builder->create(loc, delta1, info.stepValue); + tripCount = builder->create(loc, delta2, info.stepValue); + controlType = builder->getIndexType(); + tripCount = builder->createConvert(loc, controlType, tripCount); + } else { + auto delta1 = builder->create(loc, upperValue, lowerValue); + auto delta2 = builder->create(loc, delta1, info.stepValue); + tripCount = + builder->create(loc, delta2, info.stepValue); + } + if (fir::isAlwaysExecuteLoopBody()) { // minimum tripCount is 1 + auto one = builder->createIntegerConstant(loc, controlType, 1); + auto cond = builder->create(loc, CmpIPredicate::slt, + tripCount, one); tripCount = builder->create(loc, cond, one, tripCount); } - info.tripVariable = builder->createTemporary(loc, info.loopVariableType); + info.tripVariable = builder->createTemporary(loc, controlType); builder->create(loc, tripCount, info.tripVariable); builder->create(loc, lowerValue, info.loopVariable); - // Unstructured loop header code - generate loop condition. + // Unstructured loop header - generate loop condition and mask. + // Note - Currently there is no way to tag a loop as a concurrent loop. startBlock(info.headerBlock); - mlir::Value tripVariable = - builder->create(loc, info.tripVariable); - mlir::Value zero = - builder->createIntegerConstant(loc, info.loopVariableType, 0); - mlir::Value cond = builder->create( - loc, mlir::CmpIPredicate::sgt, tripVariable, zero); - genFIRConditionalBranch(cond, info.bodyBlock, info.successorBlock); + tripCount = builder->create(loc, info.tripVariable); + auto zero = builder->createIntegerConstant(loc, controlType, 0); + auto cond = builder->create(loc, mlir::CmpIPredicate::sgt, + tripCount, zero); + if (info.maskExpr) { + genFIRConditionalBranch(cond, info.maskBlock, info.exitBlock); + startBlock(info.maskBlock); + auto latchBlock = getEval().getLastNestedEvaluation().block; + assert(latchBlock && "missing masked concurrent loop latch block"); + genFIRConditionalBranch(genExprValue(*info.maskExpr), info.bodyBlock, + latchBlock); + } else { + genFIRConditionalBranch(cond, info.bodyBlock, info.exitBlock); + if (!info.isInnermost) + startBlock(info.bodyBlock); // preheader block of enclosed dimension + } + if (!info.localInitSymList.empty()) { + auto insertPt = builder->saveInsertionPoint(); + builder->setInsertionPointToStart(info.bodyBlock); + genLocalInitAssignments(); + builder->restoreInsertionPoint(insertPt); + } } /// Generate FIR to end a structured or unstructured increment loop. void genFIRIncrementLoopEnd(IncrementLoopInfo &info) { auto loc = toLocation(); if (info.isStructured()) { - // End fir.do_loop. - mlir::Value inc = builder->create( - loc, info.doLoop.getInductionVar(), info.doLoop.step()); - builder->create(loc, inc); - builder->restoreInsertionPoint(info.insertionPoint); - auto lcv = builder->createConvert(loc, info.loopVariableType, + // End fir.do_loop. A concurrent loop result is illegitimate/irrelevant. + builder->setInsertionPointToEnd(info.doLoop.getBody()); + auto result = info.doLoop.getInductionVar(); + if (!info.isUnordered) + result = builder->create(loc, result, info.doLoop.step()); + builder->create(loc, result); + builder->setInsertionPointAfter(info.doLoop); + if (info.isUnordered) + return; + // The loop control variable may be used after loop execution. + auto lcv = builder->createConvert(loc, genType(info.loopVariableSym), info.doLoop.getResult(0)); builder->create(loc, lcv, info.loopVariable); return; } - // Unstructured loop - increment loopVariable. - mlir::Value loopVariable = - builder->create(loc, info.loopVariable); - loopVariable = - builder->create(loc, loopVariable, info.stepValue); - builder->create(loc, loopVariable, info.loopVariable); - - // Unstructured loop - decrement tripVariable. - mlir::Value tripVariable = + // Unstructured loop - decrement tripVariable and step loopVariable. + mlir::Value tripCount = builder->create(loc, info.tripVariable); - mlir::Value one = builder->create( - loc, builder->getIntegerAttr(info.loopVariableType, 1)); - tripVariable = builder->create(loc, tripVariable, one); - builder->create(loc, tripVariable, info.tripVariable); - genBranch(info.headerBlock); + auto tripVarType = info.hasRealControl ? builder->getIndexType() + : genType(info.loopVariableSym); + auto one = builder->createIntegerConstant(loc, tripVarType, 1); + tripCount = builder->create(loc, tripCount, one); + builder->create(loc, tripCount, info.tripVariable); + mlir::Value value = builder->create(loc, info.loopVariable); + if (info.hasRealControl) + value = builder->create(loc, value, info.stepValue); + else + value = builder->create(loc, value, info.stepValue); + builder->create(loc, value, info.loopVariable); + + genFIRBranch(info.headerBlock); + if (!info.isOutermost) + startBlock(info.exitBlock); // latch block of enclosing dimension } /// Generate structured or unstructured FIR for an IF construct. @@ -998,7 +1104,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { genFIR(e, /*unstructuredContext=*/false); } } - setCurrentEval(eval); return; } @@ -1023,7 +1128,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { genFIR(e); } } - setCurrentEval(eval); } void genFIR(const Fortran::parser::CaseConstruct &) { @@ -1255,9 +1359,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (!iostat) return; - mlir::Block *endBlock{}; - mlir::Block *eorBlock{}; - mlir::Block *errBlock{}; + mlir::Block *endBlock = nullptr; + mlir::Block *eorBlock = nullptr; + mlir::Block *errBlock = nullptr; for (const auto &spec : specList) { std::visit(Fortran::common::visitors{ [&](const Fortran::parser::EndLabel &label) { @@ -1642,13 +1746,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(const Fortran::parser::CycleStmt &) { - genBranch(getEval().controlSuccessor->block); + genFIRBranch(getEval().controlSuccessor->block); } void genFIR(const Fortran::parser::ExitStmt &) { - genBranch(getEval().controlSuccessor->block); + genFIRBranch(getEval().controlSuccessor->block); } void genFIR(const Fortran::parser::GotoStmt &) { - genBranch(getEval().controlSuccessor->block); + genFIRBranch(getEval().controlSuccessor->block); } /// Generate the FIR for the Evaluation `eval`. @@ -1657,7 +1761,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (eval.skip) return; // rhs of {Forall,If,Where}Stmt has already been processed - setCurrentPosition(eval.position); if (unstructuredContext) { // When transitioning from unstructured to structured code, // the structured code could be a target that starts a new block. @@ -1667,6 +1770,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } setCurrentEval(eval); + setCurrentPosition(eval.position); eval.visit([&](const auto &stmt) { genFIR(stmt); }); if (unstructuredContext && blockIsUnterminated()) { @@ -1678,9 +1782,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { eval.getLastNestedEvaluation() .lexicalSuccessor->isIntermediateConstructStmt()) successor = eval.constructExit; - if (successor && successor->block) - genBranch(successor->block); + genFIRBranch(successor->block); } } @@ -1988,13 +2091,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { "dummy CHARACTER argument must be boxchar"); } else { // local CHARACTER variable - if (auto c = sba.getCharLenConst()) { + if (auto c = sba.getCharLenConst()) len = builder->createIntegerConstant(loc, idxTy, *c); - } else if (auto e = sba.getCharLenExpr()) { + else if (auto e = sba.getCharLenExpr()) len = genExprValue(*e); - } else { + else len = builder->createIntegerConstant(loc, idxTy, sym.size()); - } assert(!addr); } } @@ -2421,7 +2523,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } if (alternateEntryEval) { - genBranch(alternateEntryEval->block); + genFIRBranch(alternateEntryEval->block); builder->setInsertionPointToStart( builder->createBlock(&builder->getRegion())); } @@ -2430,11 +2532,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// Create empty blocks for the current function. void createEmptyBlocks( std::list &evaluationList) { + auto *region = &builder->getRegion(); for (auto &eval : evaluationList) { if (eval.isNewBlock) - eval.block = builder->createBlock(&builder->getRegion()); - for (size_t i = 0, n = eval.localBlocks.size(); i < n; ++i) - eval.localBlocks[i] = builder->createBlock(&builder->getRegion()); + eval.block = builder->createBlock(region); + for (auto &block : eval.localBlocks) + block = builder->createBlock(region); if (eval.isConstruct() || eval.isDirective()) { if (eval.lowerAsUnstructured()) { createEmptyBlocks(eval.getNestedEvaluations()); @@ -2442,7 +2545,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // A structured construct that is a target starts a new block. auto &constructStmt = eval.getFirstNestedEvaluation(); if (constructStmt.isNewBlock) - constructStmt.block = builder->createBlock(&builder->getRegion()); + constructStmt.block = builder->createBlock(region); } } } @@ -2457,11 +2560,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// Unconditionally switch code insertion to a new block. void startBlock(mlir::Block *newBlock) { assert(newBlock && "missing block"); - // If the current block does not have a terminator branch, - // append a fallthrough branch. if (blockIsUnterminated()) - genBranch(newBlock); - builder->setInsertionPointToStart(newBlock); + genFIRBranch(newBlock); // default termination is a fallthrough branch + builder->setInsertionPointToEnd(newBlock); // newBlock might not be empty } /// Conditionally switch code insertion to a new block. diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 41e5aef4a36a0..c14ad3af4b2fb 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -320,9 +320,8 @@ class PFTBuilder { "entry must be a subprogram"); entryPointList.push_back(std::pair{sym, p}); } - if (p->label.has_value()) { + if (p->label.has_value()) labelEvaluationMap->try_emplace(*p->label, p); - } return evaluationListStack.back()->back(); } @@ -349,9 +348,8 @@ class PFTBuilder { const auto *label = std::visit( [](const auto &label) -> const parser::Label * { using B = std::decay_t; - if constexpr (common::HasMember) { + if constexpr (common::HasMember) return &label.v; - } return nullptr; }, spec.u); @@ -448,14 +446,14 @@ class PFTBuilder { parser::TypeGuardStmt, parser::WhereConstructStmt>; if constexpr (common::HasMember) { - if (auto name{std::get>(stmt.t)}) + if (auto name = std::get>(stmt.t)) return name->ToString(); } // These statements have several std::optional if constexpr (std::is_same_v || std::is_same_v) { - if (auto name{std::get<0>(stmt.t)}) + if (auto name = std::get<0>(stmt.t)) return name->ToString(); } return {}; @@ -466,7 +464,7 @@ class PFTBuilder { template void insertConstructName(const A &stmt, lower::pft::Evaluation *parentConstruct) { - std::string name{getConstructName(stmt)}; + std::string name = getConstructName(stmt); if (!name.empty()) constructNameMap[name] = parentConstruct; } @@ -476,24 +474,24 @@ class PFTBuilder { /// top-level statements of a program. void analyzeBranches(lower::pft::Evaluation *parentConstruct, std::list &evaluationList) { - lower::pft::Evaluation *lastConstructStmtEvaluation{nullptr}; - lower::pft::Evaluation *lastIfStmtEvaluation{nullptr}; + lower::pft::Evaluation *lastConstructStmtEvaluation{}; + lower::pft::Evaluation *lastIfStmtEvaluation{}; for (auto &eval : evaluationList) { eval.visit(common::visitors{ - // Action statements + // Action statements (except I/O statements) [&](const parser::CallStmt &s) { // Look for alternate return specifiers. - const auto &args{std::get>(s.v.t)}; + const auto &args = + std::get>(s.v.t); for (const auto &arg : args) { - const auto &actual{std::get(arg.t)}; - if (const auto *altReturn{ - std::get_if(&actual.u)}) { + const auto &actual = std::get(arg.t); + if (const auto *altReturn = + std::get_if(&actual.u)) markBranchTarget(eval, altReturn->v); - } } }, [&](const parser::CycleStmt &s) { - std::string name{getConstructName(s)}; + std::string name = getConstructName(s); lower::pft::Evaluation *construct{name.empty() ? doConstructStack.back() : constructNameMap[name]}; @@ -501,7 +499,7 @@ class PFTBuilder { markBranchTarget(eval, construct->evaluationList->back()); }, [&](const parser::ExitStmt &s) { - std::string name{getConstructName(s)}; + std::string name = getConstructName(s); lower::pft::Evaluation *construct{name.empty() ? doConstructStack.back() : constructNameMap[name]}; @@ -542,9 +540,8 @@ class PFTBuilder { lower::pft::Evaluation *target{ labelEvaluationMap->find(label)->second}; assert(target && "missing branch target evaluation"); - if (!target->isA()) { + if (!target->isA()) target->isNewBlock = true; - } auto iter = assignSymbolLabelMap->find(*sym); if (iter == assignSymbolLabelMap->end()) { lower::pft::LabelSet labelSet{}; @@ -591,59 +588,56 @@ class PFTBuilder { [&](const parser::NonLabelDoStmt &s) { insertConstructName(s, parentConstruct); doConstructStack.push_back(parentConstruct); - auto &control{std::get>(s.t)}; - // eval.block is the loop preheader block, which will be set - // elsewhere if the NonLabelDoStmt is itself a target. - // eval.localBlocks[0] is the loop header block. - eval.localBlocks.emplace_back(nullptr); - if (!control.has_value()) { + const auto &loopControl = std::get<1>(s.t); + if (!loopControl.has_value()) { eval.isUnstructured = true; // infinite loop return; } eval.nonNopSuccessor().isNewBlock = true; eval.controlSuccessor = &evaluationList.back(); - if (std::holds_alternative(control->u)) + if (const auto *bounds = std::get_if<0>(&loopControl->u)) { + if (bounds->name.thing.symbol->GetType()->IsNumeric( + common::TypeCategory::Real)) + eval.isUnstructured = true; // real-valued loop control + } else if (std::get_if<1>(&loopControl->u)) { eval.isUnstructured = true; // while loop - // Defer additional processing for an unstructured concurrent loop - // to the EndDoStmt, when the loop is known to be unstructured. + } }, [&](const parser::EndDoStmt &) { - lower::pft::Evaluation &doEval{evaluationList.front()}; + lower::pft::Evaluation &doEval = evaluationList.front(); eval.controlSuccessor = &doEval; doConstructStack.pop_back(); if (parentConstruct->lowerAsStructured()) return; - - // Now that the loop is known to be unstructured, finish concurrent - // loop processing, using NonLabelDoStmt information. + // The loop is unstructured, which wasn't known for all cases when + // visiting the NonLabelDoStmt. doEval.block is the loop preheader + // block, which will be set elsewhere if the NonLabelDoStmt is + // itself a target. doEval.localBlocks[0] is the loop header block. + doEval.localBlocks.emplace_back(nullptr); parentConstruct->constructExit->isNewBlock = true; const auto &doStmt = doEval.getIf(); - assert(doStmt && "missing NonLabelDoStmt"); - auto &control = - std::get>(doStmt->t); - if (!control.has_value()) + const auto &loopControl = std::get<1>(doStmt->t); + if (!loopControl.has_value()) return; // infinite loop - - const auto *concurrent = - std::get_if(&control->u); + const auto *concurrent = std::get_if<2>(&loopControl->u); if (!concurrent) return; - - // Unstructured concurrent loop. NonLabelDoStmt code accounts - // for one concurrent loop dimension. Reserve preheader, - // header, and latch blocks for the remaining dimensions, and - // one block for a mask expression. - const auto &header = - std::get(concurrent->t); - auto dims = - std::get>(header.t).size(); - for (; dims > 1; --dims) { - doEval.localBlocks.emplace_back(nullptr); // preheader - doEval.localBlocks.emplace_back(nullptr); // header - eval.localBlocks.emplace_back(nullptr); // latch - } - if (std::get>(header.t)) - doEval.localBlocks.emplace_back(nullptr); // mask + // Unstructured concurrent loop. Reserve header, body, and latch + // blocks for each loop dimension, and one block for a mask. + // The original loop body provides the body and latch blocks of + // the innermost dimension, so adjust for those. The (first) body + // block of a non-innermost dimension is the preheader block of + // the immediately enclosed dimension. The latch block of a + // non-innermost dimension is the exit block of the immediately + // enclosed dimension. Reserving these blocks in advance, while + // not strictly required, allows "in order" code generation, which + // is much easier to read and debug. + const auto &header = std::get<0>(concurrent->t); + const auto dims = std::get<1>(header.t).size(); + const bool hasMask = std::get<2>(header.t).has_value(); + doEval.localBlocks.resize(2 * dims + hasMask - 1); // header, body + eval.localBlocks.resize(dims - 1); // latch blocks + eval.isNewBlock |= hasMask; }, [&](const parser::IfThenStmt &s) { insertConstructName(s, parentConstruct); @@ -708,6 +702,7 @@ class PFTBuilder { eval.isUnstructured = true; }, + // Default - Common analysis for I/O statements; otherwise nop. [&](const auto &stmt) { using A = std::decay_t; using IoStmts = std::tuple; - if constexpr (common::HasMember) { + if constexpr (common::HasMember) analyzeIoBranches(eval, stmt); - } - - /* do nothing */ }, }); @@ -747,15 +739,13 @@ class PFTBuilder { } // Propagate isUnstructured flag to enclosing construct. - if (parentConstruct && eval.isUnstructured) { + if (parentConstruct && eval.isUnstructured) parentConstruct->isUnstructured = true; - } // The successor of a branch starts a new block. if (eval.controlSuccessor && eval.isActionStmt() && - eval.lowerAsUnstructured()) { + eval.lowerAsUnstructured()) markSuccessorAsNewBlock(eval); - } } } @@ -802,15 +792,15 @@ class PFTBuilder { /// functionList points to the internal or module procedure function list /// of a FunctionLikeUnit or a ModuleLikeUnit. It may be null. - std::list *functionList{nullptr}; + std::list *functionList{}; std::vector constructAndDirectiveStack{}; std::vector doConstructStack{}; /// evaluationListStack is the current nested construct evaluationList state. std::vector evaluationListStack{}; llvm::DenseMap *labelEvaluationMap{}; - lower::pft::SymbolLabelMap *assignSymbolLabelMap{nullptr}; + lower::pft::SymbolLabelMap *assignSymbolLabelMap{}; std::map constructNameMap{}; - lower::pft::Evaluation *lastLexicalEvaluation{nullptr}; + lower::pft::Evaluation *lastLexicalEvaluation{}; }; class PFTDumper { @@ -1268,8 +1258,8 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( : ProgramUnit{func, parent}, endStmt{ getFunctionStmt( func)} { - const auto &programStmt{ - std::get>>(func.t)}; + const auto &programStmt = + std::get>>(func.t); if (programStmt.has_value()) { beginStmt = programStmt.value(); auto symbol = getSymbol(*beginStmt); diff --git a/flang/test/Lower/loops.f90 b/flang/test/Lower/loops.f90 new file mode 100644 index 0000000000000..bb71370097e93 --- /dev/null +++ b/flang/test/Lower/loops.f90 @@ -0,0 +1,62 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + + ! CHECK-DAG: fir.alloca !fir.array<5x5x5xi32> {name = "a"} + ! CHECK-DAG: fir.alloca i8 {name = "i"} + ! CHECK-DAG: fir.alloca i16 {name = "i"} + ! CHECK-DAG: fir.alloca i32 {name = "i"} + ! CHECK-DAG: fir.alloca i32 {name = "i"} + ! CHECK-DAG: fir.alloca i8 {name = "j"} + ! CHECK-DAG: fir.alloca i32 {name = "j"} + ! CHECK-DAG: fir.alloca i32 {name = "j"} + ! CHECK-DAG: fir.alloca i8 {name = "k"} + ! CHECK-DAG: fir.alloca i32 {name = "k"} + ! CHECK-DAG: fir.alloca i32 {name = "k"} + integer(4) :: a(5,5,5), i, j, k, asum, xsum + + i = 100 + j = 200 + k = 300 + + ! CHECK-COUNT-3: fir.do_loop {{.*}} unordered + do concurrent (i=1:5, j=1:5, k=1:5) ! shared(a) + ! CHECK: fir.coordinate_of + a(i,j,k) = 0 + enddo + ! CHECK: fir.call @_FortranAioBeginExternalListOutput + print*, i, j, k + + ! CHECK-COUNT-3: fir.do_loop {{.*}} unordered + do concurrent (integer(1)::i=1:5, j=1:5, k=1:5, i.ne.j .and. k.ne.3) shared(a) + ! CHECK-COUNT-2: fir.coordinate_of + a(i,j,k) = a(i,j,k) + 1 + enddo + + ! CHECK-COUNT-3: fir.do_loop {{[^un]*}} -> (index) + asum = 0 + do i=1,5 + do j=1,5 + do k=1,5 + ! CHECK: fir.coordinate_of + asum = asum + a(i,j,k) + enddo + enddo + enddo + ! CHECK: fir.call @_FortranAioBeginExternalListOutput + print*, i, j, k, '-', asum + + ! CHECK-NOT: fir.do_loop + do concurrent (integer(2)::i=1:5, i.ne.3) + if (i.eq.2 .or. i.eq.4) goto 9 + ! CHECK: fir.call @_FortranAioBeginExternalListOutput + print*, i + 9 continue + enddo + + xsum = 0.0 + ! CHECK-NOT: fir.do_loop + do x = 1.5, 3.5, 0.3 + xsum = xsum + 1 + enddo + ! CHECK: fir.call @_FortranAioBeginExternalFormattedOutput + print '(X,F3.1,A,I2)', x, ' -', xsum +end diff --git a/flang/test/Lower/unstructured-loop.f90 b/flang/test/Lower/unstructured-loop.f90 index 73333b1ca52b6..9fca180438552 100644 --- a/flang/test/Lower/unstructured-loop.f90 +++ b/flang/test/Lower/unstructured-loop.f90 @@ -8,11 +8,10 @@ subroutine some() integer :: i ! CHECK: [[tripcount:%[0-9]+]] = divi_signed - ! CHECK: [[zero:%c0_i32]] = constant 0 : i32 - ! CHECK: [[cmp:%5]] = cmpi "sle", [[tripcount]], [[zero]] : i32 - ! CHECK: [[one:%c1_i32_1]] = constant 1 : i32 - ! CHECK: [[newtripcount:%6]] = select [[cmp]], [[one]], [[tripcount]] : i32 - ! CHECK: fir.store [[newtripcount]] to %0 : !fir.ref + ! CHECK: [[one:%c1_i32[_0-9]*]] = constant 1 : i32 + ! CHECK: [[cmp:%[0-9]+]] = cmpi "slt", [[tripcount]], [[one]] : i32 + ! CHECK: [[newtripcount:%[0-9]+]] = select [[cmp]], [[one]], [[tripcount]] : i32 + ! CHECK: fir.store [[newtripcount]] to %{{[0-9]+}} : !fir.ref do i=4,1,1 stop 2 end do From 3900284774232bd0153c9b83fd70f1b9afbf94ba Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 17 Sep 2020 14:52:20 -0700 Subject: [PATCH 0260/1017] Fixes the linker problems in #382. --- flang/lib/Lower/Bridge.cpp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 16344e19b6d6f..8085bb1488573 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2357,11 +2357,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { LLVM_DEBUG(llvm::dbgs() << "}\n"); builder.create(loc, cb); }; - auto linkage = builder->createLinkOnceLinkage(); // create the global object global = builder->createGlobal(loc, commonTy, commonName, - /*isConstant=*/false, initFunc, linkage); + /*isConstant=*/false, initFunc); } // introduce a local AddrOf and add it to the map auto addrOf = builder->create(loc, global.resultType(), From d49605c33d3f8d415d4d236390f1d23c63463aa2 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 17 Sep 2020 14:59:25 -0700 Subject: [PATCH 0261/1017] update test file --- flang/test/Lower/common.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/test/Lower/common.f90 b/flang/test/Lower/common.f90 index db03576d4d42a..3cc0a59d7dbaf 100644 --- a/flang/test/Lower/common.f90 +++ b/flang/test/Lower/common.f90 @@ -1,7 +1,7 @@ ! RUN: bbc %s -o - | tco | FileCheck %s ! CHECK: @_QB = common global [8 x i8] zeroinitializer -! CHECK: @_QBx = linkonce global { float, float } { float 1.0{{.*}}, float 2.0{{.*}} } +! CHECK: @_QBx = global { float, float } { float 1.0{{.*}}, float 2.0{{.*}} } ! CHECK: @_QBy = common global [12 x i8] zeroinitializer ! CHECK-LABEL: _QPs0 From f1d4220339fd508f03a61d155b6bbff7a1a5bb35 Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 16 Sep 2020 16:57:49 -0700 Subject: [PATCH 0262/1017] Pass around extended values so that they can be used in more places. This implements the various TODO items in IO.cpp that needed extended values to construct correct code. Fixes #371 #372 #373 #376 #385 #389 --- flang/include/flang/Lower/AbstractConverter.h | 15 ++- flang/include/flang/Lower/CallInterface.h | 1 - flang/include/flang/Lower/FIRBuilder.h | 23 ++-- flang/lib/Lower/Bridge.cpp | 114 ++++++++++-------- flang/lib/Lower/CallInterface.cpp | 2 +- flang/lib/Lower/FIRBuilder.cpp | 33 +++++ flang/lib/Lower/Runtime.cpp | 4 +- .../Optimizer/Transforms/AffinePromotion.cpp | 8 +- .../lib/Optimizer/Transforms/RewriteLoop.cpp | 4 +- 9 files changed, 127 insertions(+), 77 deletions(-) diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h index bb1aa0d5a3d2a..ea4c300f2e1d6 100644 --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -14,6 +14,7 @@ #define FORTRAN_LOWER_ABSTRACTCONVERTER_H #include "flang/Common/Fortran.h" +#include "flang/Lower/Support/BoxValue.h" #include "flang/Lower/Utils.h" #include "mlir/IR/BuiltinOps.h" @@ -22,6 +23,7 @@ namespace common { template class Reference; } + namespace evaluate { struct DataRef; template @@ -73,18 +75,19 @@ class AbstractConverter { //===--------------------------------------------------------------------===// /// Generate the address of the location holding the expression, someExpr - virtual mlir::Value genExprAddr(const SomeExpr &, - mlir::Location *loc = nullptr) = 0; + virtual fir::ExtendedValue genExprAddr(const SomeExpr &, + mlir::Location *loc = nullptr) = 0; /// Generate the address of the location holding the expression, someExpr - mlir::Value genExprAddr(const SomeExpr *someExpr, mlir::Location loc) { + fir::ExtendedValue genExprAddr(const SomeExpr *someExpr, mlir::Location loc) { return genExprAddr(*someExpr, &loc); } /// Generate the computations of the expression to produce a value - virtual mlir::Value genExprValue(const SomeExpr &, - mlir::Location *loc = nullptr) = 0; + virtual fir::ExtendedValue genExprValue(const SomeExpr &, + mlir::Location *loc = nullptr) = 0; /// Generate the computations of the expression, someExpr, to produce a value - mlir::Value genExprValue(const SomeExpr *someExpr, mlir::Location loc) { + fir::ExtendedValue genExprValue(const SomeExpr *someExpr, + mlir::Location loc) { return genExprValue(*someExpr, &loc); } diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index 2e095a61f4916..6d3fc7fc15fd3 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -31,7 +31,6 @@ #include "mlir/IR/Function.h" #include #include -#include namespace Fortran::semantics { class Symbol; diff --git a/flang/include/flang/Lower/FIRBuilder.h b/flang/include/flang/Lower/FIRBuilder.h index 0bf54c9e15638..f09365aaf825d 100644 --- a/flang/include/flang/Lower/FIRBuilder.h +++ b/flang/include/flang/Lower/FIRBuilder.h @@ -25,6 +25,10 @@ #include "llvm/ADT/DenseMap.h" #include "llvm/ADT/Optional.h" +namespace fir { +class ExtendedValue; +} + namespace Fortran::lower { class AbstractConverter; @@ -141,21 +145,13 @@ class FirOpBuilder : public mlir::OpBuilder { // Linkage helpers (inline). The default linkage is external. //===--------------------------------------------------------------------===// - mlir::StringAttr createCommonLinkage() { - return getStringAttr("common"); - } + mlir::StringAttr createCommonLinkage() { return getStringAttr("common"); } - mlir::StringAttr createInternalLinkage() { - return getStringAttr("internal"); - } + mlir::StringAttr createInternalLinkage() { return getStringAttr("internal"); } - mlir::StringAttr createLinkOnceLinkage() { - return getStringAttr("linkonce"); - } + mlir::StringAttr createLinkOnceLinkage() { return getStringAttr("linkonce"); } - mlir::StringAttr createWeakLinkage() { - return getStringAttr("weak"); - } + mlir::StringAttr createWeakLinkage() { return getStringAttr("weak"); } /// Get a function by name. If the function exists in the current module, it /// is returned. Otherwise, a null FuncOp is returned. @@ -211,6 +207,9 @@ class FirOpBuilder : public mlir::OpBuilder { return createConvert(loc, getIndexType(), val); } + /// Create one of the shape ops given an extended value. + mlir::Value createShape(mlir::Location loc, const fir::ExtendedValue &exv); + private: const fir::KindMapping &kindMap; }; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 8085bb1488573..8914a92662a21 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -347,13 +347,18 @@ class FirConverter : public Fortran::lower::AbstractConverter { return iter->second; } - mlir::Value genExprAddr(const Fortran::lower::SomeExpr &expr, - mlir::Location *loc = nullptr) override final { - return createFIRAddr(loc ? *loc : toLocation(), &expr); + fir::ExtendedValue genExprAddr(const Fortran::lower::SomeExpr &expr, + mlir::Location *loc = nullptr) override final { + Fortran::lower::ExpressionContext context; + return createSomeExtendedAddress(loc ? *loc : toLocation(), *this, expr, + localSymbols, context); } - mlir::Value genExprValue(const Fortran::lower::SomeExpr &expr, - mlir::Location *loc = nullptr) override final { - return createFIRExpr(loc ? *loc : toLocation(), &expr); + fir::ExtendedValue + genExprValue(const Fortran::lower::SomeExpr &expr, + mlir::Location *loc = nullptr) override final { + Fortran::lower::ExpressionContext context; + return createSomeExtendedExpression(loc ? *loc : toLocation(), *this, expr, + localSymbols, context); } Fortran::evaluate::FoldingContext &getFoldingContext() override final { return foldingContext; @@ -466,11 +471,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Helper member functions //===--------------------------------------------------------------------===// - mlir::Value createFIRAddr(mlir::Location loc, - const Fortran::semantics::SomeExpr *expr) { - return createSomeAddress(loc, *this, *expr, localSymbols); - } - mlir::Value createFIRExpr(mlir::Location loc, const Fortran::semantics::SomeExpr *expr) { return createSomeExpression(loc, *this, *expr, localSymbols); @@ -555,13 +555,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIRConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr, mlir::Block *trueTarget, mlir::Block *falseTarget) { - mlir::Value cond = genExprValue(*Fortran::semantics::GetExpr(expr)); + mlir::Value cond = + createFIRExpr(toLocation(), Fortran::semantics::GetExpr(expr)); genFIRConditionalBranch(cond, trueTarget, falseTarget); } void genFIRConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr, Fortran::lower::pft::Evaluation *trueTarget, Fortran::lower::pft::Evaluation *falseTarget) { - mlir::Value cond = genExprValue(*Fortran::semantics::GetExpr(expr)); + auto cond = createFIRExpr(toLocation(), Fortran::semantics::GetExpr(expr)); genFIRConditionalBranch(cond, trueTarget->block, falseTarget->block); } @@ -638,15 +639,24 @@ class FirConverter : public Fortran::lower::AbstractConverter { template std::pair genIfCondition(const A *stmt, bool withElse = true) { - auto cond = genExprValue(*Fortran::semantics::GetExpr( - std::get(stmt->t))); + auto cond = createFIRExpr( + toLocation(), + Fortran::semantics::GetExpr( + std::get(stmt->t))); auto bcc = builder->createConvert(toLocation(), builder->getI1Type(), cond); auto ifOp = builder->create(toLocation(), bcc, withElse); auto insPt = builder->saveInsertionPoint(); - builder->setInsertionPointToStart(&ifOp.whereRegion().front()); + builder->setInsertionPointToStart(&ifOp.thenRegion().front()); return {insPt, ifOp}; } + mlir::Value genFIRLoopIndex(const Fortran::parser::ScalarExpr &x, + mlir::Type t) { + auto loc = toLocation(); + mlir::Value v = createFIRExpr(loc, Fortran::semantics::GetExpr(x)); + return builder->createConvert(loc, t, v); + } + mlir::FuncOp getFunc(llvm::StringRef name, mlir::FunctionType ty) { if (auto func = builder->getNamedFunction(name)) { assert(func.getType() == ty); @@ -660,8 +670,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto &eval = getEval(); setCurrentPosition(stmt.v.source); assert(stmt.typedCall && "Call was not analyzed"); - Fortran::semantics::SomeExpr expr{*stmt.typedCall}; // Call statement lowering shares code with function call lowering. + Fortran::semantics::SomeExpr expr{*stmt.typedCall}; auto res = createFIRExpr(toLocation(), &expr); if (!res) return; // "Normal" subroutine call. @@ -701,10 +711,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) { auto &eval = getEval(); - auto selectExpr = genExprValue(*Fortran::semantics::GetExpr( - std::get(stmt.t))); - llvm::SmallVector indexList; - llvm::SmallVector blockList; + auto selectExpr = createFIRExpr( + toLocation(), Fortran::semantics::GetExpr( + std::get(stmt.t))); + llvm::SmallVector indexList; + llvm::SmallVector blockList; int64_t index = 0; for (auto &label : std::get>(stmt.t)) { indexList.push_back(++index); @@ -717,8 +728,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) { auto &eval = getEval(); - auto expr = genExprValue( - *Fortran::semantics::GetExpr(std::get(stmt.t))); + auto expr = createFIRExpr( + toLocation(), + Fortran::semantics::GetExpr(std::get(stmt.t))); auto exprType = expr.getType(); auto loc = toLocation(); if (exprType.isSignlessInteger()) { @@ -947,7 +959,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { : genType(info.loopVariableSym); auto genControlValue = [&](const Fortran::semantics::SomeExpr *expr) { if (expr) - return builder->createConvert(loc, controlType, genExprValue(*expr)); + return builder->createConvert(loc, controlType, + createFIRExpr(loc, expr)); if (!info.hasRealControl) return builder->createIntegerConstant(loc, controlType, 1); // step auto one = @@ -982,8 +995,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->create(loc, value, info.loopVariable); if (info.maskExpr) { auto ifOp = builder->create( - loc, genExprValue(*info.maskExpr), /*withOtherRegion=*/false); - builder->setInsertionPointToStart(&ifOp.whereRegion().front()); + loc, createFIRExpr(loc, info.maskExpr), /*withElseRegion=*/false); + builder->setInsertionPointToStart(&ifOp.thenRegion().front()); } genLocalInitAssignments(); return; @@ -1025,7 +1038,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { startBlock(info.maskBlock); auto latchBlock = getEval().getLastNestedEvaluation().block; assert(latchBlock && "missing masked concurrent loop latch block"); - genFIRConditionalBranch(genExprValue(*info.maskExpr), info.bodyBlock, + genFIRConditionalBranch(createFIRExpr(loc, info.maskExpr), info.bodyBlock, latchBlock); } else { genFIRConditionalBranch(cond, info.bodyBlock, info.exitBlock); @@ -1093,11 +1106,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { std::tie(insPt, nestedIf) = genIfCondition(s); } else if (auto *s = e.getIf()) { // otherwise block, then nested fir.if - builder->setInsertionPointToStart(&nestedIf.otherRegion().front()); + builder->setInsertionPointToStart(&nestedIf.elseRegion().front()); std::tie(std::ignore, nestedIf) = genIfCondition(s); } else if (e.isA()) { // otherwise block - builder->setInsertionPointToStart(&nestedIf.otherRegion().front()); + builder->setInsertionPointToStart(&nestedIf.elseRegion().front()); } else if (e.isA()) { builder->restoreInsertionPoint(insPt); } else { @@ -1204,8 +1217,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { using ScalarExpr = Fortran::parser::Scalar; MLIRContext *context = builder->getContext(); auto loc = toLocation(); - auto selectExpr = genExprValue( - *Fortran::semantics::GetExpr(std::get(stmt.t))); + auto selectExpr = createFIRExpr( + toLocation(), + Fortran::semantics::GetExpr(std::get(stmt.t))); auto selectType = selectExpr.getType(); Fortran::lower::CharacterExprHelper helper{*builder, loc}; if (helper.isCharacter(selectExpr.getType())) { @@ -1221,7 +1235,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { const auto v = Fortran::evaluate::ToInt64(*expr); valueList.push_back( v ? builder->createIntegerConstant(loc, selectType, *v) - : builder->createConvert(loc, selectType, genExprValue(*expr))); + : builder->createConvert(loc, selectType, + createFIRExpr(toLocation(), expr))); }; for (Fortran::lower::pft::Evaluation *e = eval.controlSuccessor; e; e = e->controlSuccessor) { @@ -1467,9 +1482,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { for (auto s : shape) { if (s.has_value()) { - auto ub = builder->createConvert( - loc, idxTy, - genExprValue(Fortran::evaluate::AsGenericExpr(std::move(*s)))); + auto e = Fortran::evaluate::AsGenericExpr(std::move(*s)); + auto ub = builder->createConvert(loc, idxTy, createFIRExpr(loc, &e)); auto up = builder->create(loc, ub, one); extents.push_back(up); } else { @@ -1586,9 +1600,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Conversions should have been inserted by semantic analysis, // but they can be incorrect between the rhs and lhs. Correct // that here. - mlir::Value addr = isPointer ? genExprValue(assign.lhs) - : genExprAddr(assign.lhs); - auto val = genExprValue(assign.rhs); + auto addr = fir::getBase(isPointer ? genExprValue(assign.lhs) + : genExprAddr(assign.lhs)); + auto val = createFIRExpr(loc, &assign.rhs); // A function with multiple entry points returning different // types tags all result variables with one of the largest // types to allow them to share the same storage. Assignment @@ -1608,7 +1622,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Fortran 2018 10.2.1.3 p10 and p11 // Generating value for lhs to get fir.boxchar. Fortran::lower::ExpressionContext context; - auto lhs = genExprAddr(assign.lhs); + auto lhs = fir::getBase(genExprAddr(assign.lhs)); auto rhs = createSomeExtendedExpression( toLocation(), *this, assign.rhs, localSymbols, context); Fortran::lower::CharacterExprHelper{*builder, loc}.createAssign( @@ -1728,10 +1742,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { // to the compiler-generated result variable. const auto &symbol = funit->getSubprogramSymbol(); if (Fortran::semantics::HasAlternateReturns(symbol)) { - auto expr = Fortran::semantics::GetExpr(*stmt.v); + const auto *expr = Fortran::semantics::GetExpr(*stmt.v); assert(expr && "missing alternate return expression"); auto altReturnIndex = builder->createConvert( - loc, builder->getIndexType(), genExprValue(*expr)); + loc, builder->getIndexType(), createFIRExpr(loc, expr)); builder->create(loc, altReturnIndex, getAltReturnResult(symbol)); } @@ -2077,7 +2091,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { addr = charHelp.createEmboxChar(boxAddr, len); } else if (auto e = sba.getCharLenExpr()) { // Set/override LEN with an expression - len = genExprValue(*e); + len = createFIRExpr(loc, &*e); addr = charHelp.createEmboxChar(boxAddr, len); } else { // LEN is from the boxchar @@ -2094,7 +2108,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (auto c = sba.getCharLenConst()) len = builder->createIntegerConstant(loc, idxTy, *c); else if (auto e = sba.getCharLenExpr()) - len = genExprValue(*e); + len = createFIRExpr(loc, &*e); else len = builder->createIntegerConstant(loc, idxTy, sym.size()); assert(!addr); @@ -2168,8 +2182,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto high = spec->ubound().GetExplicit(); if (low && high) { // let the folder deal with the common `ub - 1 + 1` case - auto lb = genExprValue(Fortran::semantics::SomeExpr{*low}); - auto ub = genExprValue(Fortran::semantics::SomeExpr{*high}); + Fortran::semantics::SomeExpr lowEx{*low}; + auto lb = createFIRExpr(loc, &lowEx); + Fortran::semantics::SomeExpr highEx{*high}; + auto ub = createFIRExpr(loc, &highEx); auto ty = ub.getType(); auto diff = builder->create(loc, ty, ub, lb); auto one = builder->createIntegerConstant(loc, ty, 1); @@ -2181,7 +2197,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } if (low && spec->ubound().isAssumed()) { // An assumed size array. The extent is not computed. - auto lb = genExprValue(Fortran::semantics::SomeExpr{*low}); + Fortran::semantics::SomeExpr lowEx{*low}; + auto lb = createFIRExpr(loc, &lowEx); lbounds.emplace_back(lb); extents.emplace_back(mlir::Value{}); } @@ -2358,9 +2375,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder.create(loc, cb); }; // create the global object - global = - builder->createGlobal(loc, commonTy, commonName, - /*isConstant=*/false, initFunc); + global = builder->createGlobal(loc, commonTy, commonName, + /*isConstant=*/false, initFunc); } // introduce a local AddrOf and add it to the map auto addrOf = builder->create(loc, global.resultType(), diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index 4615d71473426..09cec17f44bde 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -144,7 +144,7 @@ mlir::Value Fortran::lower::CallerInterface::getResultLength() { assert(typeAndShape && "no result type"); auto expr = AsGenericExpr(typeAndShape->LEN().value()); if (Fortran::evaluate::IsConstantExpr(expr)) - return converter.genExprValue(expr); + return fir::getBase(converter.genExprValue(expr)); llvm_unreachable( "non constant result length on caller side not yet safely handled"); } diff --git a/flang/lib/Lower/FIRBuilder.cpp b/flang/lib/Lower/FIRBuilder.cpp index ec6e910377453..b81cc06120d71 100644 --- a/flang/lib/Lower/FIRBuilder.cpp +++ b/flang/lib/Lower/FIRBuilder.cpp @@ -11,6 +11,7 @@ #include "flang/Lower/Bridge.h" #include "flang/Lower/ComplexExpr.h" #include "flang/Lower/ConvertType.h" +#include "flang/Lower/Support/BoxValue.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Semantics/symbol.h" #include "llvm/Support/ErrorHandling.h" @@ -187,3 +188,35 @@ fir::StringLitOp Fortran::lower::FirOpBuilder::createStringLit( return create(loc, llvm::ArrayRef{arrTy}, llvm::None, attrs); } + +mlir::Value +Fortran::lower::FirOpBuilder::createShape(mlir::Location loc, + const fir::ExtendedValue &exv) { + auto ctor = [&](const fir::AbstractArrayBox &box) -> mlir::Value { + if (box.lboundsAllOne()) { + // Create a ShapeOp with nominal origin of all ones. + auto shapeTy = fir::ShapeType::get(getContext(), box.getExtents().size()); + return create(loc, shapeTy, box.getExtents()); + } + // Create a ShapeShiftOp, as origin may not be all ones. + auto idxTy = getIndexType(); + auto shapeTy = + fir::ShapeShiftType::get(getContext(), box.getExtents().size()); + llvm::SmallVector pairs; + for (const auto &pair : llvm::zip(box.getLBounds(), box.getExtents())) { + auto lb = createConvert(loc, idxTy, std::get<0>(pair)); + pairs.push_back(lb); + auto ext = createConvert(loc, idxTy, std::get<1>(pair)); + pairs.push_back(ext); + } + return create(loc, shapeTy, pairs); + }; + return exv.match([&](const fir::ArrayBoxValue &box) { return ctor(box); }, + [&](const fir::CharArrayBoxValue &box) { return ctor(box); }, + [&](const fir::BoxValue &box) { return ctor(box); }, + [&](const auto &) { + exv.dump(); + mlir::emitError(loc, "expected shape on entity"); + return mlir::Value{}; + }); +} diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index d3e6381866f6b..047b0488d0616 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -85,7 +85,7 @@ void Fortran::lower::genStopStatement( std::get>(stmt.t)) { auto expr = Fortran::semantics::GetExpr(*code); assert(expr && "failed getting typed expression"); - operands.push_back(converter.genExprValue(*expr)); + operands.push_back(fir::getBase(converter.genExprValue(*expr))); } else { operands.push_back( builder.createIntegerConstant(loc, calleeType.getInput(0), 0)); @@ -101,7 +101,7 @@ void Fortran::lower::genStopStatement( std::get>(stmt.t)) { auto expr = Fortran::semantics::GetExpr(*quiet); assert(expr && "failed getting typed expression"); - operands.push_back(converter.genExprValue(*expr)); + operands.push_back(fir::getBase(converter.genExprValue(*expr))); } else { operands.push_back( builder.createIntegerConstant(loc, calleeType.getInput(2), 0)); diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index 21c02e37b3721..0985a366b4043 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -507,7 +507,7 @@ class AffineIfConversion : public mlir::OpRewritePattern { mlir::PatternRewriter &rewriter) const override { LLVM_DEBUG(llvm::dbgs() << "AffineIfConversion: rewriting if:\n"; op.dump();); - auto &ifOps = op.whereRegion().front().getOperations(); + auto &ifOps = op.thenRegion().front().getOperations(); auto affineCondition = AffineIfCondition(op.condition()); if (!affineCondition.integerSet) { LLVM_DEBUG( @@ -517,12 +517,12 @@ class AffineIfConversion : public mlir::OpRewritePattern { } auto affineIf = rewriter.create( op.getLoc(), affineCondition.integerSet.getValue(), - affineCondition.affineArgs, !op.otherRegion().empty()); + affineCondition.affineArgs, !op.elseRegion().empty()); rewriter.startRootUpdate(affineIf); affineIf.getThenBlock()->getOperations().splice( --affineIf.getThenBlock()->end(), ifOps, ifOps.begin(), --ifOps.end()); - if (!op.otherRegion().empty()) { - auto &otherOps = op.otherRegion().front().getOperations(); + if (!op.elseRegion().empty()) { + auto &otherOps = op.elseRegion().front().getOperations(); affineIf.getElseBlock()->getOperations().splice( --affineIf.getElseBlock()->end(), otherOps, otherOps.begin(), --otherOps.end()); diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 2564f3cf44726..a0fcd98d4b6ab 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -157,7 +157,7 @@ class CfgIfConv : public mlir::OpRewritePattern { // Move blocks from the "then" region to the region containing 'fir.if', // place it before the continuation block, and branch to it. - auto &ifOpRegion = ifOp.whereRegion(); + auto &ifOpRegion = ifOp.thenRegion(); auto *ifOpBlock = &ifOpRegion.front(); auto *ifOpTerminator = ifOpRegion.back().getTerminator(); auto ifOpTerminatorOperands = ifOpTerminator->getOperands(); @@ -170,7 +170,7 @@ class CfgIfConv : public mlir::OpRewritePattern { // 'fir.if', place it before the continuation block and branch to it. It // will be placed after the "then" regions. auto *otherwiseBlock = continueBlock; - auto &otherwiseRegion = ifOp.otherRegion(); + auto &otherwiseRegion = ifOp.elseRegion(); if (!otherwiseRegion.empty()) { otherwiseBlock = &otherwiseRegion.front(); auto *otherwiseTerm = otherwiseRegion.back().getTerminator(); From 2719847a411326761259fd9fb24305db7f6a279a Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 18 Sep 2020 13:08:19 -0700 Subject: [PATCH 0263/1017] Fixes the logical edit descriptor mismatch. #379 --- flang/include/flang/Lower/Support/TypeCode.h | 17 +++++++++++++++-- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 13 ++++++++----- 2 files changed, 23 insertions(+), 7 deletions(-) diff --git a/flang/include/flang/Lower/Support/TypeCode.h b/flang/include/flang/Lower/Support/TypeCode.h index d57657e739294..64a5c62300084 100644 --- a/flang/include/flang/Lower/Support/TypeCode.h +++ b/flang/include/flang/Lower/Support/TypeCode.h @@ -59,9 +59,18 @@ inline int integerBitsToTypeCode(unsigned bits) { // clang-format on } -// FIXME: LOGICAL has no type codes defined; using integer for now +// Always use CFI_type_Bool and let the rest get sorted out by the elem_size. +// NB: do *not* use the CFI_type_intN_t codes. The flang runtime will choke. inline int logicalBitsToTypeCode(unsigned bits) { - llvm_unreachable("logical type has no direct support; use integer"); + // clang-format off + switch (bits) { + case 8: + case 16: + case 32: + case 64: return CFI_type_Bool; + default: llvm_unreachable("unsupported logical size"); + } + // clang-format on } inline int realBitsToTypeCode(unsigned bits) { @@ -76,6 +85,10 @@ inline int realBitsToTypeCode(unsigned bits) { // clang-format on } +static constexpr int derivedToTypeCode() { + return CFI_type_struct; +} + } // namespace fir #endif // LOWER_SUPPORT_TYPECODE_H diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index cea97ef92b61e..7ccaf5b58cd47 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -1273,6 +1273,12 @@ struct EmboxCommonConversion : public FIROpConversion { return {this->genConstantOffset(loc, rewriter, width / 8), this->genConstantOffset(loc, rewriter, typeCode)}; }; + auto doLogical = + [&](unsigned width) -> std::tuple { + int typeCode = fir::logicalBitsToTypeCode(width); + return {this->genConstantOffset(loc, rewriter, width / 8), + this->genConstantOffset(loc, rewriter, typeCode)}; + }; auto doFloat = [&](unsigned width) -> std::tuple { int typeCode = fir::realBitsToTypeCode(width); return {this->genConstantOffset(loc, rewriter, width / 8), @@ -1319,11 +1325,8 @@ struct EmboxCommonConversion : public FIROpConversion { if (auto ty = boxEleTy.dyn_cast()) return doCharacter(getKindMap().getCharacterBitsize(ty.getFKind()), ty.getLen()); - if (auto ty = boxEleTy.dyn_cast()) { - // TODO: doesn't the runtime need to know these are LOGICAL? Pretend they - // are INTEGER for now. - return doInteger(getKindMap().getLogicalBitsize(ty.getFKind())); - } + if (auto ty = boxEleTy.dyn_cast()) + return doLogical(getKindMap().getLogicalBitsize(ty.getFKind())); if (auto seqTy = boxEleTy.dyn_cast()) { if (auto charTy = seqTy.getEleTy().dyn_cast()) { // TODO: assumes the row is the length of the CHARACTER. This is true by From e12dda7a7a8f36967405b2ccb67392e99f12c70c Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 18 Sep 2020 17:38:05 -0700 Subject: [PATCH 0264/1017] Fix #333 --- flang/lib/Lower/ConvertExpr.cpp | 13 +++++++++---- flang/test/Lower/arguments.f90 | 9 +++++++++ 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index d2ef5375050c9..27d5408c01f37 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1265,11 +1265,13 @@ class ExprLowering { template fir::ExtendedValue gen(const Fortran::evaluate::FunctionRef &func) { - assert(func.GetType().has_value() && "function has no type"); + if (!func.GetType().has_value()) + mlir::emitError(getLoc(), "internal: a function must have a type"); auto resTy = genType(*func.GetType()); auto retVal = genProcedureRef(func, llvm::ArrayRef{resTy}); + auto casted = builder.createConvert(getLoc(), resTy, fir::getBase(retVal)); auto mem = builder.create(getLoc(), resTy); - builder.create(getLoc(), fir::getBase(retVal), mem); + builder.create(getLoc(), casted, mem); return mem.getResult(); } @@ -1382,7 +1384,7 @@ class ExprLowering { Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr)) { argVal = symMap.lookupSymbol(*argSymbol); } else { - auto exv = genval(*expr); + auto exv = genExtAddr(*expr); // FIXME: should use the box values, etc. argVal = fir::getBase(exv); } @@ -1560,9 +1562,12 @@ class ExprLowering { if constexpr (inRefSet>) { return gen(a); } else { + auto val = fir::getBase(genval(a)); + // Functions are always referent. + if (val.getType().template isa()) + return val; // Since `a` is not itself a valid referent, determine its value and // create a temporary location for referencing. - auto val = fir::getBase(genval(a)); auto mem = builder.create(getLoc(), val.getType()); builder.create(getLoc(), val, mem); return mem.getResult(); diff --git a/flang/test/Lower/arguments.f90 b/flang/test/Lower/arguments.f90 index 2478dc251c1ff..af1fc0f044415 100644 --- a/flang/test/Lower/arguments.f90 +++ b/flang/test/Lower/arguments.f90 @@ -21,3 +21,12 @@ subroutine foo(avar1) ! CHECK: } end program test1 +! CHECK-LABEL: func @_QPsub2 +function sub2(r) + real :: r(20) + ! CHECK: %[[coor:.*]] = fir.coordinate_of %arg0 + ! CHECK: = fir.call @_QPf(%[[coor]]) : (!fir.ref) -> f32 + sub2 = f(r(1)) + ! CHECK: return %{{.*}} : f32 +end function sub2 + From d5de1777a2cc4048094900f4231b8161b659ddb1 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 21 Sep 2020 12:58:26 -0700 Subject: [PATCH 0265/1017] fixes for #378 --- flang/include/flang/Lower/CharacterExpr.h | 3 ++- flang/lib/Lower/Bridge.cpp | 6 ++---- flang/lib/Lower/IntervalSet.h | 15 +++++++++++---- flang/test/Lower/character-assignment.f90 | 7 +++++-- 4 files changed, 20 insertions(+), 11 deletions(-) diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index 71442d87de9d6..28dba7a916eca 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -53,7 +53,8 @@ class CharacterExprHelper { /// Lower \p lhs = \p rhs where \p lhs and \p rhs are scalar characters. /// It handles cases where \p lhs and \p rhs may overlap. - void createAssign(mlir::Value lhs, const fir::ExtendedValue &rhs); + void createAssign(const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs); /// Lower an assignment where the buffer and LEN parameter are known and do /// not need to be unboxed. diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 8914a92662a21..1d5b32845f128 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1621,10 +1621,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (isCharacterCategory(lhsType->category())) { // Fortran 2018 10.2.1.3 p10 and p11 // Generating value for lhs to get fir.boxchar. - Fortran::lower::ExpressionContext context; - auto lhs = fir::getBase(genExprAddr(assign.lhs)); - auto rhs = createSomeExtendedExpression( - toLocation(), *this, assign.rhs, localSymbols, context); + auto lhs = genExprAddr(assign.lhs); + auto rhs = genExprValue(assign.rhs); Fortran::lower::CharacterExprHelper{*builder, loc}.createAssign( lhs, rhs); return; diff --git a/flang/lib/Lower/IntervalSet.h b/flang/lib/Lower/IntervalSet.h index 89c9489eddd7b..667eb2534a9b9 100644 --- a/flang/lib/Lower/IntervalSet.h +++ b/flang/lib/Lower/IntervalSet.h @@ -83,6 +83,7 @@ struct IntervalSet { m.insert({lo, up}); } } else { + auto i1 = i; if (i == end() || i->first > lo) i = std::prev(i); // i->first <= lo @@ -92,11 +93,17 @@ struct IntervalSet { } // i->second < up if (i->second < lo) { - // i < [lo..up] - m.insert({lo, up}); - return; + if (i1 == end() || i1->first > up) { + // i < [lo..up] < i1 + m.insert({lo, up}); + return; + } + // i < [lo..up], i1->first <= up --> [lo..up] union [i1..?] + i = i1; + } else { + // i->first <= lo, lo <= i->second --> [i->first..up] union [i..?] + lo = i->first; } - lo = i->first; auto j = m.upper_bound(up); // up < j->first auto cu = std::prev(j)->second; diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index 1a54bda63af64..b66bedd65227c 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -28,6 +28,7 @@ subroutine assign1(lhs, rhs) ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp2]], %[[i]] ! CHECK: fir.store %[[rhs_elt]] to %[[tmp_addr]] ! CHECK-NEXT: } + ! CHECK: %[[lhs:.*]]:2 = fir.unboxchar %arg0 ! Copy of temp into lhs ! CHECK: fir.do_loop %[[ii:.*]] = @@ -40,8 +41,9 @@ subroutine assign1(lhs, rhs) ! CHECK-NEXT: } ! Padding - ! CHECK: %[[c32:.*]] = constant 32 : i8 - ! CHECK: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> + ! CHECK-DAG: %[[lhs:.*]]:2 = fir.unboxchar %arg0 + ! CHECK-DAG: %[[c32:.*]] = constant 32 : i8 + ! CHECK-DAG: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> ! CHECK: fir.do_loop %[[ij:.*]] = ! CHECK: %[[lhs_addr2:.*]] = fir.convert %[[lhs]]#0 ! CHECK: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs_addr2]], %[[ij]] @@ -106,6 +108,7 @@ subroutine assign_constant(lhs) ! CHECK: } ! Padding + ! CHECK-DAG: %[[lhs:.*]]:2 = fir.unboxchar %arg0 ! CHECK-DAG: %[[c32:.*]] = constant 32 : i8 ! CHECK-DAG: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> ! CHECK: fir.do_loop %[[j:.*]] = %{{.*}} to %{{.*}} { From fa92ba47dfc690dd0c691b921de056de45b6f31f Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 21 Sep 2020 19:21:42 -0700 Subject: [PATCH 0266/1017] fixes for #383 --- flang/lib/Lower/ConvertExpr.cpp | 56 ++++++++++++++++++++++++++------- 1 file changed, 44 insertions(+), 12 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 27d5408c01f37..56ecedc06df0f 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -295,8 +295,35 @@ class ExprLowering { return addr; } - mlir::Value genLoad(mlir::Value addr) { - return builder.create(getLoc(), addr); + /// Generate a load of a value from an address. + mlir::Value genLoad(const fir::ExtendedValue &addr) { + auto loc = getLoc(); + return addr.match( + [&](const fir::CharBoxValue &box) -> mlir::Value { + auto buffer = box.getBuffer(); + auto len = dyn_cast(box.getLen().getDefiningOp()); + if (!len) { + // TODO: return an emboxchar? + mlir::emitError(loc, "cannot load a variable length char"); + return {}; + } + auto lenAttr = len.value().dyn_cast(); + if (!lenAttr) { + mlir::emitError(loc, "length must be integer"); + return {}; + } + auto lenConst = lenAttr.getValue().getSExtValue(); + fir::SequenceType::Shape shape = {lenConst}; + auto baseTy = + Fortran::lower::CharacterExprHelper::getCharacterType(box); + auto charTy = + builder.getRefType(fir::SequenceType::get(shape, baseTy)); + auto casted = builder.createConvert(loc, charTy, buffer); + return builder.create(loc, casted); + }, + [&](const auto &v) -> mlir::Value { + return builder.create(loc, fir::getBase(v)); + }); } // FIXME: replace this @@ -1097,21 +1124,26 @@ class ExprLowering { llvm::report_fatal_error("TODO: array slice not supported"); }; return si.match( - [&](const Fortran::lower::SymbolBox::FullDim &arr) { + [&](const Fortran::lower::SymbolBox::FullDim &arr) + -> fir::ExtendedValue { if (!inArrayContext() && isSlice(aref)) return genArraySlice(arr); return genFullDim(arr, one); }, - [&](const Fortran::lower::SymbolBox::CharFullDim &arr) { - return genFullDim(arr, arr.getLen()); + [&](const Fortran::lower::SymbolBox::CharFullDim &arr) + -> fir::ExtendedValue { + auto len = arr.getLen(); + return fir::CharBoxValue(genFullDim(arr, len), len); }, - [&](const Fortran::lower::SymbolBox::Derived &arr) { - TODO(); - return mlir::Value{}; + [&](const Fortran::lower::SymbolBox::Derived &arr) + -> fir::ExtendedValue { + // TODO: implement + mlir::emitError(loc, "not implemented: array of derived type"); + return {}; }, - [&](const auto &) { - TODO(); - return mlir::Value{}; + [&](const auto &) -> fir::ExtendedValue { + mlir::emitError(loc, "internal: array lowering failed"); + return {}; }); } @@ -1235,7 +1267,7 @@ class ExprLowering { } fir::ExtendedValue genval(const Fortran::evaluate::ArrayRef &aref) { - return genLoad(fir::getBase(gen(aref))); + return genLoad(gen(aref)); } fir::ExtendedValue gen(const Fortran::evaluate::CoarrayRef &coref) { From 58d2c1299f1dd198e0fb204216ff9a12b5aa9920 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 22 Sep 2020 05:59:09 -0700 Subject: [PATCH 0267/1017] Fix ShapeShiftOp rewrite undefined behaviour --- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index 9e308ecb42cbb..a92f498b70c00 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -109,16 +109,18 @@ class EmboxConversion : public mlir::OpRewritePattern { auto shapeOp = dyn_cast(shapeVal.getDefiningOp()); llvm::SmallVector shapeOpers; llvm::SmallVector shiftOpers; + unsigned rank; if (shapeOp) { populateShape(shapeOpers, shapeOp); + rank = shapeOp.getType().cast().getRank(); } else { auto shiftOp = dyn_cast(shapeVal.getDefiningOp()); assert(shiftOp && "shape is neither fir.shape nor fir.shape_shift"); populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); + rank = shiftOp.getType().cast().getRank(); } mlir::NamedAttrList attrs; auto idxTy = rewriter.getIndexType(); - auto rank = shapeOp.getType().cast().getRank(); auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); attrs.push_back(rewriter.getNamedAttr(XEmboxOp::rankAttrName(), rankAttr)); auto lenParamSize = embox.lenParams().size(); @@ -160,16 +162,18 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { auto shapeOp = dyn_cast(shapeVal.getDefiningOp()); llvm::SmallVector shapeOpers; llvm::SmallVector shiftOpers; + unsigned rank; if (shapeOp) { populateShape(shapeOpers, shapeOp); + rank = shapeOp.getType().cast().getRank(); } else { auto shiftOp = dyn_cast(shapeVal.getDefiningOp()); if (shiftOp) populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); + rank = shiftOp.getType().cast().getRank(); } mlir::NamedAttrList attrs; auto idxTy = rewriter.getIndexType(); - auto rank = shapeOp.getType().cast().getRank(); auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); attrs.push_back( rewriter.getNamedAttr(XArrayCoorOp::rankAttrName(), rankAttr)); @@ -181,8 +185,7 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { auto idxAttr = rewriter.getIntegerAttr(idxTy, indexSize); attrs.push_back( rewriter.getNamedAttr(XArrayCoorOp::indexAttrName(), idxAttr)); - auto shapeSize = shapeOp.getNumOperands(); - auto dimAttr = rewriter.getIntegerAttr(idxTy, shapeSize); + auto dimAttr = rewriter.getIntegerAttr(idxTy, shapeOpers.size()); attrs.push_back( rewriter.getNamedAttr(XArrayCoorOp::shapeAttrName(), dimAttr)); llvm::SmallVector sliceOpers; From 4e7678ffb0f7f29ac7ad0c1dd28a425e7ead8034 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Mon, 14 Sep 2020 00:31:41 +0530 Subject: [PATCH 0268/1017] [flang][OpenMP] Parallel region codegen support Executable can be generated and tested as: ``` $ bbc -fopenmp -emit-fir parallel.f90 -o -| tco | llc -filetype=obj -o parallel.o $ clang parallel.o -L/PATH/lib -lFortranRuntime -lFortranDecimal -L/PATH/lib/ -lomp -lstdc++ -lm $ ./a.out ``` Extended test case for `if statement`. TODO: extend for `do loop` Added OpenMPToLLVMPass to bbc pass pipeline --- flang/lib/Lower/Bridge.cpp | 4 + .../test/Lower/OpenMP/omp-parallel-region.f90 | 118 ++++++++++++++++++ 2 files changed, 122 insertions(+) create mode 100644 flang/test/Lower/OpenMP/omp-parallel-region.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 1d5b32845f128..89b06c6113211 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1205,7 +1205,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(const Fortran::parser::OpenMPConstruct &omp) { + auto insertPt = builder->saveInsertionPoint(); genOpenMPConstruct(*this, getEval(), omp); + for (auto &e : getEval().getNestedEvaluations()) + genFIR(e); + builder->restoreInsertionPoint(insertPt); } void genFIR(const Fortran::parser::OmpEndLoopDirective &omp) { diff --git a/flang/test/Lower/OpenMP/omp-parallel-region.f90 b/flang/test/Lower/OpenMP/omp-parallel-region.f90 new file mode 100644 index 0000000000000..0497abd9e50d4 --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-region.f90 @@ -0,0 +1,118 @@ +! This test checks lowering of OpenMP parallel Directive with arbitrary code +! inside it. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: tco | FileCheck %s --check-prefix=LLVMIR + +program parallel + + integer :: a,b,c + integer :: num_threads + + a = 1 + b = 2 +!FIRDialect: %[[VAR_A:.*]] = fir.alloca i32 {name = "a"} +!FIRDialect: %[[VAR_B:.*]] = fir.alloca i32 {name = "b"} +!FIRDialect: %[[VAR_C:.*]] = fir.alloca i32 {name = "c"} +!FIRDialect: %[[VAR_NUM_THREADS:.*]] = fir.alloca i32 {name = "num_threads"} + +!LLVMIRDialect: %[[VAR_A:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "a"} +!LLVMIRDialect: %[[VAR_B:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "b"} +!LLVMIRDialect: %[[VAR_C:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "c"} +!LLVMIRDialect: %[[VAR_NUM_THREADS:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "num_threads"} + +!LLVMIR: %[[OMP_GLOBAL_THREAD_NUM:.*]] = call i32 @__kmpc_global_thread_num(%struct.ident_t* @{{.*}}) +!LLVMIR: call void @__kmpc_push_num_threads(%struct.ident_t* @{{.*}}, i32 %[[OMP_GLOBAL_THREAD_NUM]], i32 %{{.*}}) + +!$OMP PARALLEL NUM_THREADS(num_threads) +!FIRDialect: omp.parallel num_threads(%{{.*}} : i32) { +!FIRDialect-DAG: %[[OMP_VAR_A:.*]] = fir.load %[[VAR_A]] +!FIRDialect-DAG: %[[OMP_VAR_B:.*]] = fir.load %[[VAR_B]] +!FIRDialect: %[[OMP_VAR_C:.*]] = addi %[[OMP_VAR_A]], %[[OMP_VAR_B]] +!FIRDialect: fir.store %[[OMP_VAR_C]] to %[[VAR_C]] +!FIRDialect: %[[CONSTANT:.*]] = constant 4 : i32 +!FIRDialect: %[[COND_C:.*]] = fir.load %[[VAR_C]] : !fir.ref +!FIRDialect: %[[COND_RES:.*]] = cmpi "sgt", %[[COND_C]], %[[CONSTANT]] : i32 +!FIRDialect: fir.if %[[COND_RES]] { +!FIRDialect: fir.call @_FortranAioBeginExternalListOutput +!FIRDialect: fir.call @_FortranAioOutputAscii +!FIRDialect: fir.call @_FortranAioEndIoStatement +!FIRDialect: } else { +!FIRDialect-NEXT: } +!FIRDialect: fir.call @_FortranAioBeginExternalListOutput +!FIRDialect: fir.load %[[VAR_C]] +!FIRDialect: fir.call @_FortranAioOutputInteger64 +!FIRDialect: fir.call @_FortranAioEndIoStatement +!FIRDialect: omp.terminator +!FIRDialect-NEXT: } + +!LLVMIRDialect-LABEL: omp.parallel num_threads(%{{.*}} : !llvm.i32) { +!LLVMIRDialect-DAG: %[[OMP_VAR_A:.*]] = llvm.load %[[VAR_A:.*]] +!LLVMIRDialect-DAG: %[[OMP_VAR_B:.*]] = llvm.load %[[VAR_B:.*]] +!LLVMIRDialect: %[[OMP_VAR_C:.*]] = llvm.add %[[OMP_VAR_B]], %[[OMP_VAR_A]] +!LLVMIRDialect: llvm.store %[[OMP_VAR_C]], %[[VAR_C]] +!LLVMIRDialect: %[[COND_C:.*]] = llvm.load %[[VAR_C]] : !llvm.ptr +!LLVMIRDialect: %[[COND_RES:.*]] = llvm.icmp "sgt" %[[COND_C]], %{{.*}} : !llvm.i32 +!LLVMIRDialect: llvm.cond_br %[[COND_RES]], ^bb1, ^bb2 +!LLVMIRDialect: ^bb1: // pred: ^bb0 +!LLVMIRDialect: llvm.call @_FortranAioBeginExternalListOutput +!LLVMIRDialect: llvm.call @_FortranAioOutputAscii +!LLVMIRDialect: llvm.call @_FortranAioEndIoStatement +!LLVMIRDialect: llvm.br ^bb2 +!LLVMIRDialect: ^bb2: // 2 preds: ^bb0, ^bb1 +!LLVMIRDialect: llvm.call @_FortranAioBeginExternalListOutput +!LLVMIRDialect: llvm.load %[[VAR_C]] : !llvm.ptr +!LLVMIRDialect: llvm.call @_FortranAioOutputInteger64 +!LLVMIRDialect: llvm.call @_FortranAioEndIoStatement +!LLVMIRDialect: omp.terminator +!LLVMIRDialect-NEXT: } + +!LLVMIR: call {{.*}} @__kmpc_fork_call(%struct.ident_t* @{{.*}} @_QQmain..omp_par + +!LLVMIR-LABEL: define internal void @_QQmain..omp_par +!LLVMIR: br label %[[REGION_1:.*]] +!LLVMIR: [[REGION_1]]: +!LLVMIR: br label %[[REGION_1_1:.*]] +!LLVMIR: [[REGION_1_1]]: +!LLVMIR: %[[COND_RES:.*]] = icmp sgt i32 %{{.*}}, 4 +!LLVMIR: br i1 %[[COND_RES]], label %{{.*}}, label %{{.*}} +!LLVMIR: call i8* @_FortranAioBeginExternalListOutput +!LLVMIR: call i1 @_FortranAioOutputInteger64 +!LLVMIR: call i32 @_FortranAioEndIoStatement + c = a + b + + if (c .gt. 4) then + print*, "Inside If Statement" + endif + + print*, c + +!$OMP END PARALLEL + +!$OMP PARALLEL + print*, "Second Region" +!FIRDialect: omp.parallel { +!FIRDialect: fir.call @_FortranAioBeginExternalListOutput +!FIRDialect: fir.call @_FortranAioOutputAscii +!FIRDialect: fir.call @_FortranAioEndIoStatement +!FIRDialect: omp.terminator +!FIRDialect-NEXT: } + +!LLVMIRDialect: omp.parallel { +!LLVMIRDialect: llvm.call @_FortranAioBeginExternalListOutput +!LLVMIRDialect: llvm.call @_FortranAioOutputAscii +!LLVMIRDialect: llvm.call @_FortranAioEndIoStatement +!LLVMIRDialect: omp.terminator +!LLVMIRDialect: } + +!LLVMIR-DAG-LABEL: call {{.*}} @__kmpc_fork_call(%struct.ident_t* @{{.*}} @_QQmain..omp_par.1 +!LLVMIR-DAG-LABEL: define internal void @_QQmain..omp_par.1 +!LLVMIR: call i8* @_FortranAioBeginExternalListOutput +!LLVMIR: call i32 @_FortranAioEndIoStatement +!$OMP END PARALLEL + +end program From 305c435b3c1ebe5d42d2c4e330d452080a614179 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 22 Sep 2020 13:08:42 -0700 Subject: [PATCH 0269/1017] rebase fallout --- flang/tools/bbc/bbc.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index c623d51b48ee6..1e9b7a01e014a 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -215,8 +215,8 @@ static mlir::LogicalResult convertFortranSourceToMLIR( // run semantics auto &parseTree = *parsing.parseTree(); - Fortran::semantics::Semantics semantics{semanticsContext, parseTree, - parsing.cooked()}; + Fortran::semantics::Semantics semantics(semanticsContext, parseTree, + parsing.cooked().AsCharBlock()); semantics.Perform(); semantics.EmitMessages(llvm::errs()); if (semantics.AnyFatalError()) { From 5726255368f22358e3b2041242a9543d468d4ec7 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 23 Sep 2020 11:25:54 -0700 Subject: [PATCH 0270/1017] fix for #445 -- bad convert on character type --- flang/lib/Lower/Bridge.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 89b06c6113211..f9621450033eb 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2038,8 +2038,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::SmallVector offs{ builder->createIntegerConstant(loc, idxTy, sym.offset() - aliasOffset)}; auto ptr = builder->create(loc, i8Ptr, base, offs); - auto preAlloc = - builder->createConvert(loc, builder->getRefType(genType(sym)), ptr); + auto preAlloc = builder->createConvert( + loc, builder->getRefType(genTypeWithCharFixup(sym)), ptr); mapSymbolAttributes(var, storeMap, preAlloc); } From 106341141ce926b5fdb767d78d6bd7d00a39f129 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Wed, 23 Sep 2020 14:53:11 -0400 Subject: [PATCH 0271/1017] [flang][openacc] Fix loop lowering tests --- flang/test/Lower/OpenACC/acc-loop.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/flang/test/Lower/OpenACC/acc-loop.f90 b/flang/test/Lower/OpenACC/acc-loop.f90 index 3a6e7b760066f..f0b93bd23cbdf 100644 --- a/flang/test/Lower/OpenACC/acc-loop.f90 +++ b/flang/test/Lower/OpenACC/acc-loop.f90 @@ -70,7 +70,7 @@ program acc_loop END DO !CHECK: [[GANGNUM1:%.*]] = constant 8 : i32 -!CHECK-NEXT: acc.loop gang(num: [[GANGNUM1]]) { +!CHECK-NEXT: acc.loop gang(num=[[GANGNUM1]]: i32) { !CHECK: fir.do_loop !CHECK: acc.yield !CHECK-NEXT: }{{$}} @@ -81,7 +81,7 @@ program acc_loop END DO !CHECK: [[GANGNUM2:%.*]] = fir.load %{{.*}} : !fir.ref -!CHECK-NEXT: acc.loop gang(num: [[GANGNUM2]]) { +!CHECK-NEXT: acc.loop gang(num=[[GANGNUM2]]: i32) { !CHECK: fir.do_loop !CHECK: acc.yield !CHECK-NEXT: }{{$}} @@ -91,7 +91,7 @@ program acc_loop a(i) = b(i) END DO -!CHECK: acc.loop gang(num: %{{.*}}, static: %{{.*}}) { +!CHECK: acc.loop gang(num=%{{.*}}: i32, static=%{{.*}}: i32) { !CHECK: fir.do_loop !CHECK: acc.yield !CHECK-NEXT: }{{$}} @@ -112,7 +112,7 @@ program acc_loop END DO !CHECK: [[CONSTANT128:%.*]] = constant 128 : i32 -!CHECK: acc.loop vector([[CONSTANT128]]) { +!CHECK: acc.loop vector([[CONSTANT128]]: i32) { !CHECK: fir.do_loop !CHECK: acc.yield !CHECK-NEXT: }{{$}} @@ -123,7 +123,7 @@ program acc_loop END DO !CHECK: [[VECTORLENGTH:%.*]] = fir.load %{{.*}} : !fir.ref -!CHECK: acc.loop vector([[VECTORLENGTH]]) { +!CHECK: acc.loop vector([[VECTORLENGTH]]: i32) { !CHECK: fir.do_loop !CHECK: acc.yield !CHECK-NEXT: }{{$}} @@ -144,7 +144,7 @@ program acc_loop END DO !CHECK: [[WORKER128:%.*]] = constant 128 : i32 -!CHECK: acc.loop worker([[WORKER128]]) { +!CHECK: acc.loop worker([[WORKER128]]: i32) { !CHECK: fir.do_loop !CHECK: acc.yield !CHECK-NEXT: }{{$}} From c0a7847dd9aa7b690bd210956a06ffb1dda9ec7d Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 23 Sep 2020 11:03:16 -0700 Subject: [PATCH 0272/1017] fix for #444 - bad merge of interval sets review comments --- flang/lib/Lower/IntervalSet.h | 50 ----------------------------------- 1 file changed, 50 deletions(-) diff --git a/flang/lib/Lower/IntervalSet.h b/flang/lib/Lower/IntervalSet.h index 667eb2534a9b9..fddeea3831731 100644 --- a/flang/lib/Lower/IntervalSet.h +++ b/flang/lib/Lower/IntervalSet.h @@ -19,12 +19,8 @@ namespace Fortran::lower { //===----------------------------------------------------------------------===// /// Interval set to keep track of intervals, merging them when they overlap one -<<<<<<< HEAD /// another. Used to refine the pseudo-offset ranges of the front-end symbols /// into groups of aliasing variables. -======= -/// another. Used to refine ranges of offsets. ->>>>>>> Update the lowering of COMMON blocks to match changes in the front-end. struct IntervalSet { using MAP = std::map; using Iterator = MAP::const_iterator; @@ -42,7 +38,6 @@ struct IntervalSet { if (up < i->first) { // [lo..up] < i->first m.insert({lo, up}); -<<<<<<< HEAD return; } // up >= i->first @@ -73,48 +68,6 @@ struct IntervalSet { lo = i->first; } fuse(lo, up, i); -======= - } else { - // up >= i->first - if (i->second > up) - up = i->second; - m.erase(i); - // merge i with [lo..max(up,i->second)] - m.insert({lo, up}); - } - } else { - auto i1 = i; - if (i == end() || i->first > lo) - i = std::prev(i); - // i->first <= lo - if (i->second >= up) { - // i->first <= lo && up <= i->second, keep i - return; - } - // i->second < up - if (i->second < lo) { - if (i1 == end() || i1->first > up) { - // i < [lo..up] < i1 - m.insert({lo, up}); - return; - } - // i < [lo..up], i1->first <= up --> [lo..up] union [i1..?] - i = i1; - } else { - // i->first <= lo, lo <= i->second --> [i->first..up] union [i..?] - lo = i->first; - } - auto j = m.upper_bound(up); - // up < j->first - auto cu = std::prev(j)->second; - // cu < j->first - if (cu > up) - up = cu; - m.erase(i, j); - // merge [i .. j) with [i->first, max(up, cu)] - m.insert({lo, up}); - } ->>>>>>> Update the lowering of COMMON blocks to match changes in the front-end. } Iterator find(std::size_t pt) const { @@ -135,7 +88,6 @@ struct IntervalSet { std::size_t size() const { return m.size(); } private: -<<<<<<< HEAD // Find and fuse overlapping sets. void fuse(std::size_t lo, std::size_t up, Iterator i) { auto j = m.upper_bound(up); @@ -149,8 +101,6 @@ struct IntervalSet { m.insert({lo, up}); } -======= ->>>>>>> Update the lowering of COMMON blocks to match changes in the front-end. MAP m{}; }; From b1fca253a5a6a2ab6eceb912c21faebd5c0959d2 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Fri, 18 Sep 2020 15:57:35 -0400 Subject: [PATCH 0273/1017] [flang][openacc] Lower parallel and data constructs --- flang/test/Lower/OpenACC/acc-data.f90 | 69 +++++++ flang/test/Lower/OpenACC/acc-parallel.f90 | 234 ++++++++++++++++++++++ 2 files changed, 303 insertions(+) create mode 100644 flang/test/Lower/OpenACC/acc-data.f90 create mode 100644 flang/test/Lower/OpenACC/acc-parallel.f90 diff --git a/flang/test/Lower/OpenACC/acc-data.f90 b/flang/test/Lower/OpenACC/acc-data.f90 new file mode 100644 index 0000000000000..0ab3de7f7fe57 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-data.f90 @@ -0,0 +1,69 @@ +! This test checks lowering of OpenACC data directive. + +! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s + +program acc_data + real, dimension(10, 10) :: a, b, c + +!CHECK: [[A:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "a"} +!CHECK: [[B:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "b"} +!CHECK: [[C:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "c"} + + !$acc data copy(a, b, c) + !$acc end data + +!CHECK: acc.data copy([[A]]: !fir.ref>, [[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + + !$acc data copy(a) copy(b) copy(c) + !$acc end data + +!CHECK: acc.data copy([[A]]: !fir.ref>, [[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + + !$acc data copyin(a) copyin(readonly: b, c) + !$acc end data + +!CHECK: acc.data copyin([[A]]: !fir.ref>) copyin_readonly([[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + + !$acc data copyout(a) copyout(zero: b) copyout(c) + !$acc end data + +!CHECK: acc.data copyout([[A]]: !fir.ref>, [[C]]: !fir.ref>) copyout_zero([[B]]: !fir.ref>) { +!CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + + !$acc data create(a, b) create(zero: c) + !$acc end data + +!CHECK: acc.data create([[A]]: !fir.ref>, [[B]]: !fir.ref>) create_zero([[C]]: !fir.ref>) { +!CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + + !$acc data no_create(a, b) create(zero: c) + !$acc end data + +!CHECK: acc.data create_zero([[C]]: !fir.ref>) no_create([[A]]: !fir.ref>, [[B]]: !fir.ref>) { +!CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + + !$acc data present(a, b, c) + !$acc end data + +!CHECK: acc.data present([[A]]: !fir.ref>, [[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + + !$acc data attach(b, c) + !$acc end data + +!CHECK: acc.data attach([[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + +end program + diff --git a/flang/test/Lower/OpenACC/acc-parallel.f90 b/flang/test/Lower/OpenACC/acc-parallel.f90 new file mode 100644 index 0000000000000..9b025d8ccecba --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-parallel.f90 @@ -0,0 +1,234 @@ +! This test checks lowering of OpenACC parallel directive. + +! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s + +program acc_parallel + integer :: i, j + + integer :: async = 1 + integer :: wait1 = 1 + integer :: wait2 = 2 + integer :: numGangs = 1 + integer :: numWorkers = 10 + integer :: vectorLength = 128 + logical :: ifCondition = .TRUE. + real, dimension(10, 10) :: a, b, c + +!CHECK: [[A:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "a"} +!CHECK: [[B:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "b"} +!CHECK: [[C:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "c"} + + !$acc parallel + !$acc end parallel + +!CHECK: acc.parallel { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel async + !$acc end parallel + +!CHECK: acc.parallel { +!CHECK: acc.yield +!CHECK-NEXT: } attributes {asyncAttr} + + !$acc parallel async(1) + !$acc end parallel + +!CHECK: [[ASYNC1:%.*]] = constant 1 : i32 +!CHECK: acc.parallel async([[ASYNC1]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel async(async) + !$acc end parallel + +!CHECK: [[ASYNC2:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: acc.parallel async([[ASYNC2]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel wait + !$acc end parallel + +!CHECK: acc.parallel { +!CHECK: acc.yield +!CHECK-NEXT: } attributes {waitAttr} + + !$acc parallel wait(1) + !$acc end parallel + +!CHECK: [[WAIT1:%.*]] = constant 1 : i32 +!CHECK: acc.parallel wait([[WAIT1]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel wait(1, 2) + !$acc end parallel + +!CHECK: [[WAIT2:%.*]] = constant 1 : i32 +!CHECK: [[WAIT3:%.*]] = constant 2 : i32 +!CHECK: acc.parallel wait([[WAIT2]]: i32, [[WAIT3]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel wait(wait1, wait2) + !$acc end parallel + +!CHECK: [[WAIT4:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: [[WAIT5:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: acc.parallel wait([[WAIT4]]: i32, [[WAIT5]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel num_gangs(1) + !$acc end parallel + +!CHECK: [[NUMGANGS1:%.*]] = constant 1 : i32 +!CHECK: acc.parallel num_gangs([[NUMGANGS1]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel num_gangs(numGangs) + !$acc end parallel + +!CHECK: [[NUMGANGS2:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: acc.parallel num_gangs([[NUMGANGS2]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel num_workers(10) + !$acc end parallel + +!CHECK: [[NUMWORKERS1:%.*]] = constant 10 : i32 +!CHECK: acc.parallel num_workers([[NUMWORKERS1]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel num_workers(numWorkers) + !$acc end parallel + +!CHECK: [[NUMWORKERS2:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: acc.parallel num_workers([[NUMWORKERS2]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel vector_length(128) + !$acc end parallel + +!CHECK: [[VECTORLENGTH1:%.*]] = constant 128 : i32 +!CHECK: acc.parallel vector_length([[VECTORLENGTH1]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel vector_length(vectorLength) + !$acc end parallel + +!CHECK: [[VECTORLENGTH2:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: acc.parallel vector_length([[VECTORLENGTH2]]: i32) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel if(.TRUE.) + !$acc end parallel + +!CHECK: [[IF1:%.*]] = constant true +!CHECK: acc.parallel if([[IF1]]) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + +! NOT WORKING YET +! !$acc parallel if(ifCondition) +! !$acc end parallel + + !$acc parallel self(.TRUE.) + !$acc end parallel + +!CHECK: [[SELF1:%.*]] = constant true +!CHECK: acc.parallel self([[SELF1]]) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel self + !$acc end parallel + +!CHECK: acc.parallel { +!CHECK: acc.yield +!CHECK-NEXT: } attributes {selfAttr} + +! NOT WORKING YET +! !$acc parallel self(ifCondition) +! !$acc end parallel + + !$acc parallel copy(a, b, c) + !$acc end parallel + +!CHECK: acc.parallel copy([[A]]: !fir.ref>, [[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel copy(a) copy(b) copy(c) + !$acc end parallel + +!CHECK: acc.parallel copy([[A]]: !fir.ref>, [[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel copyin(a) copyin(readonly: b, c) + !$acc end parallel + +!CHECK: acc.parallel copyin([[A]]: !fir.ref>) copyin_readonly([[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel copyout(a) copyout(zero: b) copyout(c) + !$acc end parallel + +!CHECK: acc.parallel copyout([[A]]: !fir.ref>, [[C]]: !fir.ref>) copyout_zero([[B]]: !fir.ref>) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel create(a, b) create(zero: c) + !$acc end parallel + +!CHECK: acc.parallel create([[A]]: !fir.ref>, [[B]]: !fir.ref>) create_zero([[C]]: !fir.ref>) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel no_create(a, b) create(zero: c) + !$acc end parallel + +!CHECK: acc.parallel create_zero([[C]]: !fir.ref>) no_create([[A]]: !fir.ref>, [[B]]: !fir.ref>) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel present(a, b, c) + !$acc end parallel + +!CHECK: acc.parallel present([[A]]: !fir.ref>, [[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel deviceptr(a) deviceptr(c) + !$acc end parallel + +!CHECK: acc.parallel deviceptr([[A]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel attach(b, c) + !$acc end parallel + +!CHECK: acc.parallel attach([[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + + !$acc parallel private(a) firstprivate(b) private(c) + !$acc end parallel + +!CHECK: acc.parallel private([[A]]: !fir.ref>, [[C]]: !fir.ref>) firstprivate([[B]]: !fir.ref>) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} + +end program + From aa8533aee7a63be884c8eb39728edcbb2139d6ce Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 24 Sep 2020 07:07:10 -0700 Subject: [PATCH 0274/1017] Fix wrong character length in READ inputs and internal IO Fix tests - remove embox/unbox now avoided fm909 fix: Use getExprAddr to get internal IO buffer Replace genExprValue by genExprAddr for inquire character variable spec --- flang/include/flang/Lower/CharacterExpr.h | 9 +++++++++ flang/test/Lower/character-assignment.f90 | 9 +++------ flang/test/Lower/concat.f90 | 7 ++----- 3 files changed, 14 insertions(+), 11 deletions(-) diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index 28dba7a916eca..2061100195f3d 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -153,6 +153,15 @@ class CharacterExprHelper { /// previous. static bool isArray(mlir::Type type); + /// Temporary helper to help migrating towards properties of + /// ExtendedValue containing characters. + /// Mainly, this ensure that characters are always CharArrayBoxValue, + /// CharBoxValue, or BoxValue and that the base address is not a boxchar. + /// Return the argument if this is not a character. + /// TODO: Create and propagate ExtendedValue according to properties listed + /// above instead of fixing it when needed. + fir::ExtendedValue cleanUpCharacterExtendedValue(const fir::ExtendedValue &); + private: fir::CharBoxValue materializeValue(mlir::Value str); fir::CharBoxValue toDataLengthPair(mlir::Value character); diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index b66bedd65227c..4c3ce15cb39cc 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -76,15 +76,12 @@ subroutine assign_substring1(str, rhs, lb, ub) ! CHECK-DAG: %[[cmp_len:.*]] = cmpi "slt", %[[pre_lhs_len]], %[[c0]] ! CHECK-DAG: %[[lhs_len:.*]] = select %[[cmp_len]], %[[c0]], %[[pre_lhs_len]] - ! CHECK: %[[lhs_box:.*]] = fir.emboxchar %[[lhs_addr]], %[[lhs_len]] ! The rest of the assignment is just as the one above, only test that the - ! substring box is the one used + ! substring is the one used as lhs. ! ... - ! CHECK: %[[lhs:.*]]:2 = fir.unboxchar %[[lhs_box]] - ! ... - ! CHECK: %[[lhs2:.*]] = fir.convert %[[lhs]]#0 - ! CHECK-NEXT: fir.coordinate_of %[[lhs2]], %arg4 + ! CHECK: %[[lhs_addr3:.*]] = fir.convert %[[lhs_addr]] + ! CHECK-NEXT: fir.coordinate_of %[[lhs_addr3]], %arg4 ! ... end subroutine diff --git a/flang/test/Lower/concat.f90 b/flang/test/Lower/concat.f90 index e29a0e096c6a7..290c4ef1de1a2 100644 --- a/flang/test/Lower/concat.f90 +++ b/flang/test/Lower/concat.f90 @@ -39,11 +39,8 @@ subroutine concat_1(a, b) ! CHECK: fir.store %[[b_elt]] to %[[temp_addr2]] ! CHECK: } - ! CHECK: %[[embox_temp:.*]] = fir.emboxchar %[[temp]], %[[len]] - ! IO runtime call - ! CHECK: %[[result:.*]]:2 = fir.unboxchar %[[embox_temp]] - ! CHECK-DAG: %[[raddr:.*]] = fir.convert %[[result]]#0 - ! CHECK-DAG: %[[rlen:.*]] = fir.convert %[[result]]#1 + ! CHECK-DAG: %[[raddr:.*]] = fir.convert %[[temp]] + ! CHECK-DAG: %[[rlen:.*]] = fir.convert %[[len]] ! CHECK: call @{{.*}}OutputAscii(%{{.*}}, %[[raddr]], %[[rlen]]) end subroutine From adfe5f4de0381f7ba0ef95bd2a079286395562e9 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 25 Sep 2020 12:29:47 -0700 Subject: [PATCH 0275/1017] Add Todo.h: version the TODO macro for Release and Debug builds. For release builds, the stack trace will be omitted. --- flang/lib/Lower/ConvertType.cpp | 11 +---------- flang/tools/bbc/bbc.cpp | 12 +++++++++--- 2 files changed, 10 insertions(+), 13 deletions(-) diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp index 43c1bb0a092cf..553999be8c527 100644 --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -8,6 +8,7 @@ #include "flang/Lower/ConvertType.h" #include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/Todo.h" #include "flang/Lower/Utils.h" #include "flang/Optimizer/Dialect/FIRType.h" #include "flang/Semantics/tools.h" @@ -15,16 +16,6 @@ #include "mlir/IR/Builders.h" #include "mlir/IR/BuiltinTypes.h" -#undef QUOTE -#undef TODO -#define QUOTE(X) #X -#define TODO(S) \ - { \ - emitError(__FILE__ ":" QUOTE(__LINE__) ": type lowering of " S \ - " not implemented"); \ - exit(1); \ - } - template bool isConstant(const Fortran::evaluate::Expr &e) { return Fortran::evaluate::IsConstantExpr(Fortran::lower::SomeExpr{e}); diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 1e9b7a01e014a..cad8cdb8194c4 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -279,15 +279,20 @@ static mlir::LogicalResult convertFortranSourceToMLIR( } else { // run the default canned pipeline pm.addPass(std::make_unique()); + + // simplify the IR pm.addPass(mlir::createCanonicalizerPass()); pm.addPass(fir::createCSEPass()); - // pm.addPass(fir::createPromoteToAffinePass()); + pm.addPass(mlir::createInlinerPass()); + pm.addPass(mlir::createCSEPass()); + + // convert control flow to CFG form pm.addPass(fir::createFirToCfgPass()); pm.addPass(fir::createControlFlowLoweringPass()); pm.addPass(mlir::createLowerToCFGPass()); - // pm.addPass(fir::createMemToRegPass()); - pm.addPass(mlir::createCSEPass()); + pm.addPass(mlir::createCanonicalizerPass()); + pm.addPass(fir::createCSEPass()); } if (emitLLVM) { @@ -295,6 +300,7 @@ static mlir::LogicalResult convertFortranSourceToMLIR( pm.addPass(fir::createFirCodeGenRewritePass()); pm.addPass(fir::createFirTargetRewritePass()); pm.addPass(fir::createFIRToLLVMPass(nameUniquer)); + std::error_code ec; llvm::ToolOutputFile outFile(outputName + ".ll", ec, llvm::sys::fs::OF_None); From 545b5ed28df70ceff3566e84ac86d1bdf2f36571 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 25 Sep 2020 13:16:43 -0700 Subject: [PATCH 0276/1017] convert lowering over to use Todo.h --- flang/lib/Lower/Bridge.cpp | 80 ++++++++++++++++----------------- flang/lib/Lower/Coarray.cpp | 9 +--- flang/lib/Lower/ConvertExpr.cpp | 60 ++++++++++++------------- flang/lib/Lower/Mangler.cpp | 5 +-- 4 files changed, 72 insertions(+), 82 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index f9621450033eb..cd5adf320840b 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -25,6 +25,7 @@ #include "flang/Lower/OpenMP.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" +#include "flang/Lower/Todo.h" #include "flang/Lower/Support/BoxValue.h" #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" @@ -45,9 +46,6 @@ #define DEBUG_TYPE "flang-lower-bridge" -#undef TODO -#define TODO() llvm_unreachable("not yet implemented"); - static llvm::cl::opt dumpBeforeFir( "fdebug-dump-pre-fir", llvm::cl::init(false), llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation")); @@ -1185,7 +1183,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { }, s.u); } - TODO(); + TODO(""); } void genFIR(const Fortran::parser::ForallAssignmentStmt &s) { @@ -1227,7 +1225,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto selectType = selectExpr.getType(); Fortran::lower::CharacterExprHelper helper{*builder, loc}; if (helper.isCharacter(selectExpr.getType())) { - TODO(); + TODO(""); } llvm::SmallVector attrList; llvm::SmallVector valueList; @@ -1292,13 +1290,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::ElseStmt &) {} // nop void genFIR(const Fortran::parser::EndIfStmt &) {} // nop - void genFIR(const Fortran::parser::AssociateConstruct &) { TODO(); } - void genFIR(const Fortran::parser::AssociateStmt &) { TODO(); } - void genFIR(const Fortran::parser::EndAssociateStmt &) { TODO(); } + void genFIR(const Fortran::parser::AssociateConstruct &) { TODO(""); } + void genFIR(const Fortran::parser::AssociateStmt &) { TODO(""); } + void genFIR(const Fortran::parser::EndAssociateStmt &) { TODO(""); } - void genFIR(const Fortran::parser::BlockConstruct &) { TODO(); } - void genFIR(const Fortran::parser::BlockStmt &) { TODO(); } - void genFIR(const Fortran::parser::EndBlockStmt &) { TODO(); } + void genFIR(const Fortran::parser::BlockConstruct &) { TODO(""); } + void genFIR(const Fortran::parser::BlockStmt &) { TODO(""); } + void genFIR(const Fortran::parser::EndBlockStmt &) { TODO(""); } void genFIR(const Fortran::parser::ChangeTeamConstruct &construct) { genChangeTeamConstruct(*this, getEval(), construct); @@ -1310,17 +1308,17 @@ class FirConverter : public Fortran::lower::AbstractConverter { genEndChangeTeamStmt(*this, getEval(), stmt); } - void genFIR(const Fortran::parser::CriticalConstruct &) { TODO(); } - void genFIR(const Fortran::parser::CriticalStmt &) { TODO(); } - void genFIR(const Fortran::parser::EndCriticalStmt &) { TODO(); } + void genFIR(const Fortran::parser::CriticalConstruct &) { TODO(""); } + void genFIR(const Fortran::parser::CriticalStmt &) { TODO(""); } + void genFIR(const Fortran::parser::EndCriticalStmt &) { TODO(""); } - void genFIR(const Fortran::parser::SelectRankConstruct &) { TODO(); } - void genFIR(const Fortran::parser::SelectRankStmt &) { TODO(); } - void genFIR(const Fortran::parser::SelectRankCaseStmt &) { TODO(); } + void genFIR(const Fortran::parser::SelectRankConstruct &) { TODO(""); } + void genFIR(const Fortran::parser::SelectRankStmt &) { TODO(""); } + void genFIR(const Fortran::parser::SelectRankCaseStmt &) { TODO(""); } - void genFIR(const Fortran::parser::SelectTypeConstruct &) { TODO(); } - void genFIR(const Fortran::parser::SelectTypeStmt &) { TODO(); } - void genFIR(const Fortran::parser::TypeGuardStmt &) { TODO(); } + void genFIR(const Fortran::parser::SelectTypeConstruct &) { TODO(""); } + void genFIR(const Fortran::parser::SelectTypeStmt &) { TODO(""); } + void genFIR(const Fortran::parser::TypeGuardStmt &) { TODO(""); } //===--------------------------------------------------------------------===// // IO statements (see io.h) @@ -1427,9 +1425,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Memory allocation and deallocation //===--------------------------------------------------------------------===// - void genFIR(const Fortran::parser::AllocateStmt &) { TODO(); } + void genFIR(const Fortran::parser::AllocateStmt &) { TODO(""); } - void genFIR(const Fortran::parser::DeallocateStmt &) { TODO(); } + void genFIR(const Fortran::parser::DeallocateStmt &) { TODO(""); } /// Nullify pointer object list /// @@ -1450,7 +1448,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto cast = builder->createConvert(loc, ty, zero); builder->create(loc, cast, load); }, - [&](const Fortran::parser::StructureComponent &) { TODO(); }, + [&](const Fortran::parser::StructureComponent &) { TODO(""); }, }, po.u); } @@ -1491,7 +1489,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto up = builder->create(loc, ub, one); extents.push_back(up); } else { - TODO(); + TODO(""); } } // Iteration space is created with outermost columns, innermost rows @@ -1597,7 +1595,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Scalar assignment if (isHeap) { - TODO(); + TODO(""); } if (isNumericScalarCategory(lhsType->category())) { // Fortran 2018 10.2.1.3 p8 and p9 @@ -1634,36 +1632,36 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (lhsType->category() == Fortran::common::TypeCategory::Derived) { // Fortran 2018 10.2.1.3 p12 and p13 - TODO(); + TODO(""); } llvm_unreachable("unknown category"); }, [&](const Fortran::evaluate::ProcedureRef &) { // Defined assignment: call ProcRef - TODO(); + TODO(""); }, [&](const Fortran::evaluate::Assignment::BoundsSpec &) { // Pointer assignment with possibly empty bounds-spec - TODO(); + TODO(""); }, [&](const Fortran::evaluate::Assignment::BoundsRemapping &) { // Pointer assignment with bounds-remapping - TODO(); + TODO(""); }, }, assign.u); } - void genFIR(const Fortran::parser::WhereConstruct &) { TODO(); } - void genFIR(const Fortran::parser::WhereConstructStmt &) { TODO(); } - void genFIR(const Fortran::parser::MaskedElsewhereStmt &) { TODO(); } - void genFIR(const Fortran::parser::ElsewhereStmt &) { TODO(); } - void genFIR(const Fortran::parser::EndWhereStmt &) { TODO(); } - void genFIR(const Fortran::parser::WhereStmt &) { TODO(); } + void genFIR(const Fortran::parser::WhereConstruct &) { TODO(""); } + void genFIR(const Fortran::parser::WhereConstructStmt &) { TODO(""); } + void genFIR(const Fortran::parser::MaskedElsewhereStmt &) { TODO(""); } + void genFIR(const Fortran::parser::ElsewhereStmt &) { TODO(""); } + void genFIR(const Fortran::parser::EndWhereStmt &) { TODO(""); } + void genFIR(const Fortran::parser::WhereStmt &) { TODO(""); } - void genFIR(const Fortran::parser::ForallConstructStmt &) { TODO(); } - void genFIR(const Fortran::parser::EndForallStmt &) { TODO(); } - void genFIR(const Fortran::parser::ForallStmt &) { TODO(); } + void genFIR(const Fortran::parser::ForallConstructStmt &) { TODO(""); } + void genFIR(const Fortran::parser::EndForallStmt &) { TODO(""); } + void genFIR(const Fortran::parser::ForallStmt &) { TODO(""); } void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) { genAssignment(*stmt.typedAssignment->v); @@ -1717,7 +1715,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { genPauseStatement(*this, stmt); } - void genFIR(const Fortran::parser::NamelistStmt &) { TODO(); } + void genFIR(const Fortran::parser::NamelistStmt &) { TODO(""); } // call FAIL IMAGE in runtime void genFIR(const Fortran::parser::FailImageStmt &stmt) { @@ -1846,7 +1844,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto linkage = builder->createInternalLinkage(); if (details->init()) { if (!sym.GetType()->AsIntrinsic()) { - TODO(); // Derived type / polymorphic + TODO(""); // Derived type / polymorphic } auto symTy = genType(var); if (symTy.isa()) { @@ -1881,7 +1879,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } else if (sym.has()) { llvm_unreachable("COMMON symbol processed elsewhere"); } else { - TODO(); // Procedure pointer or something else + TODO(""); // Procedure pointer or something else } } diff --git a/flang/lib/Lower/Coarray.cpp b/flang/lib/Lower/Coarray.cpp index d73acbe17ce20..b1eef2d05d240 100644 --- a/flang/lib/Lower/Coarray.cpp +++ b/flang/lib/Lower/Coarray.cpp @@ -15,17 +15,10 @@ #include "SymbolMap.h" #include "flang/Lower/AbstractConverter.h" #include "flang/Lower/FIRBuilder.h" +#include "flang/Lower/Todo.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/expression.h" -#undef TODO -#define TODO(MSG) \ - { \ - mlir::emitError(converter.getCurrentLocation(), "not yet implemented") \ - << MSG; \ - exit(1); \ - } - //===----------------------------------------------------------------------===// // TEAM statements and constructs //===----------------------------------------------------------------------===// diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 56ecedc06df0f..f66712a24a9d3 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -21,6 +21,7 @@ #include "flang/Lower/ConvertType.h" #include "flang/Lower/IntrinsicCall.h" #include "flang/Lower/Runtime.h" +#include "flang/Lower/Todo.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Semantics/expression.h" #include "flang/Semantics/symbol.h" @@ -32,9 +33,8 @@ #include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorHandling.h" #include "llvm/Support/raw_ostream.h" -#define DEBUG_TYPE "flang-lower-expr" -#define TODO() llvm_unreachable("not yet implemented") +#define DEBUG_TYPE "flang-lower-expr" static llvm::cl::opt generateArrayCoordinate( "gen-array-coor", @@ -175,7 +175,7 @@ class ExprLowering { return builder.create(getLoc(), *lhs, *rhs); } // binary ops can appear in array contexts - TODO(); + TODO(""); } template mlir::Value createBinaryOp(const A &ex) { @@ -215,7 +215,7 @@ class ExprLowering { if (auto *lhs = left.getUnboxed()) if (auto *rhs = right.getUnboxed()) return builder.create(getLoc(), pred, *lhs, *rhs); - TODO(); + TODO(""); } template mlir::Value createCompareOp(const A &ex, mlir::CmpIPredicate pred) { @@ -229,7 +229,7 @@ class ExprLowering { if (auto *lhs = left.getUnboxed()) if (auto *rhs = right.getUnboxed()) return builder.create(getLoc(), pred, *lhs, *rhs); - TODO(); + TODO(""); } template mlir::Value createFltCmpOp(const A &ex, mlir::CmpFPredicate pred) { @@ -368,7 +368,7 @@ class ExprLowering { } fir::ExtendedValue genval(const Fortran::evaluate::BOZLiteralConstant &) { - TODO(); + TODO(""); } /// Return indirection to function designated in ProcedureDesignator. /// The type of the function indirection is not guaranteed to match the one @@ -407,10 +407,10 @@ class ExprLowering { return builder.createNullConstant(location); } fir::ExtendedValue genval(const Fortran::evaluate::StructureConstructor &) { - TODO(); + TODO(""); } fir::ExtendedValue genval(const Fortran::evaluate::ImpliedDoIndex &) { - TODO(); + TODO(""); } fir::ExtendedValue genval(const Fortran::evaluate::DescriptorInquiry &desc) { @@ -425,19 +425,19 @@ class ExprLowering { .getLengthType(); res = builder.create(getLoc(), lenType, descRef); } else if (descType.isa()) { - TODO(); + TODO(""); } else { llvm_unreachable("not a descriptor"); } break; default: - TODO(); + TODO(""); } return res; } fir::ExtendedValue genval(const Fortran::evaluate::TypeParamInquiry &) { - TODO(); + TODO(""); } mlir::Value extractComplexPart(mlir::Value cplx, bool isImagPart) { @@ -590,7 +590,7 @@ class ExprLowering { template fir::ExtendedValue genval(const Fortran::evaluate::SetLength &) { - TODO(); + TODO(""); } mlir::Value createComplexCompare(mlir::Value cplx1, mlir::Value cplx2, @@ -892,11 +892,11 @@ class ExprLowering { template fir::ExtendedValue genval(const Fortran::evaluate::ArrayConstructor &) { - TODO(); + TODO(""); } - fir::ExtendedValue gen(const Fortran::evaluate::ComplexPart &) { TODO(); } - fir::ExtendedValue genval(const Fortran::evaluate::ComplexPart &) { TODO(); } + fir::ExtendedValue gen(const Fortran::evaluate::ComplexPart &) { TODO(""); } + fir::ExtendedValue genval(const Fortran::evaluate::ComplexPart &) { TODO(""); } /// Reference to a substring. fir::ExtendedValue gen(const Fortran::evaluate::Substring &s) { @@ -905,7 +905,7 @@ class ExprLowering { Fortran::common::visitors{ [&](const Fortran::evaluate::DataRef &x) { return gen(x); }, [&](const Fortran::evaluate::StaticDataObject::Pointer &) - -> fir::ExtendedValue { TODO(); }, + -> fir::ExtendedValue { TODO(""); }, }, s.parent()); llvm::SmallVector bounds; @@ -1006,7 +1006,7 @@ class ExprLowering { auto c = gen(cmpt); if (auto *val = c.getUnboxed()) return genLoad(*val); - TODO(); + TODO(""); } // Determine the result type after removing `dims` dimensions from the array @@ -1035,7 +1035,7 @@ class ExprLowering { return genval(*sub); return genIntegerConstant<8>(builder.getContext(), 1); } - TODO(); + TODO(""); } fir::ExtendedValue @@ -1110,7 +1110,7 @@ class ExprLowering { if (auto ext = std::get<0>(pair)) delta = builder.create(loc, delta, ext); } else { - TODO(); + TODO(""); } } ++dim; @@ -1181,11 +1181,11 @@ class ExprLowering { auto val = builder.createConvert(loc, idxTy, *sval); arrayCoorArgs.push_back(val); } else { - TODO(); + TODO(""); } } else { // RangedBoxValue - TODO(); + TODO(""); } } return builder.create( @@ -1194,21 +1194,21 @@ class ExprLowering { return si.match( [&](const Fortran::lower::SymbolBox::FullDim &arr) { if (!inArrayContext() && isSlice(aref)) { - TODO(); + TODO(""); return mlir::Value{}; } return genWithShape(arr); }, [&](const Fortran::lower::SymbolBox::CharFullDim &arr) { - TODO(); + TODO(""); return mlir::Value{}; }, [&](const Fortran::lower::SymbolBox::Derived &arr) { - TODO(); + TODO(""); return mlir::Value{}; }, [&](const auto &) { - TODO(); + TODO(""); return mlir::Value{}; }); } @@ -1237,7 +1237,7 @@ class ExprLowering { assert(adj && "boxed value not handled"); args.push_back(builder.create(loc, ty, *val, adj)); } else { - TODO(); + TODO(""); } } else { auto *range = std::get_if(&subBox); @@ -1405,10 +1405,10 @@ class ExprLowering { for (const auto &arg : caller.getPassedArguments()) { const auto *actual = arg.entity; if (!actual) - TODO(); // optional arguments + TODO(""); // optional arguments const auto *expr = actual->UnwrapExpr(); if (!expr) - TODO(); // assumed type arguments + TODO(""); // assumed type arguments mlir::Value argRef; mlir::Value argVal; @@ -1453,7 +1453,7 @@ class ExprLowering { } caller.placeInput(arg, boxChar); } else if (arg.passBy == PassBy::Box) { - TODO(); // generate emboxing if need. + TODO(""); // generate emboxing if need. } else if (arg.passBy == PassBy::AddressAndLength) { Fortran::lower::CharacterExprHelper helper{builder, getLoc()}; auto ch = helper.materializeCharacter(argRef); @@ -1474,7 +1474,7 @@ class ExprLowering { auto ch = helper.createUnboxChar(resRef); caller.placeAddressAndLengthInput(*resultArg, ch.first, ch.second); } else { - TODO(); // Pass descriptor + TODO(""); // Pass descriptor } } diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp index 6731a5855087d..a762b1ad86b3e 100644 --- a/flang/lib/Lower/Mangler.cpp +++ b/flang/lib/Lower/Mangler.cpp @@ -9,6 +9,7 @@ #include "flang/Lower/Mangler.h" #include "flang/Common/reference.h" #include "flang/Lower/Utils.h" +#include "flang/Lower/Todo.h" #include "flang/Optimizer/Dialect/FIRType.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Semantics/tools.h" @@ -18,8 +19,6 @@ #include "llvm/ADT/StringRef.h" #include "llvm/ADT/Twine.h" -#define TODO() llvm_unreachable("not implemented") - // recursively build the vector of module scopes static void moduleNames(const Fortran::semantics::Scope &scope, llvm::SmallVector &result) { @@ -113,7 +112,7 @@ Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer, [&](const Fortran::semantics::CommonBlockDetails &) { return uniquer.doCommonBlock(symbolName); }, - [](const auto &) -> std::string { TODO(); }, + [](const auto &) -> std::string { TODO(""); }, }, ultimateSymbol.details()); } From 62127e3f3be3ab835c34a570fdbe725f6b531b6f Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Mon, 28 Sep 2020 01:19:03 -0700 Subject: [PATCH 0277/1017] Do not try allocate references in genref --- flang/lib/Lower/ConvertExpr.cpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index f66712a24a9d3..fdeffff7cbded 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1596,7 +1596,8 @@ class ExprLowering { } else { auto val = fir::getBase(genval(a)); // Functions are always referent. - if (val.getType().template isa()) + if (val.getType().template isa() || + fir::isa_ref_type(val.getType())) return val; // Since `a` is not itself a valid referent, determine its value and // create a temporary location for referencing. From a1e3f731a601c6d4dc48aa472cbb6c2c6e985115 Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 28 Sep 2020 13:13:25 -0700 Subject: [PATCH 0278/1017] Fixes accidentally including the LEN as part of the shape of a CHARACTER. Also fixes bungling the type of the embox for input items. --- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index a92f498b70c00..7b63d1b582286 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -67,23 +67,36 @@ class EmboxConversion : public mlir::OpRewritePattern { if (auto boxTy = embox.getType().dyn_cast()) if (auto seqTy = boxTy.getEleTy().dyn_cast()) if (seqTy.hasConstantShape()) - return rewriteStaticShape(embox, rewriter, seqTy); + if (!scalarCharacter(seqTy)) + return rewriteStaticShape(embox, rewriter, seqTy); return mlir::failure(); } + static bool scalarCharacter(SequenceType seqTy) { + if (auto eleTy = seqTy.getEleTy().dyn_cast()) + return seqTy.getDimension() == 1; + return false; + } + + /// For element type `char` the row is the LEN and must not be included in + /// the shape structure. + static std::size_t charAdjust(SequenceType seqTy) { + return seqTy.getEleTy().isa() ? 1 : 0; + } + mlir::LogicalResult rewriteStaticShape(EmboxOp embox, mlir::PatternRewriter &rewriter, SequenceType seqTy) const { auto loc = embox.getLoc(); llvm::SmallVector shapeOpers; auto idxTy = rewriter.getIndexType(); - for (auto ext : seqTy.getShape()) { + for (auto ext : llvm::drop_begin(seqTy.getShape(), charAdjust(seqTy))) { auto iAttr = rewriter.getIndexAttr(ext); auto extVal = rewriter.create(loc, idxTy, iAttr); shapeOpers.push_back(extVal); } mlir::NamedAttrList attrs; - auto rank = seqTy.getDimension(); + auto rank = seqTy.getDimension() - charAdjust(seqTy); auto rankAttr = rewriter.getIntegerAttr(idxTy, rank); attrs.push_back(rewriter.getNamedAttr(XEmboxOp::rankAttrName(), rankAttr)); auto zeroAttr = rewriter.getIntegerAttr(idxTy, 0); From 3c4222ed98070b3a3e6f6b17d835a98cdc41916c Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 28 Sep 2020 17:12:49 -0700 Subject: [PATCH 0279/1017] Fixes the issue where STOP 'text' was calling the wrong runtime. This patch hacks the runtime files simply so things will typecheck and compile. It does not change the runtime library. --- flang/lib/Lower/Runtime.cpp | 58 ++++++++++++++++++++++++------------- flang/test/Lower/stop.f90 | 26 +++++++++++++---- 2 files changed, 58 insertions(+), 26 deletions(-) diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index 047b0488d0616..a5c4e0e902002 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -15,7 +15,9 @@ #include "flang/Lower/Support/BoxValue.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/tools.h" -#include "llvm/ADT/SmallVector.h" +#include "llvm/Support/Debug.h" + +#define DEBUG_TYPE "flang-lower-runtime" using namespace Fortran::runtime; #define mkRTKey(X) mkKey(RTNAME(X)) @@ -75,45 +77,61 @@ void Fortran::lower::genStopStatement( const Fortran::parser::StopStmt &stmt) { auto &builder = converter.getFirOpBuilder(); auto loc = converter.getCurrentLocation(); - auto callee = genRuntimeFunction(loc, builder); - auto calleeType = callee.getType(); llvm::SmallVector operands; - assert(calleeType.getNumInputs() == 3 && - "expected 3 arguments in STOP runtime"); + mlir::FuncOp callee; + mlir::FunctionType calleeType; // First operand is stop code (zero if absent) if (const auto &code = std::get>(stmt.t)) { - auto expr = Fortran::semantics::GetExpr(*code); - assert(expr && "failed getting typed expression"); - operands.push_back(fir::getBase(converter.genExprValue(*expr))); + auto expr = converter.genExprValue(*Fortran::semantics::GetExpr(*code)); + LLVM_DEBUG(llvm::dbgs() << "stop expression: "; expr.dump(); + llvm::dbgs() << '\n'); + expr.match( + [&](const fir::CharBoxValue &x) { + callee = genRuntimeFunction(loc, builder); + calleeType = callee.getType(); + // Creates a pair of operands for the CHARACTER and its LEN. + operands.push_back( + builder.createConvert(loc, calleeType.getInput(0), x.getAddr())); + operands.push_back( + builder.createConvert(loc, calleeType.getInput(1), x.getLen())); + }, + [&](fir::UnboxedValue x) { + callee = genRuntimeFunction(loc, builder); + calleeType = callee.getType(); + auto cast = builder.createConvert(loc, calleeType.getInput(0), x); + operands.push_back(cast); + }, + [&](auto) { + mlir::emitError(loc, "unhandled expression in STOP"); + std::exit(1); + }); } else { + callee = genRuntimeFunction(loc, builder); + calleeType = callee.getType(); operands.push_back( builder.createIntegerConstant(loc, calleeType.getInput(0), 0)); } + // Second operand indicates ERROR STOP bool isError = std::get(stmt.t) == Fortran::parser::StopStmt::Kind::ErrorStop; - operands.push_back( - builder.createIntegerConstant(loc, calleeType.getInput(1), isError)); + operands.push_back(builder.createIntegerConstant( + loc, calleeType.getInput(operands.size()), isError)); // Third operand indicates QUIET (default to false). if (const auto &quiet = std::get>(stmt.t)) { auto expr = Fortran::semantics::GetExpr(*quiet); assert(expr && "failed getting typed expression"); - operands.push_back(fir::getBase(converter.genExprValue(*expr))); - } else { + auto q = fir::getBase(converter.genExprValue(*expr)); operands.push_back( - builder.createIntegerConstant(loc, calleeType.getInput(2), 0)); + builder.createConvert(loc, calleeType.getInput(operands.size()), q)); + } else { + operands.push_back(builder.createIntegerConstant( + loc, calleeType.getInput(operands.size()), 0)); } - // Cast operands in case they have different integer/logical types - // compare to runtime. - auto i = 0; - for (auto &op : operands) { - auto type = calleeType.getInput(i++); - op = builder.createConvert(loc, type, op); - } builder.create(loc, callee, operands); genUnreachable(builder, loc); } diff --git a/flang/test/Lower/stop.f90 b/flang/test/Lower/stop.f90 index b708da8a44ef5..815dff5325090 100644 --- a/flang/test/Lower/stop.f90 +++ b/flang/test/Lower/stop.f90 @@ -4,7 +4,7 @@ subroutine stop_test(b) ! CHECK-DAG: %[[c0:.*]] = constant 0 : i32 ! CHECK-DAG: %[[false:.*]] = constant false - ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[false]]) + ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[false]]) ! CHECK-NEXT: fir.unreachable stop end subroutine @@ -14,7 +14,7 @@ subroutine stop_code() stop 42 ! CHECK-DAG: %[[c42:.*]] = constant 42 : i32 ! CHECK-DAG: %[[false:.*]] = constant false - ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c42]], %[[false]], %[[false]]) + ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c42]], %[[false]], %[[false]]) ! CHECK-NEXT: fir.unreachable end subroutine @@ -24,7 +24,7 @@ subroutine stop_error() ! CHECK-DAG: %[[c0:.*]] = constant 0 : i32 ! CHECK-DAG: %[[true:.*]] = constant true ! CHECK-DAG: %[[false:.*]] = constant false - ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[true]], %[[false]]) + ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[true]], %[[false]]) ! CHECK-NEXT: fir.unreachable end subroutine @@ -36,7 +36,7 @@ subroutine stop_quiet(b) ! CHECK-DAG: %[[false:.*]] = constant false ! CHECK-DAG: %[[b:.*]] = fir.load %arg0 ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 - ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[bi1]]) + ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[bi1]]) ! CHECK-NEXT: fir.unreachable end subroutine @@ -48,8 +48,22 @@ subroutine stop_error_code_quiet(b) ! CHECK-DAG: %[[true:.*]] = constant true ! CHECK-DAG: %[[b:.*]] = fir.load %arg0 ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 - ! CHECK: call @_Fortran{{.*}}StopStatement(%[[c66]], %[[true]], %[[bi1]]) + ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c66]], %[[true]], %[[bi1]]) ! CHECK-NEXT: fir.unreachable end subroutine -! CHECK: func @_Fortran{{.*}}StopStatement(i32, i1, i1) -> none + +! CHECK-LABEL stop_char_lit +subroutine stop_char_lit + ! CHECK-DAG: %[[false:.*]] = constant false + ! CHECK-DAG: %[[five:.*]] = constant 5 : index + ! CHECK-DAG: %[[lit:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref>> + ! CHECK-DAG: %[[buff:.*]] = fir.convert %[[lit]] : (!fir.ref>>) -> !fir.ref + ! CHECK-DAG: %[[len:.*]] = fir.convert %[[five]] : (index) -> i64 + ! CHECK: fir.call @{{.*}}StopStatementText(%[[buff]], %[[len]], %[[false]], %[[false]]) : + ! CHECK-NEXT: fir.unreachable + stop 'crash' +end subroutine stop_char_lit + +! CHECK-DAG: func @_Fortran{{.*}}StopStatement(i32, i1, i1) -> none +! CHECK-DAG: func @_Fortran{{.*}}StopStatementText(!fir.ref, i64, i1, i1) -> none From eeeffac54dc8e1cb8739e43336fa9fd565d5607d Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Thu, 1 Oct 2020 11:34:30 -0700 Subject: [PATCH 0280/1017] Mark I/O statements with assigned formats as unstructured (#467) Mark I/O statements with assigned formats as unstructured --- flang/lib/Lower/PFTBuilder.cpp | 58 ++++++++++++++++++++-------------- flang/test/Lower/format.f90 | 36 +++++++++++++++++---- 2 files changed, 64 insertions(+), 30 deletions(-) diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index c14ad3af4b2fb..61711062270e9 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -339,23 +339,31 @@ class PFTBuilder { } /// Mark I/O statement ERR, EOR, and END specifier branch targets. + /// Mark an I/O statement with an assigned format as unstructured. template void analyzeIoBranches(lower::pft::Evaluation &eval, const A &stmt) { - auto processIfLabel{[&](const auto &specs) { - using LabelNodes = - std::tuple; - for (const auto &spec : specs) { - const auto *label = std::visit( - [](const auto &label) -> const parser::Label * { - using B = std::decay_t; - if constexpr (common::HasMember) - return &label.v; - return nullptr; - }, + auto analyzeFormatSpec = [&](const parser::Format &format) { + if (const auto *expr = std::get_if(&format.u)) { + if (semantics::ExprHasTypeCategory(*semantics::GetExpr(*expr), + common::TypeCategory::Integer)) + eval.isUnstructured = true; + } + }; + auto analyzeSpecs{[&](const auto &specList) { + for (const auto &spec : specList) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::Format &format) { + analyzeFormatSpec(format); + }, + [&](const auto &label) { + using LabelNodes = + std::tuple; + if constexpr (common::HasMember) + markBranchTarget(eval, label.v); + }}, spec.u); - - if (label) - markBranchTarget(eval, *label); } }}; @@ -366,13 +374,17 @@ class PFTBuilder { if constexpr (std::is_same_v || std::is_same_v) { - processIfLabel(stmt.controls); + if (stmt.format) + analyzeFormatSpec(*stmt.format); + analyzeSpecs(stmt.controls); + } else if constexpr (std::is_same_v) { + analyzeFormatSpec(std::get(stmt.t)); } else if constexpr (std::is_same_v) { - if (const auto *specs = + if (const auto *specList = std::get_if>(&stmt.u)) - processIfLabel(*specs); + analyzeSpecs(*specList); } else if constexpr (common::HasMember) { - processIfLabel(stmt.v); + analyzeSpecs(stmt.v); } else { // Always crash if this is instantiated static_assert(!std::is_same_v, @@ -705,11 +717,11 @@ class PFTBuilder { // Default - Common analysis for I/O statements; otherwise nop. [&](const auto &stmt) { using A = std::decay_t; - using IoStmts = std::tuple; + using IoStmts = std::tuple< + parser::BackspaceStmt, parser::CloseStmt, parser::EndfileStmt, + parser::FlushStmt, parser::InquireStmt, parser::OpenStmt, + parser::PrintStmt, parser::ReadStmt, parser::RewindStmt, + parser::WaitStmt, parser::WriteStmt>; if constexpr (common::HasMember) analyzeIoBranches(eval, stmt); }, diff --git a/flang/test/Lower/format.f90 b/flang/test/Lower/format.f90 index 898fdf3de9d5d..6663ad2183a99 100644 --- a/flang/test/Lower/format.f90 +++ b/flang/test/Lower/format.f90 @@ -1,15 +1,15 @@ ! RUN: bbc %s -o - | FileCheck %s ! CHECK-LABEL: func @_QPformatassign -function formatAssign() +subroutine formatAssign(flag1, flag2, flag3) real :: pi integer :: label - logical :: flag + logical :: flag1, flag2, flag3 ! CHECK-DAG: %[[ONE:.*]] = constant 100 : i32 ! CHECK-DAG: %[[TWO:.*]] = constant 200 : i32 ! CHECK: %{{.*}} = select %{{.*}}, %[[ONE]], %[[TWO]] : i32 - if (flag) then + if (flag1) then assign 100 to label else assign 200 to label @@ -30,11 +30,33 @@ function formatAssign() ! CHECK: fir.call @{{.*}}OutputReal32 ! CHECK: fir.call @{{.*}}EndIoStatement pi = 3.141592653589 - write(*, label) "PI=", pi - + write(*, label) " PI=", pi + ! CHECK: fir.call @{{.*}}BeginExternalFormattedOutput + ! CHECK: fir.call @{{.*}}OutputAscii + ! CHECK: fir.call @{{.*}}OutputReal32 + ! CHECK: fir.call @{{.*}}EndIoStatement + if (flag2) write(*, label) "2PI=", 2*pi + if (flag1 .and. flag2 .and. flag3) then + assign 100 to label + else + assign 200 to label + end if + if (flag3) then + ! CHECK: fir.call @{{.*}}BeginExternalFormattedOutput + ! CHECK: fir.call @{{.*}}OutputAscii + ! CHECK: fir.call @{{.*}}OutputReal32 + ! CHECK: fir.call @{{.*}}EndIoStatement + write(*, label) "3PI=", 3*pi + endif 100 format (A, F10.3) 200 format (A,E8.1) -300 format (A, E2.4) +300 format (A, E4.2) + +end subroutine - end function +! CHECK-LABEL: func @_QQmain + call formatAssign(.true., .true., .true.) + print* + call formatAssign(.true., .false., .true.) +end From c7df6768a3b6c04541f1cf02dac5a7c977626ce5 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 1 Oct 2020 11:10:03 -0700 Subject: [PATCH 0281/1017] Fix the failing OMP test so that it passes. One of the lines of the test looks like it is being generated as a symmetric add operation, for example. This test fails when building flang with clang++. --- flang/test/Lower/OpenMP/omp-parallel-region.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/test/Lower/OpenMP/omp-parallel-region.f90 b/flang/test/Lower/OpenMP/omp-parallel-region.f90 index 0497abd9e50d4..a8f6723c7ada6 100644 --- a/flang/test/Lower/OpenMP/omp-parallel-region.f90 +++ b/flang/test/Lower/OpenMP/omp-parallel-region.f90 @@ -34,8 +34,8 @@ program parallel !FIRDialect-DAG: %[[OMP_VAR_B:.*]] = fir.load %[[VAR_B]] !FIRDialect: %[[OMP_VAR_C:.*]] = addi %[[OMP_VAR_A]], %[[OMP_VAR_B]] !FIRDialect: fir.store %[[OMP_VAR_C]] to %[[VAR_C]] -!FIRDialect: %[[CONSTANT:.*]] = constant 4 : i32 -!FIRDialect: %[[COND_C:.*]] = fir.load %[[VAR_C]] : !fir.ref +!FIRDialect-DAG: %[[CONSTANT:.*]] = constant 4 : i32 +!FIRDialect-DAG: %[[COND_C:.*]] = fir.load %[[VAR_C]] : !fir.ref !FIRDialect: %[[COND_RES:.*]] = cmpi "sgt", %[[COND_C]], %[[CONSTANT]] : i32 !FIRDialect: fir.if %[[COND_RES]] { !FIRDialect: fir.call @_FortranAioBeginExternalListOutput @@ -53,7 +53,7 @@ program parallel !LLVMIRDialect-LABEL: omp.parallel num_threads(%{{.*}} : !llvm.i32) { !LLVMIRDialect-DAG: %[[OMP_VAR_A:.*]] = llvm.load %[[VAR_A:.*]] !LLVMIRDialect-DAG: %[[OMP_VAR_B:.*]] = llvm.load %[[VAR_B:.*]] -!LLVMIRDialect: %[[OMP_VAR_C:.*]] = llvm.add %[[OMP_VAR_B]], %[[OMP_VAR_A]] +!LLVMIRDialect: %[[OMP_VAR_C:.*]] = llvm.add {{.*}}%[[OMP_VAR_A]] !LLVMIRDialect: llvm.store %[[OMP_VAR_C]], %[[VAR_C]] !LLVMIRDialect: %[[COND_C:.*]] = llvm.load %[[VAR_C]] : !llvm.ptr !LLVMIRDialect: %[[COND_RES:.*]] = llvm.icmp "sgt" %[[COND_C]], %{{.*}} : !llvm.i32 From b5fada77ae53d007be2a8ebd06ed9b8826c6d52f Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 1 Oct 2020 11:51:26 -0700 Subject: [PATCH 0282/1017] remove some whitespace --- flang/test/Lower/OpenMP/omp-parallel-region.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flang/test/Lower/OpenMP/omp-parallel-region.f90 b/flang/test/Lower/OpenMP/omp-parallel-region.f90 index a8f6723c7ada6..9a0d4f0db2ad7 100644 --- a/flang/test/Lower/OpenMP/omp-parallel-region.f90 +++ b/flang/test/Lower/OpenMP/omp-parallel-region.f90 @@ -34,8 +34,8 @@ program parallel !FIRDialect-DAG: %[[OMP_VAR_B:.*]] = fir.load %[[VAR_B]] !FIRDialect: %[[OMP_VAR_C:.*]] = addi %[[OMP_VAR_A]], %[[OMP_VAR_B]] !FIRDialect: fir.store %[[OMP_VAR_C]] to %[[VAR_C]] -!FIRDialect-DAG: %[[CONSTANT:.*]] = constant 4 : i32 -!FIRDialect-DAG: %[[COND_C:.*]] = fir.load %[[VAR_C]] : !fir.ref +!FIRDialect-DAG: %[[CONSTANT:.*]] = constant 4 : i32 +!FIRDialect-DAG: %[[COND_C:.*]] = fir.load %[[VAR_C]] : !fir.ref !FIRDialect: %[[COND_RES:.*]] = cmpi "sgt", %[[COND_C]], %[[CONSTANT]] : i32 !FIRDialect: fir.if %[[COND_RES]] { !FIRDialect: fir.call @_FortranAioBeginExternalListOutput @@ -53,7 +53,7 @@ program parallel !LLVMIRDialect-LABEL: omp.parallel num_threads(%{{.*}} : !llvm.i32) { !LLVMIRDialect-DAG: %[[OMP_VAR_A:.*]] = llvm.load %[[VAR_A:.*]] !LLVMIRDialect-DAG: %[[OMP_VAR_B:.*]] = llvm.load %[[VAR_B:.*]] -!LLVMIRDialect: %[[OMP_VAR_C:.*]] = llvm.add {{.*}}%[[OMP_VAR_A]] +!LLVMIRDialect: %[[OMP_VAR_C:.*]] = llvm.add {{.*}}%[[OMP_VAR_A]] !LLVMIRDialect: llvm.store %[[OMP_VAR_C]], %[[VAR_C]] !LLVMIRDialect: %[[COND_C:.*]] = llvm.load %[[VAR_C]] : !llvm.ptr !LLVMIRDialect: %[[COND_RES:.*]] = llvm.icmp "sgt" %[[COND_C]], %{{.*}} : !llvm.i32 From 21fe1e14e3ea1dca3681b2224151b10e625b0df0 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 1 Oct 2020 12:59:00 -0700 Subject: [PATCH 0283/1017] rebase fallout --- flang/lib/Lower/PFTBuilder.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 61711062270e9..931dd3f6d12ea 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -1273,7 +1273,7 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( const auto &programStmt = std::get>>(func.t); if (programStmt.has_value()) { - beginStmt = programStmt.value(); + beginStmt = FunctionStatement(programStmt.value()); auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; processSymbolTable(*symbol->scope(), varList); From c7db9b53c7cb141a90e7b347081a0761ddd28991 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Mon, 28 Sep 2020 01:56:27 +0530 Subject: [PATCH 0284/1017] [flang][OpenMP] Lower private, firstprivate, shared, copyin clauses for Parallel construct TODO: Handle Attribute based clauses: 1. Default clause 2. ProcBind clause --- .../OpenMP/omp-parallel-copyin-clause.f90 | 42 +++++++++++++ .../omp-parallel-firstprivate-clause.f90 | 40 ++++++++++++ .../Lower/OpenMP/omp-parallel-if-clause.f90 | 63 +++++++++++++++++++ ...f90 => omp-parallel-numthreads-clause.f90} | 0 .../OpenMP/omp-parallel-private-clause.f90 | 40 ++++++++++++ .../OpenMP/omp-parallel-shared-clause.f90 | 40 ++++++++++++ 6 files changed, 225 insertions(+) create mode 100644 flang/test/Lower/OpenMP/omp-parallel-copyin-clause.f90 create mode 100644 flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause.f90 create mode 100644 flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 rename flang/test/Lower/OpenMP/{empty-omp-parallel.f90 => omp-parallel-numthreads-clause.f90} (100%) create mode 100644 flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 create mode 100644 flang/test/Lower/OpenMP/omp-parallel-shared-clause.f90 diff --git a/flang/test/Lower/OpenMP/omp-parallel-copyin-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-copyin-clause.f90 new file mode 100644 index 0000000000000..e59248d9c0df4 --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-copyin-clause.f90 @@ -0,0 +1,42 @@ +! This test checks lowering of OpenMP parallel Directive with +! `COPYIN` clause present. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect + +!FIRDialect: func @_QPcopyin_clause(%[[ARG1:.*]]: !fir.ref, %[[ARG2:.*]]: !fir.ref>) { +!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "alpha"} +!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "beta"} +!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "gama"} +!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "alpha_array"} +!FIRDialect: omp.parallel copyin(%[[ALPHA]] : !fir.ref, %[[BETA]] : !fir.ref, %[[GAMA]] : !fir.ref, %[[ALPHA_ARRAY]] +!: !fir.ref>, %[[ARG1]] : !fir.ref, %[[ARG2]] : !fir.ref>)) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: llvm.func @_QPcopyin_clause(%[[ARG1:.*]]: !llvm.ptr, %[[ARG2:.*]]: !llvm.ptr>) { +!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "alpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "beta"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "gama"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "alpha_array"} : (!llvm.i64) -> !llvm.ptr> +!LLVMIRDialect: omp.parallel copyin(%[[ALPHA]] : !llvm.ptr, %[[BETA]] : !llvm.ptr, %[[GAMA]] : !llvm.ptr, +!%[[ALPHA_ARRAY]] : !llvm.ptr>, %[[ARG1]] : !llvm.ptr, %[[ARG2]] : !llvm.ptr>) { +!LLVMIRDialect: omp.terminator +!LLVMIRDialect: } + +subroutine copyin_clause(arg1, arg2) + + integer :: arg1, arg2(10) + integer :: alpha, beta, gama + integer :: alpha_array(10) + +!$OMP THREADPRIVATE(alpha, beta, gama, alpha_array, arg1, arg2) +!$OMP PARALLEL COPYIN(alpha, beta, gama, alpha_array, arg1, arg2) + print*, "COPYIN" + print*, alpha, beta, gama + +!$OMP END PARALLEL + +end subroutine diff --git a/flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause.f90 new file mode 100644 index 0000000000000..9e7124911c556 --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause.f90 @@ -0,0 +1,40 @@ +! This test checks lowering of OpenMP parallel Directive with +! `FIRSTPRIVATE` clause present. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect + +!FIRDialect: func @_QPfirstprivate_clause(%[[ARG1:.*]]: !fir.ref, %[[ARG2:.*]]: !fir.ref>) { +!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "alpha"} +!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "beta"} +!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "gama"} +!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "alpha_array"} +!FIRDialect: omp.parallel firstprivate(%[[ALPHA]] : !fir.ref, %[[BETA]] : !fir.ref, %[[GAMA]] : !fir.ref, +!%[[ALPHA_ARRAY]] : !fir.ref>, %[[ARG1]] : !fir.ref, %[[ARG2]] : !fir.ref>)) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: llvm.func @_QPfirstprivate_clause(%[[ARG1:.*]]: !llvm.ptr, %[[ARG2:.*]]: !llvm.ptr>) { +!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "alpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "beta"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "gama"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "alpha_array"} : (!llvm.i64) -> !llvm.ptr> +!LLVMIRDialect: omp.parallel firstprivate(%[[ALPHA]] : !llvm.ptr, %[[BETA]] : !llvm.ptr, %[[GAMA]] : !llvm.ptr, +!%[[ALPHA_ARRAY]] : !llvm.ptr>, %[[ARG1]] : !llvm.ptr, %[[ARG2]] : !llvm.ptr>) { +!LLVMIRDialect: omp.terminator +!LLVMIRDialect: } + +subroutine firstprivate_clause(arg1, arg2) + + integer :: arg1, arg2(10) + integer :: alpha, beta, gama + integer :: alpha_array(10) + +!$OMP PARALLEL FIRSTPRIVATE(alpha, beta, gama, alpha_array, arg1, arg2) + print*, "FIRSTPRIVATE" + print*, alpha, beta, gama +!$OMP END PARALLEL + +end subroutine diff --git a/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 new file mode 100644 index 0000000000000..75b9d9d524e8d --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 @@ -0,0 +1,63 @@ +! This test checks lowering of OpenMP parallel Directive with +! `IF` clause present. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: tco | FileCheck %s --check-prefix=LLVMIR + +!FIRDialect: %[[ALPHA:.*]] = fir.alloca i32 {name = "alpha"} +!FIRDialect: %[[CONSTANT_4:.*]] = constant 4 : i32 +!FIRDialect: fir.store %[[CONSTANT_4]] to %[[ALPHA]] : !fir.ref +!FIRDialect: %[[CONSTANT_0:.*]] = constant 0 : i32 +!FIRDialect: %[[LD_ALPHA:.*]] = fir.load %0 : !fir.ref +!FIRDialect: %[[COND:.*]] = cmpi "sle", %[[LD_ALPHA]], %[[CONSTANT_0]] : i32 +!FIRDialect: omp.parallel if(%[[COND]] : i1) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMIRDialect: %[[CONSTANT_4:.*]] = llvm.mlir.constant(4 : i32) : !llvm.i32 +!LLVMIRDialect: %[[CONSTANT_0:.*]] = llvm.mlir.constant(0 : i32) : !llvm.i32 +!LLVMIRDialect: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "alpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect: llvm.store %[[CONSTANT_4]], %[[ALPHA]] : !llvm.ptr +!LLVMIRDialect: %[[LD_ALPHA:.*]] = llvm.load %[[ALPHA]] : !llvm.ptr +!LLVMIRDialect: %[[COND:.*]] = llvm.icmp "sle" %[[LD_ALPHA]], %[[CONSTANT_0]] : !llvm.i32 +!LLVMIRDialect: omp.parallel if(%[[COND]] : !llvm.i1) { +!LLVMIRDialect: omp.terminator +!LLVMIRDialect: } + +!LLVMIR: %[[ALPHA:.*]] = alloca i32, i64 1 +!LLVMIR: store i32 4, i32* %[[ALPHA]], align 4 +!LLVMIR: %[[LD_ALPHA:.*]] = load i32, i32* %[[ALPHA]], align 4 +!LLVMIR: %[[COND:.*]] = icmp sle i32 %[[LD_ALPHA]], 0 +!LLVMIR: br i1 %[[COND]], label %[[PARALLEL:.*]], label %[[SERIAL:.*]] +!LLVMIR: [[PARALLEL]]: +!LLVMIR: br label %omp_parallel +!LLVMIR: [[SERIAL]]: +!LLVMIR: call void @__kmpc_serialized_parallel +!LLVMIR: call void @_QQmain..omp_par +!LLVMIR: call void @__kmpc_end_serialized_parallel + +program ifclause + integer :: alpha + alpha = 4 + +!$OMP PARALLEL IF(alpha .le. 0) +print*, "Equality statement: Execution: Serial" +!$OMP END PARALLEL + +!$OMP PARALLEL IF(.false.) +print*, "False statement: Execution: Serial" +!$OMP END PARALLEL + +!$OMP PARALLEL IF(alpha .ge. 0) +print*, "Equality statement: Execution: Parallel" +!$OMP END PARALLEL + +!$OMP PARALLEL IF(.true.) +print*, "True statement: Execution: Parallel" +!$OMP END PARALLEL + +end diff --git a/flang/test/Lower/OpenMP/empty-omp-parallel.f90 b/flang/test/Lower/OpenMP/omp-parallel-numthreads-clause.f90 similarity index 100% rename from flang/test/Lower/OpenMP/empty-omp-parallel.f90 rename to flang/test/Lower/OpenMP/omp-parallel-numthreads-clause.f90 diff --git a/flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 new file mode 100644 index 0000000000000..9a1754ab77985 --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 @@ -0,0 +1,40 @@ +! This test checks lowering of OpenMP parallel Directive with +! `PRIVATE` clause present. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect + +!FIRDialect: func @_QPprivate_clause(%[[ARG1:.*]]: !fir.ref, %[[ARG2:.*]]: !fir.ref>) { +!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "alpha"} +!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "beta"} +!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "gama"} +!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "alpha_array"} +!FIRDialect-DAG: omp.parallel private(%[[ALPHA]] : !fir.ref, %[[BETA]] : !fir.ref, %[[GAMA]] : !fir.ref, +!%[[ALPHA_ARRAY]] : !fir.ref>, %[[ARG1]] : !fir.ref, %[[ARG2]] : !fir.ref>)) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: llvm.func @_QPprivate_clause(%[[ARG1:.*]]: !llvm.ptr, %[[ARG2:.*]]: !llvm.ptr>) { +!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "alpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "beta"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "gama"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "alpha_array"} : (!llvm.i64) -> !llvm.ptr> +!LLVMIRDialect: omp.parallel private(%[[ALPHA]] : !llvm.ptr, %[[BETA]] : !llvm.ptr, %[[GAMA]] : !llvm.ptr, +!%[[ALPHA_ARRAY]] : !llvm.ptr>, %[[ARG1]] : !llvm.ptr, %[[ARG2]] : !llvm.ptr>) { +!LLVMIRDialect: omp.terminator +!LLVMIRDialect: } + +subroutine private_clause(arg1, arg2) + + integer :: arg1, arg2(10) + integer :: alpha, beta, gama + integer :: alpha_array(10) + +!$OMP PARALLEL PRIVATE(alpha, beta, gama, alpha_array, arg1, arg2) + print*, "PRIVATE" + print*, alpha, beta, gama +!$OMP END PARALLEL + +end subroutine diff --git a/flang/test/Lower/OpenMP/omp-parallel-shared-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-shared-clause.f90 new file mode 100644 index 0000000000000..2658dbbd2c6bb --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-shared-clause.f90 @@ -0,0 +1,40 @@ +! This test checks lowering of OpenMP parallel Directive with +! `SHARED` clause present. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect + +!FIRDialect: func @_QPshared_clause(%[[ARG1:.*]]: !fir.ref, %[[ARG2:.*]]: !fir.ref>) { +!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "alpha"} +!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "beta"} +!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "gama"} +!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "alpha_array"} +!FIRDialect: omp.parallel shared(%[[ALPHA]] : !fir.ref, %[[BETA]] : !fir.ref, %[[GAMA]] : !fir.ref, %[[ALPHA_ARRAY]] +!: !fir.ref>, %[[ARG1]] : !fir.ref, %[[ARG2]] : !fir.ref>)) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: llvm.func @_QPshared_clause(%[[ARG1:.*]]: !llvm.ptr, %[[ARG2:.*]]: !llvm.ptr>) { +!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "alpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "beta"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "gama"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "alpha_array"} : (!llvm.i64) -> !llvm.ptr> +!LLVMIRDialect: omp.parallel shared(%[[ALPHA]] : !llvm.ptr, %[[BETA]] : !llvm.ptr, %[[GAMA]] : !llvm.ptr, +!%[[ALPHA_ARRAY]] : !llvm.ptr>, %[[ARG1]] : !llvm.ptr, %[[ARG2]] : !llvm.ptr>) { +!LLVMIRDialect: omp.terminator +!LLVMIRDialect: } + +subroutine shared_clause(arg1, arg2) + + integer :: arg1, arg2(10) + integer :: alpha, beta, gama + integer :: alpha_array(10) + +!$OMP PARALLEL SHARED(alpha, beta, gama, alpha_array, arg1, arg2) + print*, "SHARED" + print*, alpha, beta, gama +!$OMP END PARALLEL + +end subroutine From f869df650ba20e69b9a2aca42fd8a4d4e142ee8b Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 2 Oct 2020 14:07:25 -0700 Subject: [PATCH 0285/1017] convert the last few TODO macros. --- .../{Lower => Optimizer}/Support/TypeCode.h | 8 +++---- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 24 +++++++++---------- 2 files changed, 15 insertions(+), 17 deletions(-) rename flang/include/flang/{Lower => Optimizer}/Support/TypeCode.h (93%) diff --git a/flang/include/flang/Lower/Support/TypeCode.h b/flang/include/flang/Optimizer/Support/TypeCode.h similarity index 93% rename from flang/include/flang/Lower/Support/TypeCode.h rename to flang/include/flang/Optimizer/Support/TypeCode.h index 64a5c62300084..360ca46f881cd 100644 --- a/flang/include/flang/Lower/Support/TypeCode.h +++ b/flang/include/flang/Optimizer/Support/TypeCode.h @@ -1,4 +1,4 @@ -//===-- Lower/Support/TypeCode.h --------------------------------*- C++ -*-===// +//===-- Optimizer/Support/TypeCode.h ----------------------------*- C++ -*-===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. @@ -10,8 +10,8 @@ // //===----------------------------------------------------------------------===// -#ifndef LOWER_SUPPORT_TYPECODE_H -#define LOWER_SUPPORT_TYPECODE_H +#ifndef OPTIMIZER_SUPPORT_TYPECODE_H +#define OPTIMIZER_SUPPORT_TYPECODE_H #include "flang/ISO_Fortran_binding.h" #include "llvm/Support/ErrorHandling.h" @@ -91,4 +91,4 @@ static constexpr int derivedToTypeCode() { } // namespace fir -#endif // LOWER_SUPPORT_TYPECODE_H +#endif // OPTIMIZER_SUPPORT_TYPECODE_H diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 7ccaf5b58cd47..a366e48440378 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -13,7 +13,7 @@ #include "flang/Optimizer/CodeGen/CodeGen.h" #include "DescriptorModel.h" #include "Target.h" -#include "flang/Lower/Support/TypeCode.h" +#include "flang/Lower/Todo.h" // remove when TODO's are done #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" @@ -21,6 +21,7 @@ #include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Optimizer/Support/KindMapping.h" +#include "flang/Optimizer/Support/TypeCode.h" #include "mlir/Conversion/StandardToLLVM/ConvertStandardToLLVM.h" #include "mlir/Conversion/StandardToLLVM/ConvertStandardToLLVMPass.h" #include "mlir/Dialect/Affine/IR/AffineOps.h" @@ -52,9 +53,6 @@ /// necessary to preserve the semantics of the Fortran program. //===----------------------------------------------------------------------===// -#undef TODO -#define TODO() llvm::report_fatal_error("tilikum: not yet implemented") - using namespace llvm; using OperandTy = ArrayRef; @@ -1157,7 +1155,7 @@ struct DispatchOpConversion : public FIROpConversion { // get the table, lookup the method, fetch the func-ptr rewriter.replaceOpWithNewOp(dispatch, ty, operands, None); - TODO(); + TODO(""); return success(); } }; @@ -1170,7 +1168,7 @@ struct DispatchTableOpConversion mlir::LogicalResult matchAndRewrite(fir::DispatchTableOp dispTab, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - TODO(); + TODO(""); return success(); } }; @@ -1182,7 +1180,7 @@ struct DTEntryOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::DTEntryOp dtEnt, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - TODO(); + TODO(""); return success(); } }; @@ -1340,7 +1338,7 @@ struct EmboxCommonConversion : public FIROpConversion { return getSizeAndTypeCode(loc, rewriter, seqTy.getEleTy()); } if (boxEleTy.isa()) { - TODO(); + TODO(""); } if (fir::isa_ref_type(boxEleTy)) { // FIXME: use the target pointer size rather than sizeof(void*) @@ -1348,7 +1346,7 @@ struct EmboxCommonConversion : public FIROpConversion { this->genConstantOffset(loc, rewriter, CFI_type_cptr)}; } // fail: unhandled case - TODO(); + TODO(""); } }; @@ -1646,7 +1644,7 @@ struct InsertOnRangeOpConversion mlir::LogicalResult doRewrite(fir::InsertOnRangeOp range, mlir::Type ty, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - TODO(); + TODO(""); return success(); } }; @@ -1783,7 +1781,7 @@ struct CoordinateOpConversion // If the base has dynamic shape, it has to be boxed as the dimension // information is saved in the box. if (FIRToLLVMTypeConverter::dynamicallySized(cpnTy)) { - TODO(); + TODO(""); return success(); } } else { @@ -1911,7 +1909,7 @@ struct CoordinateOpConversion return mlir::emitError(loc, "base element has deferred shapes"); // Generate offset computation. - TODO(); + TODO(""); return failure(); } @@ -2117,7 +2115,7 @@ struct GlobalLenOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::GlobalLenOp globalLen, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - TODO(); + TODO(""); return success(); } }; From 59c450e81e9e74afcf0f6a4c87651f6a315c86ba Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Fri, 2 Oct 2020 21:43:32 -0400 Subject: [PATCH 0286/1017] [flang][openacc] Fix data construct lowering (#470) --- flang/test/Lower/OpenACC/acc-data.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/flang/test/Lower/OpenACC/acc-data.f90 b/flang/test/Lower/OpenACC/acc-data.f90 index 0ab3de7f7fe57..a14b337de7d07 100644 --- a/flang/test/Lower/OpenACC/acc-data.f90 +++ b/flang/test/Lower/OpenACC/acc-data.f90 @@ -12,56 +12,56 @@ program acc_data !$acc data copy(a, b, c) !$acc end data -!CHECK: acc.data copy([[A]]: !fir.ref>, [[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.data copy([[A]], [[B]], [[C]] : !fir.ref>, !fir.ref>, !fir.ref>) { !CHECK: acc.terminator !CHECK-NEXT: }{{$}} !$acc data copy(a) copy(b) copy(c) !$acc end data -!CHECK: acc.data copy([[A]]: !fir.ref>, [[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.data copy([[A]], [[B]], [[C]] : !fir.ref>, !fir.ref>, !fir.ref>) { !CHECK: acc.terminator !CHECK-NEXT: }{{$}} !$acc data copyin(a) copyin(readonly: b, c) !$acc end data -!CHECK: acc.data copyin([[A]]: !fir.ref>) copyin_readonly([[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.data copyin([[A]] : !fir.ref>) copyin_readonly([[B]], [[C]] : !fir.ref>, !fir.ref>) { !CHECK: acc.terminator !CHECK-NEXT: }{{$}} !$acc data copyout(a) copyout(zero: b) copyout(c) !$acc end data -!CHECK: acc.data copyout([[A]]: !fir.ref>, [[C]]: !fir.ref>) copyout_zero([[B]]: !fir.ref>) { +!CHECK: acc.data copyout([[A]], [[C]] : !fir.ref>, !fir.ref>) copyout_zero([[B]] : !fir.ref>) { !CHECK: acc.terminator !CHECK-NEXT: }{{$}} !$acc data create(a, b) create(zero: c) !$acc end data -!CHECK: acc.data create([[A]]: !fir.ref>, [[B]]: !fir.ref>) create_zero([[C]]: !fir.ref>) { +!CHECK: acc.data create([[A]], [[B]] : !fir.ref>, !fir.ref>) create_zero([[C]] : !fir.ref>) { !CHECK: acc.terminator !CHECK-NEXT: }{{$}} !$acc data no_create(a, b) create(zero: c) !$acc end data -!CHECK: acc.data create_zero([[C]]: !fir.ref>) no_create([[A]]: !fir.ref>, [[B]]: !fir.ref>) { +!CHECK: acc.data create_zero([[C]] : !fir.ref>) no_create([[A]], [[B]] : !fir.ref>, !fir.ref>) { !CHECK: acc.terminator !CHECK-NEXT: }{{$}} !$acc data present(a, b, c) !$acc end data -!CHECK: acc.data present([[A]]: !fir.ref>, [[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.data present([[A]], [[B]], [[C]] : !fir.ref>, !fir.ref>, !fir.ref>) { !CHECK: acc.terminator !CHECK-NEXT: }{{$}} !$acc data attach(b, c) !$acc end data -!CHECK: acc.data attach([[B]]: !fir.ref>, [[C]]: !fir.ref>) { +!CHECK: acc.data attach([[B]], [[C]] : !fir.ref>, !fir.ref>) { !CHECK: acc.terminator !CHECK-NEXT: }{{$}} From 70af1bad522e625d019991d2ed816555a0448b20 Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 5 Oct 2020 11:31:33 -0700 Subject: [PATCH 0287/1017] Fix bug with (full) boxing assumed length CHARACTER type value. --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index a366e48440378..90b5fff8ecc0e 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -1261,10 +1261,9 @@ struct EmboxCommonConversion : public FIROpConversion { } // Get the element size and CFI type code of the boxed value. - std::tuple - getSizeAndTypeCode(mlir::Location loc, - mlir::ConversionPatternRewriter &rewriter, - mlir::Type boxEleTy) const { + std::tuple getSizeAndTypeCode( + mlir::Location loc, mlir::ConversionPatternRewriter &rewriter, + mlir::Type boxEleTy, mlir::ValueRange lenParams = {}) const { auto doInteger = [&](unsigned width) -> std::tuple { int typeCode = fir::integerBitsToTypeCode(width); @@ -1330,7 +1329,11 @@ struct EmboxCommonConversion : public FIROpConversion { // TODO: assumes the row is the length of the CHARACTER. This is true by // construction, but it may not hold after optimizations have run. auto rowSize = seqTy.getShape()[0]; - assert(rowSize != fir::SequenceType::getUnknownExtent()); + if (rowSize == fir::SequenceType::getUnknownExtent()) { + auto [_, tyCode] = + getSizeAndTypeCode(loc, rewriter, seqTy.getEleTy()); + return {lenParams[0], tyCode}; + } auto strTy = fir::CharacterType::get(rewriter.getContext(), charTy.getFKind(), rowSize); return getSizeAndTypeCode(loc, rewriter, strTy); @@ -1388,7 +1391,8 @@ struct EmboxOpConversion : public EmboxCommonConversion { // Write each of the fields with the appropriate values storeField(0, operands[0], bitCast); - auto [eleSize, cfiTy] = getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy()); + auto [eleSize, cfiTy] = getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy(), + operands.drop_front(1)); storeField(1, eleSize, intCast); auto version = genConstantOffset(loc, rewriter, CFI_VERSION); storeField(2, version, intCast); @@ -1438,7 +1442,9 @@ struct XEmboxOpConversion : public EmboxCommonConversion { // Write each of the fields with the appropriate values storeField(0, operands[0], bitCast); - auto [eleSize, cfiTy] = getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy()); + auto [eleSize, cfiTy] = + getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy(), + operands.drop_front(xbox.lenParamOffset() + 1)); storeField(1, eleSize, intCast); auto version = genConstantOffset(loc, rewriter, CFI_VERSION); storeField(2, version, intCast); From 2646e0d16888b819d959ac0fe2a8840bb8b3ee56 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Sat, 3 Oct 2020 02:19:46 +0530 Subject: [PATCH 0288/1017] [flang][OpenMP] Lower master construct to OpenMPDialect Lowering to LLVMIR will be done as a separate patch. Addressed review comments --- flang/test/Lower/OpenMP/omp-master.f90 | 89 ++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) create mode 100644 flang/test/Lower/OpenMP/omp-master.f90 diff --git a/flang/test/Lower/OpenMP/omp-master.f90 b/flang/test/Lower/OpenMP/omp-master.f90 new file mode 100644 index 0000000000000..3a19769df69ee --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-master.f90 @@ -0,0 +1,89 @@ +! This test checks lowering of OpenMP Master Directive to FIR + OpenMP Dialect. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect + +subroutine foo() + +!$OMP MASTER +!FIRDialect-LABEL: func @_QPfoo() { +!FIRDialect: omp.master { +!FIRDialect: fir.call @_FortranAioBeginExternalListOutput +!FIRDialect: fir.call @_FortranAioOutputAscii +!FIRDialect: fir.call @_FortranAioEndIoStatement +!FIRDialect: omp.terminator +!FIRDialect: } +!FIRDialect: return +!FIRDialect: } +print*, "Master region" +!$OMP END MASTER + +end subroutine + +program main + + integer :: alpha, beta, gama + alpha = 4 + beta = 5 + gama = 6 +!$OMP PARALLEL +print*, "Parallel region" +!FIRDialect-LABEL: func @_QQmain() { +!FIRDialect: omp.parallel { +!FIRDialect: fir.call @_FortranAioBeginExternalListOutput +!FIRDialect: fir.call @_FortranAioOutputAscii +!FIRDialect: fir.call @_FortranAioEndIoStatement + +!$OMP MASTER +!FIRDialect: omp.master { +!FIRDialect: fir.call @_FortranAioBeginExternalListOutput +!FIRDialect: fir.call @_FortranAioOutputAscii +!FIRDialect: fir.call @_FortranAioEndIoStatement +!FIRDialect: omp.terminator +!FIRDialect: } +print*, "Master region" +!$OMP END MASTER + +!FIRDialect: omp.terminator +!FIRDialect: } + +!$OMP END PARALLEL + +!$OMP PARALLEL +!FIRDialect: omp.parallel { +!FIRDialect: fir.call @_QPfoo() : () -> () +!FIRDialect: omp.terminator +!FIRDialect: } +call foo() +!$OMP END PARALLEL + + +!$OMP MASTER +!FIRDialect: omp.master { +!FIRDialect: %{{.*}} = fir.load %{{.*}} +!FIRDialect: %{{.*}} = fir.load %{{.*}} +!FIRDialect: %[[RESULT:.*]] = cmpi "sge", %{{.*}}, %{{.*}} +!FIRDialect: fir.if %[[RESULT]] { +if (alpha .ge. gama) then +!$OMP PARALLEL +!FIRDialect: omp.parallel { +!FIRDialect: fir.call @_FortranAioBeginExternalListOutput +!FIRDialect: fir.call @_FortranAioOutputInteger64 +!FIRDialect: fir.call @_FortranAioEndIoStatement +!FIRDialect: omp.terminator +!FIRDialect: } +print*, alpha +!$OMP END PARALLEL + beta = alpha + gama +end if +!FIRDialect: %{{.*}} = fir.load %{{.*}} +!FIRDialect: %{{.*}} = fir.load %{{.*}} +!FIRDialect: %{{.*}} = addi %{{.*}}, %{{.*}} +!FIRDialect: fir.store %{{.*}} to %{{.*}} +!FIRDialect: } else { +!FIRDialect: } +!FIRDialect: omp.terminator +!FIRDialect: } +!$OMP END MASTER + +end From 0f63c625d0e26bf43e3e4e6901fd656c0efc5eb4 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Tue, 29 Sep 2020 14:08:33 -0400 Subject: [PATCH 0289/1017] [flang][openacc] Update lowering of parallel and data construct --- flang/test/Lower/OpenACC/acc-data.f90 | 25 +++++++++++++++++++++++ flang/test/Lower/OpenACC/acc-parallel.f90 | 22 ++++++++++++++------ 2 files changed, 41 insertions(+), 6 deletions(-) diff --git a/flang/test/Lower/OpenACC/acc-data.f90 b/flang/test/Lower/OpenACC/acc-data.f90 index a14b337de7d07..588922c8ed730 100644 --- a/flang/test/Lower/OpenACC/acc-data.f90 +++ b/flang/test/Lower/OpenACC/acc-data.f90 @@ -4,11 +4,29 @@ program acc_data real, dimension(10, 10) :: a, b, c + logical :: ifCondition = .TRUE. !CHECK: [[A:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "a"} !CHECK: [[B:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "b"} !CHECK: [[C:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "c"} + !$acc data if(.TRUE.) copy(a) + !$acc end data + +!CHECK: [[IF1:%.*]] = constant true +!CHECK: acc.data if([[IF1]]) copy([[A]] : !fir.ref>) { +!CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + + !$acc data copy(a) if(ifCondition) + !$acc end data + +!CHECK: [[IFCOND:%.*]] = fir.load %{{.*}} : !fir.ref> +!CHECK: [[IF2:%.*]] = fir.convert [[IFCOND]] : (!fir.logical<4>) -> i1 +!CHECK: acc.data if([[IF2]]) copy([[A]] : !fir.ref>) { +!CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + !$acc data copy(a, b, c) !$acc end data @@ -56,6 +74,13 @@ program acc_data !CHECK: acc.data present([[A]], [[B]], [[C]] : !fir.ref>, !fir.ref>, !fir.ref>) { !CHECK: acc.terminator +!CHECK-NEXT: }{{$}} + + !$acc data deviceptr(b, c) + !$acc end data + +!CHECK: acc.data deviceptr([[B]], [[C]] : !fir.ref>, !fir.ref>) { +!CHECK: acc.terminator !CHECK-NEXT: }{{$}} !$acc data attach(b, c) diff --git a/flang/test/Lower/OpenACC/acc-parallel.f90 b/flang/test/Lower/OpenACC/acc-parallel.f90 index 9b025d8ccecba..111ee2ce932be 100644 --- a/flang/test/Lower/OpenACC/acc-parallel.f90 +++ b/flang/test/Lower/OpenACC/acc-parallel.f90 @@ -137,9 +137,14 @@ program acc_parallel !CHECK: acc.yield !CHECK-NEXT: }{{$}} -! NOT WORKING YET -! !$acc parallel if(ifCondition) -! !$acc end parallel + !$acc parallel if(ifCondition) + !$acc end parallel + +!CHECK: [[IFCOND:%.*]] = fir.load %{{.*}} : !fir.ref> +!CHECK: [[IF2:%.*]] = fir.convert [[IFCOND]] : (!fir.logical<4>) -> i1 +!CHECK: acc.parallel if([[IF2]]) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} !$acc parallel self(.TRUE.) !$acc end parallel @@ -156,9 +161,14 @@ program acc_parallel !CHECK: acc.yield !CHECK-NEXT: } attributes {selfAttr} -! NOT WORKING YET -! !$acc parallel self(ifCondition) -! !$acc end parallel + !$acc parallel self(ifCondition) + !$acc end parallel + +!CHECK: [[SELFCOND:%.*]] = fir.load %{{.*}} : !fir.ref> +!CHECK: [[SELF2:%.*]] = fir.convert [[SELFCOND]] : (!fir.logical<4>) -> i1 +!CHECK: acc.parallel self([[SELF2]]) { +!CHECK: acc.yield +!CHECK-NEXT: }{{$}} !$acc parallel copy(a, b, c) !$acc end parallel From cb394ef14e87aa13bf4852fee40a3fc0e5ab6128 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 29 Sep 2020 04:34:06 -0700 Subject: [PATCH 0290/1017] Character rework: use CharBoxValue instead of boxchar in internal value propagation - Use SymBox member functiuon in DescriptorInquiry Lowering - Prevent implicit cast from SymbolBox to mlir::Value - Fix entry issue with character results - Start cleaning character buffer types - Add constraint to check no boxchar makes it to ExtendedValue - Use ExtendedValue in function call lowering. Replace materializeCharacterOrSequence usages - Fix lit test diffs due to refactoring - Remove materializeCharacterOrSequence (replaced by ExtendedValue helpers) - replace materializeCharacter and remove cleanUpCharacter helper - remove llvm::Optional from lookupSymbol return - rework genType(Expr) to simplify and account for the shape - remove assert that AbstractBox base must be an address + Motivation: genLoad is loading characters (and now returns CharBoxValue) and CharBoxValue are now the norm to propagate character even when loaded. - Fix regressions with arrays treatead as scalar in IO output. This bug also motivated the genType() rework. - More character propagation as CharBoxValue + Return CharBoxValue/CharArrayBoxValue/ArrayBoxValue in genScalarLit/genArrayLit. + Return CharBoxValue from genLoad when loading characters. Add TODOs for non scalar cases. + Make ArrayRef lowering on character array to return CharBoxValue for character array. - rename CharaceterHelper `isCharacter` to `isCharacterScalar` (better describe what it is doing) - Update CHAR/ACHAR intrinsic lowering to return CharBoxValue - use genExprAddr for character rhs assignment Now that genLoad is actually loading constant length characters and it appeared that createAssign cannot assign these loaded rhs since fir.coordinateof only work on in-memory types. - avoid assert checking for scalar in character array context - allocate character in memory before loops to use coordinateof This is needed now that genload loads constant length charcaters. I think the best would be to change coordinateof to work on fir.array<> but that's not the easiest. The alternative is to never load characters, always use genref. - retrieve constant length in creatCharacterTemp The constant length is used in the type. Descriptor creation currently only works with constant length in the type, so this patch is important to avoid regressions. - ensure character lengths are of the same types --- flang/include/flang/Lower/CharacterExpr.h | 59 ++--- flang/include/flang/Lower/CharacterRuntime.h | 11 +- flang/include/flang/Lower/ConvertType.h | 8 +- flang/include/flang/Lower/Support/BoxValue.h | 29 +- flang/lib/Lower/Bridge.cpp | 161 ++++++----- flang/lib/Lower/CharacterRuntime.cpp | 27 +- flang/lib/Lower/ConvertExpr.cpp | 264 ++++++++++--------- flang/lib/Lower/ConvertType.cpp | 65 ++++- flang/lib/Lower/SymbolMap.h | 4 - flang/test/Lower/character-assignment.f90 | 43 +-- flang/test/Lower/concat.f90 | 12 +- flang/test/Lower/intrinsics.f90 | 4 +- 12 files changed, 381 insertions(+), 306 deletions(-) diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index 2061100195f3d..34a6220bcb20a 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -35,18 +35,20 @@ class CharacterExprHelper { /// Copy the \p count first characters of \p src into \p dest. /// \p count can have any integer type. - void createCopy(mlir::Value dest, mlir::Value src, mlir::Value count); + void createCopy(const fir::CharBoxValue &dest, const fir::CharBoxValue &src, + mlir::Value count); /// Set characters of \p str at position [\p lower, \p upper) to blanks. /// \p lower and \upper bounds are zero based. /// If \p upper <= \p lower, no padding is done. /// \p upper and \p lower can have any integer type. - void createPadding(mlir::Value str, mlir::Value lower, mlir::Value upper); + void createPadding(const fir::CharBoxValue &str, mlir::Value lower, + mlir::Value upper); /// Create str(lb:ub), lower bounds must always be specified, upper /// bound is optional. - mlir::Value createSubstring(mlir::Value str, - llvm::ArrayRef bounds); + fir::CharBoxValue createSubstring(const fir::CharBoxValue &str, + llvm::ArrayRef bounds); /// Return blank character of given \p type !fir.char mlir::Value createBlankConstant(fir::CharacterType type); @@ -62,7 +64,8 @@ class CharacterExprHelper { mlir::Value rlen); /// Create lhs // rhs in temp obtained with fir.alloca - mlir::Value createConcatenate(mlir::Value lhs, mlir::Value rhs); + fir::CharBoxValue createConcatenate(const fir::CharBoxValue &lhs, + const fir::CharBoxValue &rhs); /// LEN_TRIM intrinsic. mlir::Value createLenTrim(mlir::Value str); @@ -71,35 +74,24 @@ class CharacterExprHelper { /// Take care of type conversions before emboxing. /// \p len is converted to the integer type for character lengths if needed. mlir::Value createEmboxChar(mlir::Value addr, mlir::Value len); + mlir::Value createEmbox(const fir::CharBoxValue &str); + /// Embox a string array. The length is sizeof(str)*len(str). + mlir::Value createEmbox(const fir::CharArrayBoxValue &str); + + /// Convert character array to a scalar by reducing the extents into the + /// length. Will fail if call on non reference like base. + fir::CharBoxValue toScalarCharacter(const fir::CharArrayBoxValue &); /// Unbox \p boxchar into (fir.ref>, getLengthType()). std::pair createUnboxChar(mlir::Value boxChar); /// Allocate a temp of fir::CharacterType type and length len. - /// Returns related fir.ref>. - mlir::Value createCharacterTemp(mlir::Type type, mlir::Value len); + /// Returns related fir.ref>>. + fir::CharBoxValue createCharacterTemp(mlir::Type type, mlir::Value len); /// Allocate a temp of compile time constant length. /// Returns related fir.ref>>. - mlir::Value createCharacterTemp(mlir::Type type, int len) { - return createTemp(type, len); - } - - /// Return buffer/length pair of character str, if str is a constant, - /// it is allocated into a temp, otherwise, its memory reference is - /// returned as the buffer. - /// The buffer type of str is of type: - /// - fir.ref>> if str has compile time - /// constant length. - /// - fir.ref> if str has dynamic length. - std::pair materializeCharacter(mlir::Value str); - - /// Return the (buffer, length) pair of `str`. Returns the obvious pair if - /// `str` is a scalar. However if `str` is an array of CHARACTER, this will - /// perform an implicit concatenation of the entire array. This implements the - /// implied semantics of using an array of CHARACTER in a scalar context. - std::pair - materializeCharacterOrSequence(mlir::Value str); + fir::CharBoxValue createCharacterTemp(mlir::Type type, int len); /// Return true if \p type is a character literal type (is /// `fir.array>`).; @@ -109,7 +101,7 @@ class CharacterExprHelper { /// - fir.boxchar /// - fir.ref>> /// - fir.array> - static bool isCharacter(mlir::Type type); + static bool isCharacterScalar(mlir::Type type); /// Extract the kind of a character type static fir::KindTy getCharacterKind(mlir::Type type); @@ -163,6 +155,8 @@ class CharacterExprHelper { fir::ExtendedValue cleanUpCharacterExtendedValue(const fir::ExtendedValue &); private: + /// FIXME: the implementation also needs a clean-up now that + /// CharBoxValue are better propagated. fir::CharBoxValue materializeValue(mlir::Value str); fir::CharBoxValue toDataLengthPair(mlir::Value character); mlir::Type getReferenceType(const fir::CharBoxValue &c) const; @@ -170,23 +164,12 @@ class CharacterExprHelper { mlir::Type getSeqTy(const fir::CharBoxValue &c) const; mlir::Type getSeqTy(mlir::Value str) const; mlir::Value getCharBoxBuffer(const fir::CharBoxValue &box); - mlir::Value createEmbox(const fir::CharBoxValue &str); mlir::Value createLoadCharAt(mlir::Value buff, mlir::Value index); void createStoreCharAt(mlir::Value str, mlir::Value index, mlir::Value c); - void createCopy(const fir::CharBoxValue &dest, const fir::CharBoxValue &src, - mlir::Value count); - void createPadding(const fir::CharBoxValue &str, mlir::Value lower, - mlir::Value upper); - fir::CharBoxValue createTemp(mlir::Type type, mlir::Value len); void createLengthOneAssign(const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs); void createAssign(const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs); - fir::CharBoxValue createConcatenate(const fir::CharBoxValue &lhs, - const fir::CharBoxValue &rhs); - fir::CharBoxValue createSubstring(const fir::CharBoxValue &str, - llvm::ArrayRef bounds); mlir::Value createLenTrim(const fir::CharBoxValue &str); - mlir::Value createTemp(mlir::Type type, int len); mlir::Value createBlankConstantCode(fir::CharacterType type); private: diff --git a/flang/include/flang/Lower/CharacterRuntime.h b/flang/include/flang/Lower/CharacterRuntime.h index d2992f76406ae..714083adf2b97 100644 --- a/flang/include/flang/Lower/CharacterRuntime.h +++ b/flang/include/flang/Lower/CharacterRuntime.h @@ -11,15 +11,20 @@ #include "mlir/Dialect/StandardOps/IR/Ops.h" +namespace fir { +class ExtendedValue; +} + namespace Fortran { namespace lower { class AbstractConverter; /// Generate call to a character comparison for two ssa-values of type /// `boxchar`. -mlir::Value genBoxCharCompare(AbstractConverter &converter, mlir::Location loc, - mlir::CmpIPredicate cmp, mlir::Value lhs, - mlir::Value rhs); +mlir::Value genCharCompare(AbstractConverter &converter, mlir::Location loc, + mlir::CmpIPredicate cmp, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs); /// Generate call to a character comparison op for two unboxed variables. There /// are 4 arguments, 2 for the lhs and 2 for the rhs. Each CHARACTER must pass a diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h index 20e1cd3f80695..ba1a5f1dbd4e6 100644 --- a/flang/include/flang/Lower/ConvertType.h +++ b/flang/include/flang/Lower/ConvertType.h @@ -48,6 +48,7 @@ struct SomeKind; struct SomeType; template class Type; +class FoldingContext; } // namespace evaluate namespace semantics { @@ -95,10 +96,9 @@ inline mlir::Type translateDesignatorToFIRType( } /// Translate a SomeExpr to an mlir::Type. -mlir::Type -translateSomeExprToFIRType(mlir::MLIRContext *ctxt, - common::IntrinsicTypeDefaultKinds const &defaults, - const SomeExpr *expr); +mlir::Type translateSomeExprToFIRType(mlir::MLIRContext *ctxt, + evaluate::FoldingContext &, + const SomeExpr *expr); /// Translate a Fortran::semantics::Symbol to an mlir::Type. mlir::Type diff --git a/flang/include/flang/Lower/Support/BoxValue.h b/flang/include/flang/Lower/Support/BoxValue.h index 69ba857403b83..8f56311387a18 100644 --- a/flang/include/flang/Lower/Support/BoxValue.h +++ b/flang/include/flang/Lower/Support/BoxValue.h @@ -53,11 +53,10 @@ using UnboxedValue = mlir::Value; class AbstractBox { public: AbstractBox() = delete; - AbstractBox(mlir::Value addr) : addr{addr} { - assert(isa_passbyref_type(addr.getType()) && - "box values must be references"); - } + AbstractBox(mlir::Value addr) : addr{addr} {} + /// FIXME: this comment is not true anymore since genLoad + /// is loading constant length characters. What is the impact /// ? /// An abstract box always contains a memory reference to a value. mlir::Value getAddr() const { return addr; } @@ -70,7 +69,10 @@ class AbstractBox { class CharBoxValue : public AbstractBox { public: CharBoxValue(mlir::Value addr, mlir::Value len) - : AbstractBox{addr}, len{len} {} + : AbstractBox{addr}, len{len} { + if (addr && addr.getType().template isa()) + llvm::report_fatal_error("BoxChar should not be in CharBoxValue"); + } CharBoxValue clone(mlir::Value newBase) const { return {newBase, len}; } @@ -230,7 +232,22 @@ class ExtendedValue : public details::matcher { ExtendedValue(ExtendedValue &&) = default; template , ExtendedValue>>> - constexpr ExtendedValue(A &&box) : box{std::forward(box)} {} + constexpr ExtendedValue(A &&a) : box{std::forward(a)} { + if (auto b = getUnboxed()) { + if (*b) { + auto type = b->getType(); + if (type.template isa()) + llvm::report_fatal_error("BoxChar should be unboxed"); + if (auto refType = type.template dyn_cast()) + type = refType.getEleTy(); + if (auto seqType = type.template dyn_cast()) + type = seqType.getEleTy(); + if (type.template isa()) + llvm::report_fatal_error( + "character buffer should be in CharBoxValue"); + } + } + } template constexpr const A *getBoxOf() const { diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index cd5adf320840b..989fcf0c75c70 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -25,8 +25,8 @@ #include "flang/Lower/OpenMP.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" -#include "flang/Lower/Todo.h" #include "flang/Lower/Support/BoxValue.h" +#include "flang/Lower/Todo.h" #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" @@ -323,7 +323,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { //===--------------------------------------------------------------------===// mlir::Value getSymbolAddress(Fortran::lower::SymbolRef sym) override final { - return fir::getBase(lookupSymbol(sym)); + return lookupSymbol(sym).getAddr(); } bool lookupLabelSet(Fortran::lower::SymbolRef sym, @@ -367,8 +367,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { &getMLIRContext(), bridge.getDefaultKinds(), data); } mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final { - return Fortran::lower::translateSomeExprToFIRType( - &getMLIRContext(), bridge.getDefaultKinds(), &expr); + return Fortran::lower::translateSomeExprToFIRType(&getMLIRContext(), + foldingContext, &expr); } mlir::Type genType(const Fortran::lower::pft::Variable &var) override final { return Fortran::lower::translateVariableToFIRType( @@ -475,7 +475,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } /// Find the symbol in the local map or return null. - mlir::Value lookupSymbol(const Fortran::semantics::Symbol &sym) { + Fortran::lower::SymbolBox + lookupSymbol(const Fortran::semantics::Symbol &sym) { if (auto v = localSymbols.lookupSymbol(sym)) return v; return {}; @@ -499,6 +500,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { localSymbols.erase(sym); else if (lookupSymbol(sym)) return false; + // TODO: ensure val type is fir.array> like. Insert + // cast if needed. localSymbols.addCharSymbol(sym, val, len); return true; } @@ -506,8 +509,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Value createTemp(mlir::Location loc, const Fortran::semantics::Symbol &sym, llvm::ArrayRef shape = {}) { + // FIXME: should return fir::ExtendedValue if (auto v = lookupSymbol(sym)) - return v; + return v.getAddr(); auto newVal = builder->createTemporary(loc, genType(sym), sym.name().ToString(), shape); addSymbol(sym, newVal); @@ -583,19 +587,27 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) { const auto &resultSym = functionSymbol.get().result(); - mlir::Value resultRef = lookupSymbol(resultSym); + auto resultSymBox = lookupSymbol(resultSym); auto loc = toLocation(); - if (resultRef.getType().isa()) { - builder->create(loc, resultRef); + if (!resultSymBox) { + mlir::emitError(loc, "failed lowering function return"); return; } - // A function with multiple entry points returning different types tags - // all result variables with one of the largest types to allow them to - // share the the same storage. Convert this to the actual type. - mlir::Type resultRefType = builder->getRefType(genType(resultSym)); - if (resultRef.getType() != resultRefType) - resultRef = builder->createConvert(loc, resultRefType, resultRef); - mlir::Value resultVal = builder->create(loc, resultRef); + auto resultVal = resultSymBox.match( + [&](const fir::CharBoxValue &x) -> mlir::Value { + return Fortran::lower::CharacterExprHelper{*builder, loc} + .createEmboxChar(x.getBuffer(), x.getLen()); + }, + [&](const auto &) -> mlir::Value { + auto resultRef = resultSymBox.getAddr(); + mlir::Type resultRefType = builder->getRefType(genType(resultSym)); + // A function with multiple entry points returning different types + // tags all result variables with one of the largest types to allow + // them to share the same storage. Convert this to the actual type. + if (resultRef.getType() != resultRefType) + resultRef = builder->createConvert(loc, resultRefType, resultRef); + return builder->create(loc, resultRef); + }); builder->create(loc, resultVal); } @@ -605,9 +617,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { getAltReturnResult(const Fortran::semantics::Symbol &symbol) { assert(Fortran::semantics::HasAlternateReturns(symbol) && "subroutine does not have alternate returns"); - const auto returnValue = lookupSymbol(symbol); - assert(returnValue && "missing alternate return value"); - return returnValue; + return getSymbolAddress(symbol); } void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit, @@ -778,15 +788,13 @@ class FirConverter : public Fortran::lower::AbstractConverter { // only by an ASSIGN statement in the same scoping unit as the assigned // GOTO statement. + auto loc = toLocation(); auto &eval = getEval(); const auto &symbolLabelMap = eval.getOwningProcedure()->assignSymbolLabelMap; const auto &symbol = *std::get(stmt.t).symbol; - auto variable = lookupSymbol(symbol); - auto loc = toLocation(); - if (!variable) - variable = createTemp(loc, symbol); - auto selectExpr = builder->create(loc, variable); + auto selectExpr = + builder->create(loc, getSymbolAddress(symbol)); auto iter = symbolLabelMap.find(symbol); if (iter == symbolLabelMap.end()) { // Fail for a nonconforming program unit that does not have any ASSIGN @@ -1224,7 +1232,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::semantics::GetExpr(std::get(stmt.t))); auto selectType = selectExpr.getType(); Fortran::lower::CharacterExprHelper helper{*builder, loc}; - if (helper.isCharacter(selectExpr.getType())) { + if (helper.isCharacterScalar(selectExpr.getType())) { TODO(""); } llvm::SmallVector attrList; @@ -1441,7 +1449,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { [&](const Fortran::parser::Name &sym) { auto ty = genType(*sym.symbol); auto load = builder->create( - loc, lookupSymbol(*sym.symbol)); + loc, getSymbolAddress(*sym.symbol)); auto idxTy = builder->getIndexType(); auto zero = builder->create( loc, idxTy, builder->getIntegerAttr(idxTy, 0)); @@ -1622,9 +1630,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { } if (isCharacterCategory(lhsType->category())) { // Fortran 2018 10.2.1.3 p10 and p11 - // Generating value for lhs to get fir.boxchar. auto lhs = genExprAddr(assign.lhs); - auto rhs = genExprValue(assign.rhs); + // Current character assignment only works with in memory + // characters since !fir.array<> cannot be addressed with + // fir.coordinate_of without being inside a !fir.ref<> or other + // memory types. So use genExprAddr for rhs. + auto rhs = genExprAddr(assign.rhs); Fortran::lower::CharacterExprHelper{*builder, loc}.createAssign( lhs, rhs); return; @@ -1693,13 +1704,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::AssignStmt &stmt) { const auto &symbol = *std::get(stmt.t).symbol; - auto variable = lookupSymbol(symbol); auto loc = toLocation(); - if (!variable) - variable = createTemp(loc, symbol); const auto labelValue = builder->createIntegerConstant( loc, genType(symbol), std::get(stmt.t)); - builder->create(loc, labelValue, variable); + builder->create(loc, labelValue, getSymbolAddress(symbol)); } void genFIR(const Fortran::parser::FormatStmt &) { @@ -2076,7 +2084,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { // bounds from the caller (boxed somewhere else). Locals have the same // properties except they are never boxed arguments from the caller and // never having a missing column size. - mlir::Value addr = lookupSymbol(sym); + + // Arguments (and some results) already have a symbolBox with the address. + auto maybeSymbolBox = lookupSymbol(sym); + mlir::Value addr = + maybeSymbolBox ? maybeSymbolBox.getAddr() : mlir::Value{}; mlir::Value len; [[maybe_unused]] bool mustBeDummy = false; @@ -2084,31 +2096,30 @@ class FirConverter : public Fortran::lower::AbstractConverter { // if element type is a CHARACTER, determine the LEN value if (isDummy || isResult) { auto unboxchar = charHelp.createUnboxChar(addr); - auto boxAddr = unboxchar.first; + addr = unboxchar.first; if (auto c = sba.getCharLenConst()) { // Set/override LEN with a constant len = builder->createIntegerConstant(loc, idxTy, *c); - addr = charHelp.createEmboxChar(boxAddr, len); } else if (auto e = sba.getCharLenExpr()) { // Set/override LEN with an expression len = createFIRExpr(loc, &*e); - addr = charHelp.createEmboxChar(boxAddr, len); } else { // LEN is from the boxchar len = unboxchar.second; mustBeDummy = true; } - // XXX: Subsequent lowering expects a CHARACTER variable to be in a + // XXX: Subsequent lowering expects a CHARACTER variable to not be in a // boxchar. We assert that here. We might want to reconsider this // precondition. - assert(addr.getType().isa() && - "dummy CHARACTER argument must be boxchar"); + assert(!addr.getType().isa() && + "dummy CHARACTER argument must be unboxed"); } else { // local CHARACTER variable if (auto c = sba.getCharLenConst()) len = builder->createIntegerConstant(loc, idxTy, *c); else if (auto e = sba.getCharLenExpr()) - len = createFIRExpr(loc, &*e); + len = builder->createConvert(loc, charHelp.getLengthType(), + createFIRExpr(loc, &*e)); else len = builder->createIntegerConstant(loc, idxTy, sym.size()); assert(!addr); @@ -2124,14 +2135,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (sba.staticSize) { // object shape is constant auto castTy = builder->getRefType(genType(var)); - if (addr) { - // XXX: special handling for boxchar; see proviso above - if (auto box = - dyn_cast_or_null(addr.getDefiningOp())) - addr = builder->createConvert(loc, castTy, box.memref()); - else - addr = builder->createConvert(loc, castTy, addr); - } + if (addr) + addr = builder->createConvert(loc, castTy, addr); if (sba.lboundIsAllOnes()) { // if lower bounds are all ones, build simple shaped object llvm::SmallVector shape; @@ -2159,14 +2164,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } else { // cast to the known constant parts from the declaration auto castTy = builder->getRefType(genType(var)); - if (addr) { - // XXX: special handling for boxchar; see proviso above - if (auto box = - dyn_cast_or_null(addr.getDefiningOp())) - addr = builder->createConvert(loc, castTy, box.memref()); - else - addr = builder->createConvert(loc, castTy, addr); - } + if (addr) + addr = builder->createConvert(loc, castTy, addr); } // construct constants and populate `bounds` for (const auto &i : llvm::zip(sba.staticLBound, sba.staticShape)) { @@ -2239,13 +2238,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { } assert(!mustBeDummy); auto charTy = genType(var); - auto c = sba.getCharLenConst(); - // Note: `len` is the mlir ConstantOp with value `c`, if `c` is an int. - mlir::Value local = preAlloc - ? preAlloc - : (c ? charHelp.createCharacterTemp(charTy, *c) - : charHelp.createCharacterTemp(charTy, len)); - addCharSymbol(sym, local, len); + fir::CharBoxValue local = preAlloc + ? fir::CharBoxValue(preAlloc, len) + : charHelp.createCharacterTemp(charTy, len); + addCharSymbol(sym, local.getBuffer(), local.getLen()); return; } if (isDummy) { @@ -2386,7 +2382,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm_unreachable("must be a common symbol"); } } - auto commonAddr = lookupSymbol(common); + mlir::Value commonAddr; + if (auto symBox = lookupSymbol(common)) + commonAddr = symBox.getAddr(); if (!commonAddr) { commonAddr = builder->create(loc, global.resultType(), global.getSymbol()); @@ -2428,6 +2426,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { using PassBy = Fortran::lower::CalleeInterface::PassEntityBy; auto mapPassedEntity = [&](const auto arg) -> void { if (arg.passBy == PassBy::AddressAndLength) { + // TODO: now that fir call has some attributes regarding character + // return, this should PassBy::AddressAndLength should be retired. auto loc = toLocation(); Fortran::lower::CharacterExprHelper charHelp{*builder, loc}; auto box = charHelp.createEmboxChar(arg.firArgument, arg.firLength); @@ -2452,9 +2452,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { } if (auto passedResult = callee.getPassedResult()) { mapPassedEntity(*passedResult); + // FIXME: need to make sure things are OK here. addSymbol is may not be OK if (funit.primaryResult && passedResult->entity.get() != *funit.primaryResult) - addSymbol(*funit.primaryResult, lookupSymbol(passedResult->entity)); + addSymbol(*funit.primaryResult, getSymbolAddress(passedResult->entity)); } } @@ -2469,9 +2470,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { mapDummiesAndResults(funit, callee); - mlir::Value primaryFuncResult; - llvm::SmallVector - deferredFuncResultList; + // Note: not storing Variable references because getOrderedSymbolTable + // below returns a temporary. + llvm::SmallVector deferredFuncResultList; CommonBlockMap commonBlockMap; for (const auto &var : funit.getOrderedSymbolTable()) { @@ -2487,6 +2488,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } + // Backup actual argument for entry character results + // with different lengths. It needs to be added to the non + // primary results symbol before mapSymbolAttributes is called. + Fortran::lower::SymbolBox resultArg; + if (auto passedResult = callee.getPassedResult()) + resultArg = lookupSymbol(passedResult->entity.get()); + + mlir::Value primaryFuncResultStorage; llvm::DenseMap storeMap; for (const auto &var : funit.getOrderedSymbolTable()) { if (var.isAggregateStore()) { @@ -2498,13 +2507,21 @@ class FirConverter : public Fortran::lower::AbstractConverter { instantiateVar(var, storeMap, &commonBlockMap); } else if (&sym == funit.primaryResult) { instantiateVar(var, storeMap); - primaryFuncResult = lookupSymbol(sym); + primaryFuncResultStorage = getSymbolAddress(sym); } else { - deferredFuncResultList.push_back(&sym); + deferredFuncResultList.push_back(var); } } - for (auto altResult : deferredFuncResultList) - addSymbol(*altResult, primaryFuncResult); + + /// TODO: should use same mechanism as equivalence? + /// One blocking point is character entry returns that need special handling + /// since they are not locally allocated but come as argument. CHARACTER(*) + /// is not something that fit wells with equivalence lowering. + for (const auto &altResult : deferredFuncResultList) { + if (auto passedResult = callee.getPassedResult()) + addSymbol(altResult.getSymbol(), resultArg.getAddr()); + mapSymbolAttributes(altResult, storeMap, primaryFuncResultStorage); + } // Create most function blocks in advance. auto *alternateEntryEval = funit.getEntryEval(); diff --git a/flang/lib/Lower/CharacterRuntime.cpp b/flang/lib/Lower/CharacterRuntime.cpp index 39c7f722c2777..3f439f8691cf1 100644 --- a/flang/lib/Lower/CharacterRuntime.cpp +++ b/flang/lib/Lower/CharacterRuntime.cpp @@ -12,6 +12,8 @@ #include "flang/Lower/Bridge.h" #include "flang/Lower/CharacterExpr.h" #include "flang/Lower/FIRBuilder.h" +#include "flang/Lower/Support/BoxValue.h" +#include "flang/Lower/Todo.h" #include "mlir/Dialect/StandardOps/IR/Ops.h" using namespace Fortran::runtime; @@ -117,13 +119,22 @@ Fortran::lower::genRawCharCompare(Fortran::lower::AbstractConverter &converter, } mlir::Value -Fortran::lower::genBoxCharCompare(Fortran::lower::AbstractConverter &converter, - mlir::Location loc, mlir::CmpIPredicate cmp, - mlir::Value lhs, mlir::Value rhs) { +Fortran::lower::genCharCompare(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::CmpIPredicate cmp, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs) { auto &builder = converter.getFirOpBuilder(); - Fortran::lower::CharacterExprHelper helper{builder, loc}; - auto lhsPair = helper.materializeCharacter(lhs); - auto rhsPair = helper.materializeCharacter(rhs); - return genRawCharCompare(converter, loc, cmp, lhsPair.first, lhsPair.second, - rhsPair.first, rhsPair.second); + if (lhs.getBoxOf() || rhs.getBoxOf()) + TODO("character compare from descriptors"); + auto allocateIfNotInMemory = [&](mlir::Value base) -> mlir::Value { + if (fir::isa_ref_type(base.getType())) + return base; + auto mem = builder.create(loc, base.getType()); + builder.create(loc, base, mem); + return mem; + }; + auto lhsBuffer = allocateIfNotInMemory(fir::getBase(lhs)); + auto rhsBuffer = allocateIfNotInMemory(fir::getBase(rhs)); + return genRawCharCompare(converter, loc, cmp, lhsBuffer, fir::getLen(lhs), + rhsBuffer, fir::getLen(rhs)); } diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index fdeffff7cbded..ca74522297c27 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -241,29 +241,8 @@ class ExprLowering { mlir::Value createCharCompare(mlir::CmpIPredicate pred, const fir::ExtendedValue &left, const fir::ExtendedValue &right) { - if (auto *lhs = left.getUnboxed()) { - if (auto *rhs = right.getUnboxed()) - return Fortran::lower::genBoxCharCompare(converter, getLoc(), pred, - *lhs, *rhs); - if (auto *rhs = right.getCharBox()) - return Fortran::lower::genBoxCharCompare(converter, getLoc(), pred, - *lhs, rhs->getBuffer()); - } - if (auto *lhs = left.getCharBox()) { - if (auto *rhs = right.getCharBox()) { - // FIXME: this should be passing the CharBoxValues and not just a buffer - // addresses - return Fortran::lower::genBoxCharCompare( - converter, getLoc(), pred, lhs->getBuffer(), rhs->getBuffer()); - } - if (auto *rhs = right.getUnboxed()) - return Fortran::lower::genBoxCharCompare(converter, getLoc(), pred, - lhs->getBuffer(), *rhs); - } - - // Error if execution reaches this point - mlir::emitError(getLoc(), "Unhandled character comparison"); - exit(1); + return Fortran::lower::genCharCompare(converter, getLoc(), pred, left, + right); } template @@ -296,14 +275,20 @@ class ExprLowering { } /// Generate a load of a value from an address. - mlir::Value genLoad(const fir::ExtendedValue &addr) { + fir::ExtendedValue genLoad(const fir::ExtendedValue &addr) { auto loc = getLoc(); return addr.match( - [&](const fir::CharBoxValue &box) -> mlir::Value { + [&](const fir::CharBoxValue &box) -> fir::ExtendedValue { auto buffer = box.getBuffer(); auto len = dyn_cast(box.getLen().getDefiningOp()); if (!len) { // TODO: return an emboxchar? + // Not sure an emboxchar would help, it would simply + // indirects the memory reference, so it fakes the load and then + // makes it harder to work with the character due to the + // indirection. Solutions I see are: + // 1. create a temp and returns a CharBoxValue pointing to it. + // 2. create a dynamic vector fir type that can abstract 1. mlir::emitError(loc, "cannot load a variable length char"); return {}; } @@ -319,10 +304,17 @@ class ExprLowering { auto charTy = builder.getRefType(fir::SequenceType::get(shape, baseTy)); auto casted = builder.createConvert(loc, charTy, buffer); - return builder.create(loc, casted); + auto val = builder.create(loc, casted); + return fir::CharBoxValue{val, box.getLen()}; }, - [&](const auto &v) -> mlir::Value { + [&](const fir::CharArrayBoxValue &v) -> fir::ExtendedValue { + TODO("loading character array"); + }, + [&](const fir::UnboxedValue &v) -> fir::ExtendedValue { return builder.create(loc, fir::getBase(v)); + }, + [&](const auto &v) -> fir::ExtendedValue { + TODO("loading array or descriptor"); }); } @@ -395,7 +387,7 @@ class ExprLowering { if (Fortran::semantics::IsDummy(*symbol)) { auto val = symMap.lookupSymbol(*symbol); assert(val && "Dummy procedure not in symbol map"); - return val; + return val.getAddr(); } auto name = converter.mangleName(*symbol); auto func = Fortran::lower::getOrDeclareFunction(name, proc, converter); @@ -414,26 +406,15 @@ class ExprLowering { } fir::ExtendedValue genval(const Fortran::evaluate::DescriptorInquiry &desc) { - auto descRef = symMap.lookupSymbol(desc.base().GetLastSymbol()); - assert(descRef && "no mlir::Value associated to Symbol"); - auto descType = descRef.getAddr().getType(); - mlir::Value res{}; + auto symBox = symMap.lookupSymbol(desc.base().GetLastSymbol()); + assert(symBox && "no SymbolBox associated to Symbol"); switch (desc.field()) { case Fortran::evaluate::DescriptorInquiry::Field::Len: - if (descType.isa()) { - auto lenType = Fortran::lower::CharacterExprHelper{builder, getLoc()} - .getLengthType(); - res = builder.create(getLoc(), lenType, descRef); - } else if (descType.isa()) { - TODO(""); - } else { - llvm_unreachable("not a descriptor"); - } - break; + return symBox.getCharLen().getValue(); default: - TODO(""); + TODO("descriptor inquiry other than length"); } - return res; + llvm_unreachable("bad descriptor inquiry"); } fir::ExtendedValue genval(const Fortran::evaluate::TypeParamInquiry &) { @@ -568,10 +549,12 @@ class ExprLowering { fir::ExtendedValue genval(const Fortran::evaluate::Concat &op) { auto lhs = genval(op.left()); auto rhs = genval(op.right()); - auto lhsBase = fir::getBase(lhs); - auto rhsBase = fir::getBase(rhs); - return Fortran::lower::CharacterExprHelper{builder, getLoc()} - .createConcatenate(lhsBase, rhsBase); + auto *lhsChar = lhs.getCharBox(); + auto *rhsChar = rhs.getCharBox(); + if (lhsChar && rhsChar) + return Fortran::lower::CharacterExprHelper{builder, getLoc()} + .createConcatenate(*lhsChar, *rhsChar); + llvm::report_fatal_error("TODO: character array concatenate"); } /// MIN and MAX operations @@ -756,10 +739,14 @@ class ExprLowering { getLoc(), llvm::ArrayRef{type}, llvm::None, attrs); }; + auto lenp = builder.createIntegerConstant( + getLoc(), + Fortran::lower::CharacterExprHelper{builder, getLoc()}.getLengthType(), + len); // When in an initializer context, construct the literal op itself and do // not construct another constant object in rodata. if (exprCtx.inInitializer()) - return consLit().getResult(); + return fir::CharBoxValue{consLit().getResult(), lenp}; // Otherwise, the string is in a plain old expression so "outline" the value // by hashconsing it to a constant literal object. @@ -780,10 +767,6 @@ class ExprLowering { builder.createLinkOnceLinkage()); auto addr = builder.create(getLoc(), global.resultType(), global.getSymbol()); - auto lenp = builder.createIntegerConstant( - getLoc(), - Fortran::lower::CharacterExprHelper{builder, getLoc()}.getLengthType(), - len); return fir::CharBoxValue{addr, lenp}; } /// Helper to call the correct scalar conversion based on category. @@ -803,6 +786,13 @@ class ExprLowering { fir::ExtendedValue genArrayLit( const Fortran::evaluate::Constant> &con) { + llvm::SmallVector lbounds; + llvm::SmallVector extents; + auto idxTy = builder.getIndexType(); + for (const auto &[lb, extent] : llvm::zip(con.lbounds(), con.shape())) { + lbounds.push_back(builder.createIntegerConstant(getLoc(), idxTy, lb - 1)); + extents.push_back(builder.createIntegerConstant(getLoc(), idxTy, extent)); + } if constexpr (TC == Fortran::common::TypeCategory::Character) { fir::SequenceType::Shape shape; shape.push_back(con.LEN()); @@ -810,7 +800,6 @@ class ExprLowering { auto chTy = converter.genType(Fortran::common::TypeCategory::Character, KIND); auto arrayTy = fir::SequenceType::get(shape, chTy); - auto idxTy = builder.getIntegerType(32); mlir::Value array = builder.create(getLoc(), arrayTy); Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); do { @@ -832,14 +821,13 @@ class ExprLowering { charVal, idx); } } while (con.IncrementSubscripts(subscripts)); - // FIXME: return an ArrayBoxValue - return array; + auto len = builder.createIntegerConstant(getLoc(), idxTy, con.LEN()); + return fir::CharArrayBoxValue{array, len, extents, lbounds}; } else { // Convert Ev::ConstantSubs to SequenceType::Shape fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end()); auto eleTy = converter.genType(TC, KIND); auto arrayTy = fir::SequenceType::get(shape, eleTy); - auto idxTy = builder.getIndexType(); mlir::Value array = builder.create(getLoc(), arrayTy); Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); do { @@ -856,8 +844,7 @@ class ExprLowering { array = builder.create(getLoc(), arrayTy, array, insVal, idx); } while (con.IncrementSubscripts(subscripts)); - // FIXME: return an ArrayBoxValue - return array; + return fir::ArrayBoxValue{array, extents, lbounds}; } } @@ -896,7 +883,9 @@ class ExprLowering { } fir::ExtendedValue gen(const Fortran::evaluate::ComplexPart &) { TODO(""); } - fir::ExtendedValue genval(const Fortran::evaluate::ComplexPart &) { TODO(""); } + fir::ExtendedValue genval(const Fortran::evaluate::ComplexPart &) { + TODO(""); + } /// Reference to a substring. fir::ExtendedValue gen(const Fortran::evaluate::Substring &s) { @@ -917,10 +906,18 @@ class ExprLowering { assert(upper && "boxed value not handled"); bounds.push_back(upper); } - // FIXME: a string should be a CharBoxValue - auto addr = fir::getBase(baseString); - return Fortran::lower::CharacterExprHelper{builder, getLoc()} - .createSubstring(addr, bounds); + Fortran::lower::CharacterExprHelper charHelper{builder, getLoc()}; + return baseString.match( + [&](const fir::CharBoxValue &x) -> fir::ExtendedValue { + return charHelper.createSubstring(x, bounds); + }, + [&](const fir::CharArrayBoxValue &) -> fir::ExtendedValue { + // TODO: substring array + TODO("array substring lowering"); + }, + [&](const auto &) -> fir::ExtendedValue { + llvm::report_fatal_error("substring base is not a CharBox"); + }); } /// The value of a substring. @@ -1253,7 +1250,13 @@ class ExprLowering { } auto ty = genSubType(base.getType(), args.size()); ty = builder.getRefType(ty); - return builder.create(loc, ty, base, args); + auto addr = builder.create(loc, ty, base, args); + // FIXME: return may not be a scalar. + return box.match( + [&](const fir::CharArrayBoxValue &x) -> fir::ExtendedValue { + return fir::CharBoxValue{addr, x.getLen()}; + }, + [&](const auto &) -> fir::ExtendedValue { return addr; }); } return genArrayRefComponent(aref); } @@ -1297,14 +1300,18 @@ class ExprLowering { template fir::ExtendedValue gen(const Fortran::evaluate::FunctionRef &func) { + // FIXME: I find this very redudant to genref>. + // Why do we need this ?? if (!func.GetType().has_value()) mlir::emitError(getLoc(), "internal: a function must have a type"); auto resTy = genType(*func.GetType()); auto retVal = genProcedureRef(func, llvm::ArrayRef{resTy}); - auto casted = builder.createConvert(getLoc(), resTy, fir::getBase(retVal)); - auto mem = builder.create(getLoc(), resTy); - builder.create(getLoc(), casted, mem); - return mem.getResult(); + auto retValBase = fir::getBase(retVal); + if (fir::isa_ref_type(retValBase.getType())) + return retVal; + auto mem = builder.create(getLoc(), retValBase.getType()); + builder.create(getLoc(), retValBase, mem); + return fir::substBase(retVal, mem.getResult()); } /// Generate a call to an intrinsic function. @@ -1405,78 +1412,70 @@ class ExprLowering { for (const auto &arg : caller.getPassedArguments()) { const auto *actual = arg.entity; if (!actual) - TODO(""); // optional arguments + TODO("optional argument lowering"); const auto *expr = actual->UnwrapExpr(); if (!expr) - TODO(""); // assumed type arguments - - mlir::Value argRef; - mlir::Value argVal; - if (const auto *argSymbol = - Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr)) { - argVal = symMap.lookupSymbol(*argSymbol); - } else { - auto exv = genExtAddr(*expr); - // FIXME: should use the box values, etc. - argVal = fir::getBase(exv); - } - auto type = argVal.getType(); - if (fir::isa_passbyref_type(type) || type.isa()) { - argRef = argVal; - argVal = {}; - } - assert((argVal || argRef) && "needs value or address"); + TODO("assumed type actual argument lowering"); - // Handle cases where the argument must be passed by value if (arg.passBy == PassBy::Value) { + auto *argVal = genExtValue(*expr).getUnboxed(); if (!argVal) - argVal = genLoad(argRef); - caller.placeInput(arg, argVal); + mlir::emitError( + getLoc(), + "Lowering internal error: passing non trivial value by by value"); + else + caller.placeInput(arg, *argVal); continue; } - // From this point, arguments needs to be in memory. - if (!argRef) { - // expression is a value, so store it in a temporary so we can - // pass-by-reference - argRef = builder.createTemporary(getLoc(), argVal.getType()); - builder.create(getLoc(), argVal, argRef); - } + auto argRef = genExtAddr(*expr); + + auto helper = Fortran::lower::CharacterExprHelper{builder, getLoc()}; if (arg.passBy == PassBy::BaseAddress) { - caller.placeInput(arg, argRef); + caller.placeInput(arg, fir::getBase(argRef)); } else if (arg.passBy == PassBy::BoxChar) { - auto boxChar = argRef; - if (!boxChar.getType().isa()) { - Fortran::lower::CharacterExprHelper helper{builder, getLoc()}; - auto ch = helper.materializeCharacterOrSequence(boxChar); - boxChar = helper.createEmboxChar(ch.first, ch.second); - } + auto boxChar = argRef.match( + [&](const fir::CharBoxValue &x) { return helper.createEmbox(x); }, + [&](const fir::CharArrayBoxValue &x) { + return helper.createEmbox(x); + }, + [&](const fir::BoxValue &x) -> mlir::Value { + // Beware, descriptor content might have to be copied before + // and after the call to a contiguous character argument. + TODO("lowering actual arguments descriptor to boxchar"); + }, + [&](const auto &x) { + mlir::emitError(getLoc(), "Lowering internal error: actual " + "argument is not a character"); + return mlir::Value{}; + }); caller.placeInput(arg, boxChar); } else if (arg.passBy == PassBy::Box) { - TODO(""); // generate emboxing if need. + TODO("passing descriptor in call"); // generate emboxing if need. } else if (arg.passBy == PassBy::AddressAndLength) { - Fortran::lower::CharacterExprHelper helper{builder, getLoc()}; - auto ch = helper.materializeCharacter(argRef); - caller.placeAddressAndLengthInput(arg, ch.first, ch.second); + caller.placeAddressAndLengthInput(arg, fir::getBase(argRef), + fir::getLen(argRef)); } else { llvm_unreachable("pass by value not handled here"); } } // Handle case where caller must pass result - mlir::Value resRef; - if (auto resultArg = caller.getPassedResult()) { - if (resultArg->passBy == PassBy::AddressAndLength) { - // allocate and pass character result - auto len = caller.getResultLength(); - Fortran::lower::CharacterExprHelper helper{builder, getLoc()}; - resRef = helper.createCharacterTemp(resultType[0], len); - auto ch = helper.createUnboxChar(resRef); - caller.placeAddressAndLengthInput(*resultArg, ch.first, ch.second); - } else { - TODO(""); // Pass descriptor + auto resRef = [&]() -> llvm::Optional { + if (auto resultArg = caller.getPassedResult()) { + if (resultArg->passBy == PassBy::AddressAndLength) { + // allocate and pass character result + auto len = caller.getResultLength(); + Fortran::lower::CharacterExprHelper helper{builder, getLoc()}; + auto temp = helper.createCharacterTemp(resultType[0], len); + caller.placeAddressAndLengthInput(*resultArg, temp.getBuffer(), + temp.getLen()); + return fir::ExtendedValue(temp); + } + TODO("passing hidden descriptor for result"); // Pass descriptor } - } + return {}; + }(); // In older Fortran, procedure argument types are inferred. This may lead // different view of what the function signature is in different locations. @@ -1488,7 +1487,7 @@ class ExprLowering { mlir::Value funcPointer; mlir::SymbolRefAttr funcSymbolAttr; if (const auto *sym = caller.getIfIndirectCallSymbol()) { - funcPointer = symMap.lookupSymbol(*sym); + funcPointer = symMap.lookupSymbol(*sym).getAddr(); assert(funcPointer && "dummy procedure or procedure pointer not in symbol map"); } else { @@ -1526,8 +1525,9 @@ class ExprLowering { auto call = builder.create(getLoc(), caller.getResultType(), funcSymbolAttr, operands); // Handle case where result was passed as argument - if (caller.getPassedResult()) - return resRef; + if (caller.getPassedResult()) { + return resRef.getValue(); + } if (resultType.size() == 0) return mlir::Value{}; // subroutine call // For now, Fortran returned values are implemented with a single MLIR @@ -1594,16 +1594,18 @@ class ExprLowering { if constexpr (inRefSet>) { return gen(a); } else { - auto val = fir::getBase(genval(a)); + auto exv = genval(a); + auto valBase = fir::getBase(exv); // Functions are always referent. - if (val.getType().template isa() || - fir::isa_ref_type(val.getType())) - return val; + if (valBase.getType().template isa() || + fir::isa_ref_type(valBase.getType())) + return exv; + // Since `a` is not itself a valid referent, determine its value and // create a temporary location for referencing. - auto mem = builder.create(getLoc(), val.getType()); - builder.create(getLoc(), val, mem); - return mem.getResult(); + auto mem = builder.create(getLoc(), valBase.getType()); + builder.create(getLoc(), valBase, mem); + return fir::substBase(exv, mem.getResult()); } } diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp index 553999be8c527..eb805b2edb350 100644 --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -7,6 +7,8 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/ConvertType.h" +#include "flang/Evaluate/fold.h" +#include "flang/Evaluate/shape.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Todo.h" #include "flang/Lower/Utils.h" @@ -464,6 +466,64 @@ class TypeBuilder { const Fortran::common::IntrinsicTypeDefaultKinds &defaults; }; +/// NewTypeBuilder simplifies the expression type conversion by operating +/// on evaluate::DynamicType and evaluate::Shape instead of going down the +/// expression tree. It fixes the fact that genType("array") would +/// return the scalar type and crash code using the result to dispatch between +/// scalar and array handling. +/// TODO: replace the previous expression type conversion with it or fix the +/// current one (The old one is still used for DataRef and Designator). +struct NewTypeBuilder { + + mlir::Type gen(const Fortran::lower::SomeExpr &expr) { + auto dynamicType = expr.GetType(); + if (!dynamicType) + llvm::report_fatal_error("lowering typeless expression type"); + auto category = dynamicType->category(); + if (category == Fortran::common::TypeCategory::Derived) + TODO("derived types lowering"); + auto shapeExpr = Fortran::evaluate::GetShape(foldingContext, expr); + if (!shapeExpr) + TODO("implied shape expression type lowering"); + + auto baseType = TypeBuilder{context, foldingContext.defaults()}.genFIRTy( + category, dynamicType->kind()); + if (category == Fortran::common::TypeCategory::Character) { + auto len = fir::SequenceType::getUnknownExtent(); + if (auto constantLen = toInt64(dynamicType->GetCharLength())) + len = *constantLen; + fir::SequenceType::Shape shape{len}; + translateShape(shape, std::move(*shapeExpr)); + return fir::SequenceType::get(shape, baseType); + } + // LOGICAL, INTEGER, REAL, COMPLEX + fir::SequenceType::Shape shape{}; + translateShape(shape, std::move(*shapeExpr)); + if (!shape.empty()) + return fir::SequenceType::get(shape, baseType); + return baseType; + } + + template + void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) { + for (auto extentExpr : shapeExpr) { + auto extent = fir::SequenceType::getUnknownExtent(); + if (auto constantExtent = toInt64(std::move(extentExpr))) + extent = *constantExtent; + shape.push_back(extent); + } + } + + template + std::optional toInt64(A &&expr) { + return Fortran::evaluate::ToInt64( + Fortran::evaluate::Fold(foldingContext, std::move(expr))); + } + + mlir::MLIRContext *context; + Fortran::evaluate::FoldingContext &foldingContext; +}; + } // namespace mlir::Type Fortran::lower::getFIRType( @@ -488,10 +548,9 @@ mlir::Type Fortran::lower::translateDataRefToFIRType( } mlir::Type Fortran::lower::translateSomeExprToFIRType( - mlir::MLIRContext *context, - const Fortran::common::IntrinsicTypeDefaultKinds &defaults, + mlir::MLIRContext *context, Fortran::evaluate::FoldingContext &foldingCtx, const SomeExpr *expr) { - return TypeBuilder{context, defaults}.gen(*expr); + return NewTypeBuilder{context, foldingCtx}.gen(*expr); } mlir::Type Fortran::lower::translateSymbolToFIRType( diff --git a/flang/lib/Lower/SymbolMap.h b/flang/lib/Lower/SymbolMap.h index 8bf591d4e20d9..75a729d5b1f44 100644 --- a/flang/lib/Lower/SymbolMap.h +++ b/flang/lib/Lower/SymbolMap.h @@ -70,10 +70,6 @@ struct SymbolBox : public fir::details::matcher { operator bool() const { return !std::holds_alternative(box); } - // This operator returns the address of the boxed value. TODO: consider - // eliminating this in favor of explicit conversion. - operator mlir::Value() const { return getAddr(); } - //===--------------------------------------------------------------------===// // Accessors //===--------------------------------------------------------------------===// diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index 4c3ce15cb39cc..d50cc8580d9e3 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -1,39 +1,31 @@ ! RUN: bbc %s -o - -emit-fir | FileCheck %s -! RUN: bbc %s -o - | FileCheck --check-prefix=UNBOX %s ! Simple character assignment tests -! UNBOX-LABEL: assign1 ! CHECK-LABEL: assign1 subroutine assign1(lhs, rhs) character(*, 1) :: lhs, rhs + ! CHECK-DAG: %[[lhs:.*]]:2 = fir.unboxchar %arg0 + ! CHECK-DAG: %[[rhs:.*]]:2 = fir.unboxchar %arg1 lhs = rhs ! Compute minimum length - ! UNBOX-DAG: %[[lhs:.*]]:2 = fir.unboxchar %arg0 - ! UNBOX-DAG: %[[rhs:.*]]:2 = fir.unboxchar %arg1 - ! UNBOX: %[[cmp_len:[0-9]+]] = cmpi "slt", %[[lhs]]#1, %[[rhs]]#1 - ! UNBOX-NEXT: %[[min_len:[0-9]+]] = select %[[cmp_len]], %[[lhs]]#1, %[[rhs]]#1 - ! CHECK: %[[cmp_len:[0-9]+]] = cmpi "slt", %[[lhs:.*]]#1, %[[rhs:.*]]#1 ! CHECK-NEXT: %[[min_len:[0-9]+]] = select %[[cmp_len]], %[[lhs]]#1, %[[rhs]]#1 ! Allocate temp in case rhs and lhs may overlap - ! CHECK: %[[tmp:.*]] = fir.alloca !fir.char<1>, %[[min_len]] + ! CHECK: %[[tmp:.*]] = fir.alloca !fir.array>, %[[min_len]] ! Copy of rhs into temp ! CHECK: fir.do_loop %[[i:.*]] = ! CHECK: %[[rhs_addr2:.*]] = fir.convert %{{[0-9]+}}#0 ! CHECK-DAG: %[[rhs_addr:.*]] = fir.coordinate_of %[[rhs_addr2]], %[[i]] ! CHECK-DAG: %[[rhs_elt:.*]] = fir.load %[[rhs_addr]] - ! CHECK-DAG: %[[tmp2:.*]] = fir.convert %[[tmp]] - ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp2]], %[[i]] + ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[i]] ! CHECK: fir.store %[[rhs_elt]] to %[[tmp_addr]] ! CHECK-NEXT: } - ! CHECK: %[[lhs:.*]]:2 = fir.unboxchar %arg0 ! Copy of temp into lhs ! CHECK: fir.do_loop %[[ii:.*]] = - ! CHECK: %[[tmp2:.*]] = fir.convert %[[tmp]] - ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp2]], %[[ii]] + ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[ii]] ! CHECK-DAG: %[[tmp_elt:.*]] = fir.load %[[tmp_addr]] ! CHECK-DAG: %[[lhs_addr2:.*]] = fir.convert %[[lhs]]#0 ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs_addr2]], %[[ii]] @@ -41,7 +33,6 @@ subroutine assign1(lhs, rhs) ! CHECK-NEXT: } ! Padding - ! CHECK-DAG: %[[lhs:.*]]:2 = fir.unboxchar %arg0 ! CHECK-DAG: %[[c32:.*]] = constant 32 : i8 ! CHECK-DAG: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> ! CHECK: fir.do_loop %[[ij:.*]] = @@ -59,7 +50,7 @@ subroutine assign_substring1(str, rhs, lb, ub) str(lb:ub) = rhs ! CHECK-DAG: %[[lb:.*]] = fir.load %arg2 ! CHECK-DAG: %[[ub:.*]] = fir.load %arg3 - ! CHECK: %[[str:.*]]:2 = fir.unboxchar %arg0 + ! CHECK-DAG: %[[str:.*]]:2 = fir.unboxchar %arg0 ! Compute substring offset ! CHECK-DAG: %[[lbi:.*]] = fir.convert %[[lb]] : (i64) -> index @@ -85,32 +76,26 @@ subroutine assign_substring1(str, rhs, lb, ub) ! ... end subroutine -! UNBOX-LABEL: assign_constant ! CHECK-LABEL: assign_constant ! CHECK: (%[[ARG:.*]]:{{.*}}) subroutine assign_constant(lhs) character(*, 1) :: lhs - ! UNBOX: %[[lhs:.*]]:2 = fir.unboxchar %arg0 - ! CHECK-DAG: %[[tmp:.*]] = fir.address_of(@{{.*}}) : + ! CHECK: %[[lhs:.*]]:2 = fir.unboxchar %arg0 + ! CHECK: %[[cst:.*]] = fir.address_of(@{{.*}}) : + ! CHECK: %[[tmp]] = fir.alloca !fir.array>, %{{.*}} lhs = "Hello World" ! CHECK: fir.do_loop %[[i:.*]] = %{{.*}} to %{{.*}} { - ! CHECK: %[[tmp2:.*]] = fir.convert %[[tmp]] - ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp2]], %[[i]] - ! CHECK-DAG: %[[tmp_elt:.*]] = fir.load %[[tmp_addr]] - ! UNBOX: %[[lhs2:.*]] = fir.convert %[[lhs]]#0 - ! UNBOX: = fir.coordinate_of %[[lhs2]], % - ! CHECK-DAG: %[[lhs_addr2:.*]] = fir.convert %[[lhs:.*]]#0 - ! CHECK: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs_addr2:.*]], %[[i]] - ! CHECK: fir.store %[[tmp_elt]] to %[[lhs_addr]] + ! CHECK: %[[cst2:.*]] = fir.convert %[[cst]] + ! CHECK-DAG: %[[cst_addr:.*]] = fir.coordinate_of %[[cst2]], %[[i]] + ! CHECK-DAG: %[[cst_elt:.*]] = fir.load %[[cst_addr]] + ! CHECK: %[[lhs_addr:.*]] = fir.coordinate_of %[[tmp:.*]], %[[i]] + ! CHECK: fir.store %[[cst_elt]] to %[[lhs_addr]] ! CHECK: } ! Padding - ! CHECK-DAG: %[[lhs:.*]]:2 = fir.unboxchar %arg0 ! CHECK-DAG: %[[c32:.*]] = constant 32 : i8 ! CHECK-DAG: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> ! CHECK: fir.do_loop %[[j:.*]] = %{{.*}} to %{{.*}} { - ! UNBOX: %[[lhs2:.*]] = fir.convert %[[lhs]]#0 - ! UNBOX: = fir.coordinate_of %[[lhs2]], % ! CHECK: %[[jhs_addr2:.*]] = fir.convert %[[lhs]]#0 ! CHECK: %[[jhs_addr:.*]] = fir.coordinate_of %[[jhs_addr2]], %[[j]] ! CHECK: fir.store %[[blank]] to %[[jhs_addr]] diff --git a/flang/test/Lower/concat.f90 b/flang/test/Lower/concat.f90 index 290c4ef1de1a2..ee05ad636acb0 100644 --- a/flang/test/Lower/concat.f90 +++ b/flang/test/Lower/concat.f90 @@ -4,16 +4,16 @@ ! CHECK-LABEL: concat_1 subroutine concat_1(a, b) - character(*) :: a, b - ! CHECK: call @{{.*}}BeginExternalListOutput ! CHECK-DAG: %[[a:.*]]:2 = fir.unboxchar %arg0 ! CHECK-DAG: %[[b:.*]]:2 = fir.unboxchar %arg1 + character(*) :: a, b + ! CHECK: call @{{.*}}BeginExternalListOutput print *, a // b ! Concatenation ! CHECK: %[[len:.*]] = addi %[[a]]#1, %[[b]]#1 - ! CHECK: %[[temp:.*]] = fir.alloca !fir.char<1>, %[[len]] + ! CHECK: %[[temp:.*]] = fir.alloca !fir.array>, %[[len]] ! CHECK-DAG: %[[c0:.*]] = constant 0 ! CHECK-DAG: %[[c1:.*]] = constant 1 @@ -22,8 +22,7 @@ subroutine concat_1(a, b) ! CHECK: %[[a_addr2:.*]] = fir.convert %[[a]]#0 ! CHECK: %[[a_addr:.*]] = fir.coordinate_of %[[a_addr2]], %[[index]] ! CHECK-DAG: %[[a_elt:.*]] = fir.load %[[a_addr]] - ! CHECK-DAG: %[[temp2:.*]] = fir.convert %[[temp]] - ! CHECK: %[[temp_addr:.*]] = fir.coordinate_of %[[temp2]], %[[index]] + ! CHECK: %[[temp_addr:.*]] = fir.coordinate_of %[[temp]], %[[index]] ! CHECK: fir.store %[[a_elt]] to %[[temp_addr]] ! CHECK: } @@ -34,8 +33,7 @@ subroutine concat_1(a, b) ! CHECK: %[[b_addr2:.*]] = fir.convert %[[b]]#0 ! CHECK: %[[b_addr:.*]] = fir.coordinate_of %[[b_addr2]], %[[b_index]] ! CHECK-DAG: %[[b_elt:.*]] = fir.load %[[b_addr]] - ! CHECK-DAG: %[[temp2:.*]] = fir.convert %[[temp]] - ! CHECK: %[[temp_addr2:.*]] = fir.coordinate_of %[[temp2]], %[[index2]] + ! CHECK: %[[temp_addr2:.*]] = fir.coordinate_of %[[temp]], %[[index2]] ! CHECK: fir.store %[[b_elt]] to %[[temp_addr2]] ! CHECK: } diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index 52390b280e55f..54923c460a5cd 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -212,7 +212,9 @@ end subroutine ior_test subroutine len_test(i, c) integer :: i character(*) :: c - ! CHECK: fir.boxchar_len + ! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 + ! CHECK: %[[x:.*]] = fir.convert %[[c]]#1 : (index) -> i32 + ! CHECK: fir.store %[[x]] to %arg0 i = len(c) end subroutine From bbebafcd1a79dd03c788e24fa70c6ee9ccc5d13c Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 22 Sep 2020 16:12:03 -0700 Subject: [PATCH 0291/1017] Factor symbol analysis in the bridge from how it is used. Use the `auto [x,y]` syntax where the compiler accepts it. review comments fixes for merge conflicts --- flang/include/flang/Lower/Support/BoxValue.h | 1 - .../flang/Optimizer/Support/InternalNames.h | 3 +- flang/lib/Lower/BoxAnalyzer.h | 489 +++++++++++ flang/lib/Lower/Bridge.cpp | 762 +++++++++++------- flang/lib/Lower/CallInterface.cpp | 12 +- flang/lib/Lower/ConvertExpr.cpp | 40 +- flang/lib/Lower/FIRBuilder.cpp | 8 +- flang/lib/Lower/Runtime.cpp | 9 +- 8 files changed, 995 insertions(+), 329 deletions(-) create mode 100644 flang/lib/Lower/BoxAnalyzer.h diff --git a/flang/include/flang/Lower/Support/BoxValue.h b/flang/include/flang/Lower/Support/BoxValue.h index 8f56311387a18..edb8fb3454029 100644 --- a/flang/include/flang/Lower/Support/BoxValue.h +++ b/flang/include/flang/Lower/Support/BoxValue.h @@ -20,7 +20,6 @@ #include "llvm/Support/Compiler.h" #include "llvm/Support/raw_ostream.h" #include -#include namespace fir { class CharBoxValue; diff --git a/flang/include/flang/Optimizer/Support/InternalNames.h b/flang/include/flang/Optimizer/Support/InternalNames.h index fa98cc2a8e490..3a34cbcbedfb6 100644 --- a/flang/include/flang/Optimizer/Support/InternalNames.h +++ b/flang/include/flang/Optimizer/Support/InternalNames.h @@ -41,7 +41,8 @@ struct NameUniquer { INTRINSIC_TYPE_DESC, PROCEDURE, TYPE_DESC, - VARIABLE + VARIABLE, + BLOCK_DATA_NAME }; /// Components of an unparsed unique name diff --git a/flang/lib/Lower/BoxAnalyzer.h b/flang/lib/Lower/BoxAnalyzer.h new file mode 100644 index 0000000000000..05a5624f95b57 --- /dev/null +++ b/flang/lib/Lower/BoxAnalyzer.h @@ -0,0 +1,489 @@ +//===-- BoxAnalyzer.h -------------------------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_BOXANALYZER_H +#define FORTRAN_LOWER_BOXANALYZER_H + +#include "flang/Evaluate/fold.h" +#include "flang/Evaluate/tools.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/Matcher.h" +#include "flang/Semantics/symbol.h" + +namespace Fortran::lower { + +//===----------------------------------------------------------------------===// +// Classifications of a symbol. +// +// Each classification is a distinct class and can be used in pattern matching. +//===----------------------------------------------------------------------===// + +namespace details { + +using FromBox = std::monostate; + +/// Base class for all box analysis results. +struct ScalarSym { + ScalarSym(const Fortran::semantics::Symbol &sym) : sym{&sym} {} + ScalarSym &operator=(const ScalarSym &) = default; + + const Fortran::semantics::Symbol &symbol() const { return *sym; } + + static constexpr bool staticSize() { return true; } + static constexpr bool isChar() { return false; } + static constexpr bool isArray() { return false; } + +private: + const Fortran::semantics::Symbol *sym; +}; + +/// Scalar of dependent type CHARACTER, constant LEN. +struct ScalarStaticChar : ScalarSym { + ScalarStaticChar(const Fortran::semantics::Symbol &sym, int64_t len) + : ScalarSym{sym}, len{len} {} + + int64_t charLen() const { return len; } + + static constexpr bool isChar() { return true; } + +private: + int64_t len; +}; + +/// Scalar of dependent type Derived, constant LEN(s). +struct ScalarStaticDerived : ScalarSym { + ScalarStaticDerived(const Fortran::semantics::Symbol &sym, + llvm::SmallVectorImpl &&lens) + : ScalarSym{sym}, lens{std::move(lens)} {} + +private: + llvm::SmallVector lens; +}; + +/// Scalar of dependent type CHARACTER, dynamic LEN. +struct ScalarDynamicChar : ScalarSym { + ScalarDynamicChar(const Fortran::semantics::Symbol &sym, + const Fortran::semantics::SomeExpr &len) + : ScalarSym{sym}, len{len} {} + ScalarDynamicChar(const Fortran::semantics::Symbol &sym) + : ScalarSym{sym}, len{FromBox{}} {} + + llvm::Optional charLen() const { + if (auto *l = std::get_if(&len)) + return {*l}; + return llvm::None; + } + + static constexpr bool staticSize() { return false; } + static constexpr bool isChar() { return true; } + +private: + std::variant len; +}; + +/// Scalar of dependent type Derived, dynamic LEN(s). +struct ScalarDynamicDerived : ScalarSym { + ScalarDynamicDerived( + const Fortran::semantics::Symbol &sym, + llvm::SmallVectorImpl &&lens) + : ScalarSym{sym}, lens{std::move(lens)} {} + +private: + llvm::SmallVector lens; +}; + +struct LBoundsAndShape { + LBoundsAndShape(llvm::SmallVectorImpl &&lbounds, + llvm::SmallVectorImpl &&shapes) + : lbounds{std::move(lbounds)}, shapes{std::move(shapes)} {} + + static constexpr bool staticSize() { return true; } + static constexpr bool isArray() { return true; } + bool lboundAllOnes() const { + return llvm::all_of(lbounds, [](int64_t v) { return v == 1; }); + } + + llvm::SmallVector lbounds; + llvm::SmallVector shapes; +}; + +/// Array of T with statically known origin (lbounds) and shape. +struct StaticArray : ScalarSym, LBoundsAndShape { + StaticArray(const Fortran::semantics::Symbol &sym, + llvm::SmallVectorImpl &&lbounds, + llvm::SmallVectorImpl &&shapes) + : ScalarSym{sym}, LBoundsAndShape{std::move(lbounds), std::move(shapes)} { + } + + static constexpr bool staticSize() { return LBoundsAndShape::staticSize(); } +}; + +struct DynamicBound { + DynamicBound( + llvm::SmallVectorImpl &&bounds) + : bounds{std::move(bounds)} {} + + static constexpr bool staticSize() { return false; } + static constexpr bool isArray() { return true; } + bool lboundAllOnes() const { + return llvm::all_of(bounds, [](const Fortran::semantics::ShapeSpec *p) { + if (auto low = p->lbound().GetExplicit()) + if (auto lb = Fortran::evaluate::ToInt64(*low)) + return *lb == 1; + return false; + }); + } + + llvm::SmallVector bounds; +}; + +/// Array of T with dynamic origin and/or shape. +struct DynamicArray : ScalarSym, DynamicBound { + DynamicArray( + const Fortran::semantics::Symbol &sym, + llvm::SmallVectorImpl &&bounds) + : ScalarSym{sym}, DynamicBound{std::move(bounds)} {} + + static constexpr bool staticSize() { return DynamicBound::staticSize(); } +}; + +/// Array of CHARACTER with statically known LEN, origin, and shape. +struct StaticArrayStaticChar : ScalarStaticChar, LBoundsAndShape { + StaticArrayStaticChar(const Fortran::semantics::Symbol &sym, int64_t len, + llvm::SmallVectorImpl &&lbounds, + llvm::SmallVectorImpl &&shapes) + : ScalarStaticChar{sym, len}, LBoundsAndShape{std::move(lbounds), + std::move(shapes)} {} + + static constexpr bool staticSize() { + return ScalarStaticChar::staticSize() && LBoundsAndShape::staticSize(); + } +}; + +/// Array of CHARACTER with dynamic LEN but constant origin, shape. +struct StaticArrayDynamicChar : ScalarDynamicChar, LBoundsAndShape { + StaticArrayDynamicChar(const Fortran::semantics::Symbol &sym, + const Fortran::semantics::SomeExpr &len, + llvm::SmallVectorImpl &&lbounds, + llvm::SmallVectorImpl &&shapes) + : ScalarDynamicChar{sym, len}, LBoundsAndShape{std::move(lbounds), + std::move(shapes)} {} + StaticArrayDynamicChar(const Fortran::semantics::Symbol &sym, + llvm::SmallVectorImpl &&lbounds, + llvm::SmallVectorImpl &&shapes) + : ScalarDynamicChar{sym}, LBoundsAndShape{std::move(lbounds), + std::move(shapes)} {} + + static constexpr bool staticSize() { + return ScalarDynamicChar::staticSize() && LBoundsAndShape::staticSize(); + } +}; + +/// Array of CHARACTER with constant LEN but dynamic origin, shape. +struct DynamicArrayStaticChar : ScalarStaticChar, DynamicBound { + DynamicArrayStaticChar( + const Fortran::semantics::Symbol &sym, int64_t len, + llvm::SmallVectorImpl &&bounds) + : ScalarStaticChar{sym, len}, DynamicBound{std::move(bounds)} {} + + static constexpr bool staticSize() { + return ScalarStaticChar::staticSize() && DynamicBound::staticSize(); + } +}; + +/// Array of CHARACTER with dynamic LEN, origin, and shape. +struct DynamicArrayDynamicChar : ScalarDynamicChar, DynamicBound { + DynamicArrayDynamicChar( + const Fortran::semantics::Symbol &sym, + const Fortran::semantics::SomeExpr &len, + llvm::SmallVectorImpl &&bounds) + : ScalarDynamicChar{sym, len}, DynamicBound{std::move(bounds)} {} + DynamicArrayDynamicChar( + const Fortran::semantics::Symbol &sym, + llvm::SmallVectorImpl &&bounds) + : ScalarDynamicChar{sym}, DynamicBound{std::move(bounds)} {} + + static constexpr bool staticSize() { + return ScalarDynamicChar::staticSize() && DynamicBound::staticSize(); + } +}; + +// TODO: Arrays of derived types with LEN(s)... + +} // namespace details + +inline bool symIsChar(const Fortran::semantics::Symbol &sym) { + return sym.GetType()->category() == + Fortran::semantics::DeclTypeSpec::Character; +} + +inline bool symIsArray(const Fortran::semantics::Symbol &sym) { + const auto *det = sym.detailsIf(); + return det && det->IsArray(); +} + +inline bool isExplicitShape(const Fortran::semantics::Symbol &sym) { + const auto *det = sym.detailsIf(); + return det && det->IsArray() && det->shape().IsExplicitShape(); +} + +//===----------------------------------------------------------------------===// +// Perform analysis to determine a box's parameter values +//===----------------------------------------------------------------------===// + +/// Analyze a symbol, classify it as to whether it just a scalar, a CHARACTER +/// scalar, an array entity, a combination thereof, and whether the LEN, shape, +/// and lbounds are constant or not. +class BoxAnalyzer : public fir::details::matcher { +public: + // Analysis default state + using None = std::monostate; + + using ScalarSym = details::ScalarSym; + using ScalarStaticChar = details::ScalarStaticChar; + using ScalarDynamicChar = details::ScalarDynamicChar; + using StaticArray = details::StaticArray; + using DynamicArray = details::DynamicArray; + using StaticArrayStaticChar = details::StaticArrayStaticChar; + using StaticArrayDynamicChar = details::StaticArrayDynamicChar; + using DynamicArrayStaticChar = details::DynamicArrayStaticChar; + using DynamicArrayDynamicChar = details::DynamicArrayDynamicChar; + // TODO: derived types + + using VT = std::variant; + + //===--------------------------------------------------------------------===// + // Constructor + //===--------------------------------------------------------------------===// + + BoxAnalyzer() : box{None{}} {} + + operator bool() const { return !std::holds_alternative(box); } + + bool isTrivial() const { return std::holds_alternative(box); } + + /// Returns true for any sort of CHARACTER. + bool isChar() const { + return match([](const ScalarStaticChar &) { return true; }, + [](const ScalarDynamicChar &) { return true; }, + [](const StaticArrayStaticChar &) { return true; }, + [](const StaticArrayDynamicChar &) { return true; }, + [](const DynamicArrayStaticChar &) { return true; }, + [](const DynamicArrayDynamicChar &) { return true; }, + [](const auto &) { return false; }); + } + + /// Returns true for any sort of array. + bool isArray() const { + return match([](const StaticArray &) { return true; }, + [](const DynamicArray &) { return true; }, + [](const StaticArrayStaticChar &) { return true; }, + [](const StaticArrayDynamicChar &) { return true; }, + [](const DynamicArrayStaticChar &) { return true; }, + [](const DynamicArrayDynamicChar &) { return true; }, + [](const auto &) { return false; }); + } + + /// Returns true iff this is an array with constant extents and lbounds. This + /// returns true for arrays of CHARACTER, even if the LEN is not a constant. + bool isStaticArray() const { + return match([](const StaticArray &) { return true; }, + [](const StaticArrayStaticChar &) { return true; }, + [](const StaticArrayDynamicChar &) { return true; }, + [](const auto &) { return false; }); + } + + bool isConstant() const { + return match( + [](const None &) -> bool { + llvm::report_fatal_error("internal: analysis failed"); + }, + [](const auto &x) { return x.staticSize(); }); + } + + llvm::Optional getCharLenConst() const { + using A = llvm::Optional; + return match( + [](const ScalarStaticChar &x) -> A { return {x.charLen()}; }, + [](const StaticArrayStaticChar &x) -> A { return {x.charLen()}; }, + [](const DynamicArrayStaticChar &x) -> A { return {x.charLen()}; }, + [](const auto &) -> A { return llvm::None; }); + } + + llvm::Optional getCharLenExpr() const { + using A = llvm::Optional; + return match([](const ScalarDynamicChar &x) { return x.charLen(); }, + [](const StaticArrayDynamicChar &x) { return x.charLen(); }, + [](const DynamicArrayDynamicChar &x) { return x.charLen(); }, + [](const auto &) -> A { return llvm::None; }); + } + + /// Is the origin of this array the default of vector of `1`? + bool lboundIsAllOnes() const { + return match( + [&](const StaticArray &x) { return x.lboundAllOnes(); }, + [&](const DynamicArray &x) { return x.lboundAllOnes(); }, + [&](const StaticArrayStaticChar &x) { return x.lboundAllOnes(); }, + [&](const StaticArrayDynamicChar &x) { return x.lboundAllOnes(); }, + [&](const DynamicArrayStaticChar &x) { return x.lboundAllOnes(); }, + [&](const DynamicArrayDynamicChar &x) { return x.lboundAllOnes(); }, + [](const auto &) -> bool { llvm::report_fatal_error("not an array"); }); + } + + /// Get the static lbound values (the origin of the array). + llvm::ArrayRef staticLBound() const { + using A = llvm::ArrayRef; + return match([](const StaticArray &x) -> A { return x.lbounds; }, + [](const StaticArrayStaticChar &x) -> A { return x.lbounds; }, + [](const StaticArrayDynamicChar &x) -> A { return x.lbounds; }, + [](const auto &) -> A { + llvm::report_fatal_error("does not have static lbounds"); + }); + } + + /// Get the static extents of the array. + llvm::ArrayRef staticShape() const { + using A = llvm::ArrayRef; + return match([](const StaticArray &x) -> A { return x.shapes; }, + [](const StaticArrayStaticChar &x) -> A { return x.shapes; }, + [](const StaticArrayDynamicChar &x) -> A { return x.shapes; }, + [](const auto &) -> A { + llvm::report_fatal_error("does not have static shape"); + }); + } + + /// Get the dynamic bounds information of the array (both origin, shape). + llvm::ArrayRef dynamicBound() const { + using A = llvm::ArrayRef; + return match([](const DynamicArray &x) -> A { return x.bounds; }, + [](const DynamicArrayStaticChar &x) -> A { return x.bounds; }, + [](const DynamicArrayDynamicChar &x) -> A { return x.bounds; }, + [](const auto &) -> A { + llvm::report_fatal_error("does not have bounds"); + }); + } + + /// Run the analysis on `sym`. + void analyze(const Fortran::semantics::Symbol &sym) { + if (symIsArray(sym)) { + auto isConstant = true; + llvm::SmallVector lbounds; + llvm::SmallVector shapes; + llvm::SmallVector bounds; + for (const auto &subs : getSymShape(sym)) { + bounds.push_back(&subs); + if (!isConstant) + continue; + if (auto low = subs.lbound().GetExplicit()) { + if (auto lb = Fortran::evaluate::ToInt64(*low)) { + lbounds.push_back(*lb); // origin for this dim + if (auto high = subs.ubound().GetExplicit()) { + if (auto ub = Fortran::evaluate::ToInt64(*high)) { + shapes.push_back(*ub - *lb + 1); // extent for this dim + continue; + } + } else if (subs.ubound().isAssumed()) { + shapes.push_back(fir::SequenceType::getUnknownExtent()); + continue; + } + } + } + isConstant = false; + } + + // sym : array + if (symIsChar(sym)) { + if (auto len = charLenConstant(sym)) { + if (isConstant) + box = StaticArrayStaticChar(sym, *len, std::move(lbounds), + std::move(shapes)); + else + box = DynamicArrayStaticChar(sym, *len, std::move(bounds)); + return; + } + if (auto var = charLenVariable(sym)) { + if (isConstant) + box = StaticArrayDynamicChar(sym, *var, std::move(lbounds), + std::move(shapes)); + else + box = DynamicArrayDynamicChar(sym, *var, std::move(bounds)); + return; + } + if (isConstant) + box = StaticArrayDynamicChar(sym, std::move(lbounds), + std::move(shapes)); + else + box = DynamicArrayDynamicChar(sym, std::move(bounds)); + return; + } + + // sym : array + if (isConstant) + box = StaticArray(sym, std::move(lbounds), std::move(shapes)); + else + box = DynamicArray(sym, std::move(bounds)); + return; + } + + // sym : CHARACTER + if (symIsChar(sym)) { + if (auto len = charLenConstant(sym)) + box = ScalarStaticChar(sym, *len); + else if (auto var = charLenVariable(sym)) + box = ScalarDynamicChar(sym, *var); + else + box = ScalarDynamicChar(sym); + return; + } + + // sym : other + box = ScalarSym(sym); + } + + const VT &matchee() const { return box; } + +private: + // Get the shape of a symbol. + const Fortran::semantics::ArraySpec & + getSymShape(const Fortran::semantics::Symbol &sym) { + return sym.get().shape(); + } + + // Get the constant LEN of a CHARACTER, if it exists. + llvm::Optional + charLenConstant(const Fortran::semantics::Symbol &sym) { + const auto &lenParam = sym.GetType()->characterTypeSpec().length(); + if (auto expr = lenParam.GetExplicit()) + if (auto asInt = Fortran::evaluate::ToInt64( + Fortran::evaluate::AsGenericExpr(std::move(*expr)))) + return {*asInt}; + return llvm::None; + } + + // Get the `SomeExpr` that describes the CHARACTER's LEN. + llvm::Optional + charLenVariable(const Fortran::semantics::Symbol &sym) { + const auto &lenParam = sym.GetType()->characterTypeSpec().length(); + if (auto expr = lenParam.GetExplicit()) + return {Fortran::evaluate::AsGenericExpr(std::move(*expr))}; + return llvm::None; + } + + VT box; +}; // namespace Fortran::lower + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_BOXANALYZER_H diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 989fcf0c75c70..1eebc20edbb4d 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -12,6 +12,7 @@ #include "flang/Lower/Bridge.h" #include "../../runtime/iostat.h" +#include "BoxAnalyzer.h" #include "SymbolMap.h" #include "flang/Lower/CallInterface.h" #include "flang/Lower/CharacterExpr.h" @@ -95,21 +96,6 @@ struct IncrementLoopInfo { }; } // namespace -static bool symIsChar(const Fortran::semantics::Symbol &sym) { - return sym.GetType()->category() == - Fortran::semantics::DeclTypeSpec::Character; -} - -static bool symIsArray(const Fortran::semantics::Symbol &sym) { - const auto *det = sym.detailsIf(); - return det && det->IsArray(); -} - -static bool isExplicitShape(const Fortran::semantics::Symbol &sym) { - const auto *det = sym.detailsIf(); - return det && det->IsArray() && det->shape().IsExplicitShape(); -} - // Retrieve a copy of a character literal string from a SomeExpr. template static llvm::Optional> @@ -149,102 +135,6 @@ getCharacterLiteralCopy(const std::optional &x) { return llvm::None; } -namespace { -struct SymbolBoxAnalyzer { - using FromBox = std::monostate; - - explicit SymbolBoxAnalyzer(const Fortran::semantics::Symbol &sym) - : sym{sym} {} - SymbolBoxAnalyzer() = delete; - SymbolBoxAnalyzer(const SymbolBoxAnalyzer &) = delete; - - /// Run the analysis on the symbol. Used to determine the type of index to - /// save in the symbol map. - void analyze() { - isChar = symIsChar(sym); - if (isChar) { - const auto &lenParam = sym.GetType()->characterTypeSpec().length(); - if (auto expr = lenParam.GetExplicit()) { - auto len = Fortran::evaluate::AsGenericExpr(std::move(*expr)); - auto asInt = Fortran::evaluate::ToInt64(len); - if (asInt) { - charLen = *asInt; - } else { - charLen = len; - staticSize = false; - } - } else { - charLen = FromBox{}; - staticSize = false; - } - } - isArray = symIsArray(sym); - for (const auto &subs : getSymShape()) { - auto low = subs.lbound().GetExplicit(); - auto high = subs.ubound().GetExplicit(); - if (staticSize && low && high) { - auto lb = Fortran::evaluate::ToInt64(*low); - auto ub = Fortran::evaluate::ToInt64(*high); - if (lb && ub) { - staticLBound.push_back(*lb); - staticShape.push_back(*ub - *lb + 1); - continue; - } - } - staticSize = false; - dynamicBound.push_back(&subs); - } - } - - /// Get the shape of an analyzed symbol. - const Fortran::semantics::ArraySpec &getSymShape() { - return sym.get().shape(); - } - - /// Get the CHARACTER's LEN value, if there is one. - llvm::Optional getCharLenConst() { - if (isChar) - if (auto *res = std::get_if(&charLen)) - return {*res}; - return {}; - } - - /// Get the CHARACTER's LEN expression, if there is one. - llvm::Optional getCharLenExpr() { - if (isChar) - if (auto *res = std::get_if(&charLen)) - return {*res}; - return {}; - } - - /// Is it a CHARACTER with a constant LEN? - bool charConstSize() const { - return isChar && std::holds_alternative(charLen); - } - - /// Symbol is neither a CHARACTER nor an array. - bool isTrivial() const { return !(isChar || isArray); } - - /// Return true iff all the lower bound values are the constant 1. - bool lboundIsAllOnes() const { - return staticSize && - llvm::all_of(staticLBound, [](int64_t v) { return v == 1; }); - } - - llvm::SmallVector staticLBound; - llvm::SmallVector staticShape; - llvm::SmallVector dynamicBound; - bool staticSize{true}; - bool isChar{false}; - bool isArray{false}; - -private: - std::variant charLen{ - FromBox{}}; - const Fortran::semantics::Symbol &sym; -}; -} // namespace - //===----------------------------------------------------------------------===// // FirConverter //===----------------------------------------------------------------------===// @@ -1887,7 +1777,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } else if (sym.has()) { llvm_unreachable("COMMON symbol processed elsewhere"); } else { - TODO(""); // Procedure pointer or something else + TODO("global"); // Procedure pointer or something else } } @@ -2027,13 +1917,17 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// which its properties depend will already have been visited. void instantiateLocal(const Fortran::lower::pft::Variable &var, llvm::DenseMap &storeMap) { + assert(!var.isAlias()); + mapSymbolAttributes(var, storeMap); + } + + void + instantiateLocalAlias(const Fortran::lower::pft::Variable &var, + llvm::DenseMap &storeMap) { + assert(var.isAlias()); const auto &sym = var.getSymbol(); const auto loc = genLocation(sym.name()); auto idxTy = builder->getIndexType(); - if (!var.isAlias()) { - mapSymbolAttributes(var, storeMap, mlir::Value{}); - return; - } auto aliasOffset = var.getAlias(); assert(storeMap.count(aliasOffset)); auto store = storeMap.find(aliasOffset)->second; @@ -2052,97 +1946,401 @@ class FirConverter : public Fortran::lower::AbstractConverter { void mapSymbolAttributes(const Fortran::lower::pft::Variable &var, llvm::DenseMap &storeMap, - mlir::Value preAlloc) { + mlir::Value preAlloc = {}) { const auto &sym = var.getSymbol(); const auto loc = genLocation(sym.name()); auto idxTy = builder->getIndexType(); const auto isDummy = Fortran::semantics::IsDummy(sym); const auto isResult = Fortran::semantics::IsFunctionResult(sym); + const auto replace = isDummy || isResult; + const auto isHostAssoc = + Fortran::semantics::IsHostAssociated(sym, sym.owner()); Fortran::lower::CharacterExprHelper charHelp{*builder, loc}; - SymbolBoxAnalyzer sba(sym); - sba.analyze(); - - if (sba.isTrivial()) { - if (isDummy) { - // This is an argument. - assert(lookupSymbol(sym) && "must already be in map"); - return; + Fortran::lower::BoxAnalyzer sba; + sba.analyze(sym); + + // The origin must be \vec{1}. + auto populateShape = [&](auto &shapes, const auto &bounds) { + for (auto *spec : bounds) { + if (auto low = spec->lbound().GetExplicit()) { + if (auto high = spec->ubound().GetExplicit()) { + Fortran::semantics::SomeExpr highEx{*high}; + auto ub = createFIRExpr(loc, &highEx); + shapes.emplace_back(builder->createConvert(loc, idxTy, ub)); + } else if (spec->ubound().isAssumed()) { + shapes.emplace_back(mlir::Value{}); + } else { + TODO("upper bound"); + } + } else { + TODO("lower bound"); + } } - // TODO: What about lower host-associated variables? (They probably need - // to be handled as dummy parameters.) - - // Otherwise, it's a local variable or function result. - auto local = createNewLocal(loc, var, preAlloc); - addSymbol(sym, local); - return; - } + }; - // The non-trivial cases are when we have an argument or local that has a - // repetition value. Arguments might be passed as simple pointers and need - // to be cast to a multi-dimensional array with constant bounds (possibly - // with a missing column), bounds computed in the callee (here), or with - // bounds from the caller (boxed somewhere else). Locals have the same - // properties except they are never boxed arguments from the caller and - // never having a missing column size. - - // Arguments (and some results) already have a symbolBox with the address. - auto maybeSymbolBox = lookupSymbol(sym); - mlir::Value addr = - maybeSymbolBox ? maybeSymbolBox.getAddr() : mlir::Value{}; - mlir::Value len; - [[maybe_unused]] bool mustBeDummy = false; - - if (sba.isChar) { - // if element type is a CHARACTER, determine the LEN value - if (isDummy || isResult) { - auto unboxchar = charHelp.createUnboxChar(addr); - addr = unboxchar.first; - if (auto c = sba.getCharLenConst()) { - // Set/override LEN with a constant - len = builder->createIntegerConstant(loc, idxTy, *c); - } else if (auto e = sba.getCharLenExpr()) { - // Set/override LEN with an expression - len = createFIRExpr(loc, &*e); + auto genLBoundsAndExtents = + [&](const Fortran::semantics::SomeExpr &lowEx, + const Fortran::semantics::SomeExpr &highEx) { + auto lb = createFIRExpr(loc, &lowEx); + auto ub = createFIRExpr(loc, &highEx); + auto ty = ub.getType(); + auto diff = builder->create(loc, ty, ub, lb); + auto one = builder->createIntegerConstant(loc, ty, 1); + auto sz = builder->create(loc, ty, diff, one); + auto idx = builder->createConvert(loc, idxTy, sz); + return std::pair{lb, idx}; + }; + + // The origin is not \vec{1}. + auto populateLBoundsExtents = [&](auto &lbounds, auto &extents, + const auto &bounds) { + for (auto *spec : bounds) { + if (auto low = spec->lbound().GetExplicit()) { + if (auto high = spec->ubound().GetExplicit()) { + // let the folder deal with the common `ub - + 1` case + auto [lb, idx] = + genLBoundsAndExtents(Fortran::semantics::SomeExpr{*low}, + Fortran::semantics::SomeExpr{*high}); + lbounds.emplace_back(lb); + extents.emplace_back(idx); + continue; + } else if (spec->ubound().isAssumed()) { + // An assumed size array. The extent is not computed. + Fortran::semantics::SomeExpr lowEx{*low}; + lbounds.emplace_back(createFIRExpr(loc, &lowEx)); + extents.emplace_back(mlir::Value{}); + } else { + TODO("upper bound"); + } } else { - // LEN is from the boxchar - len = unboxchar.second; - mustBeDummy = true; + TODO("lower bound"); } - // XXX: Subsequent lowering expects a CHARACTER variable to not be in a - // boxchar. We assert that here. We might want to reconsider this - // precondition. - assert(!addr.getType().isa() && - "dummy CHARACTER argument must be unboxed"); - } else { - // local CHARACTER variable - if (auto c = sba.getCharLenConst()) - len = builder->createIntegerConstant(loc, idxTy, *c); - else if (auto e = sba.getCharLenExpr()) - len = builder->createConvert(loc, charHelp.getLengthType(), - createFIRExpr(loc, &*e)); - else - len = builder->createIntegerConstant(loc, idxTy, sym.size()); - assert(!addr); } - } + }; + + if (isHostAssoc) + TODO("host associated"); + + sba.match( + //===--------------------------------------------------------------===// + // Trivial case. + //===--------------------------------------------------------------===// + [&](const Fortran::lower::details::ScalarSym &) { + if (isDummy) { + // This is an argument. + if (!lookupSymbol(sym)) + mlir::emitError(loc, "symbol \"") + << toStringRef(sym.name()) << "\" must already be in map"; + return; + } + // Otherwise, it's a local variable or function result. + auto local = createNewLocal(loc, var, preAlloc); + addSymbol(sym, local); + }, + + //===--------------------------------------------------------------===// + // The non-trivial cases are when we have an argument or local that has + // a repetition value. Arguments might be passed as simple pointers and + // need to be cast to a multi-dimensional array with constant bounds + // (possibly with a missing column), bounds computed in the callee + // (here), or with bounds from the caller (boxed somewhere else). Locals + // have the same properties except they are never boxed arguments from + // the caller and never having a missing column size. + //===--------------------------------------------------------------===// + + [&](const Fortran::lower::details::ScalarStaticChar &x) { + // type is a CHARACTER, determine the LEN value + auto charLen = x.charLen(); + if (replace) { + auto symBox = lookupSymbol(sym); + auto unboxchar = charHelp.createUnboxChar(symBox.getAddr()); + auto boxAddr = unboxchar.first; + // Set/override LEN with a constant + auto len = builder->createIntegerConstant(loc, idxTy, charLen); + addCharSymbol(sym, boxAddr, len, true); + return; + } + auto len = builder->createIntegerConstant(loc, idxTy, charLen); + if (preAlloc) { + addCharSymbol(sym, preAlloc, len); + return; + } + auto charTy = genType(var); + auto local = charHelp.createCharacterTemp(charTy, charLen); + addCharSymbol(sym, local.getBuffer(), local.getLen()); + }, + + //===--------------------------------------------------------------===// + + [&](const Fortran::lower::details::ScalarDynamicChar &x) { + // type is a CHARACTER, determine the LEN value + auto charLen = x.charLen(); + if (replace) { + auto symBox = lookupSymbol(sym); + auto unboxchar = charHelp.createUnboxChar(symBox.getAddr()); + auto boxAddr = unboxchar.first; + mlir::Value len; + if (charLen) { + // Set/override LEN with an expression + len = createFIRExpr(loc, &*charLen); + } else { + // LEN is from the boxchar + len = unboxchar.second; + } + addCharSymbol(sym, boxAddr, len, true); + return; + } + // local CHARACTER variable + mlir::Value len; + if (charLen) + len = createFIRExpr(loc, &*charLen); + else + len = builder->createIntegerConstant(loc, idxTy, sym.size()); + if (preAlloc) { + addCharSymbol(sym, preAlloc, len); + return; + } + auto local = charHelp.createCharacterTemp(genType(var), len); + addCharSymbol(sym, local.getBuffer(), local.getLen()); + }, + + //===--------------------------------------------------------------===// + + [&](const Fortran::lower::details::StaticArray &x) { + // object shape is constant, not a character + auto castTy = builder->getRefType(genType(var)); + mlir::Value addr = lookupSymbol(sym).getAddr(); + if (addr) + addr = builder->createConvert(loc, castTy, addr); + if (x.lboundAllOnes()) { + // if lower bounds are all ones, build simple shaped object + llvm::SmallVector shape; + for (auto i : x.shapes) + shape.push_back(builder->createIntegerConstant(loc, idxTy, i)); + mlir::Value local = + replace ? addr : createNewLocal(loc, var, preAlloc); + localSymbols.addSymbolWithShape(sym, local, shape, replace); + return; + } + // If object is an array process the lower bound and extent values by + // constructing constants and populating the lbounds and extents. + llvm::SmallVector extents; + llvm::SmallVector lbounds; + for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) { + lbounds.emplace_back( + builder->createIntegerConstant(loc, idxTy, fst)); + extents.emplace_back( + builder->createIntegerConstant(loc, idxTy, snd)); + } + mlir::Value local = + replace ? addr : createNewLocal(loc, var, preAlloc, extents); + assert(replace || Fortran::lower::isExplicitShape(sym) || + Fortran::semantics::IsAllocatableOrPointer(sym)); + localSymbols.addSymbolWithBounds(sym, local, extents, lbounds, + replace); + }, + + //===--------------------------------------------------------------===// + + [&](const Fortran::lower::details::DynamicArray &x) { + // cast to the known constant parts from the declaration + auto castTy = builder->getRefType(genType(var)); + mlir::Value addr = lookupSymbol(sym).getAddr(); + if (addr) + addr = builder->createConvert(loc, castTy, addr); + if (x.lboundAllOnes()) { + // if lower bounds are all ones, build simple shaped object + llvm::SmallVector shapes; + populateShape(shapes, x.bounds); + if (isDummy || isResult) { + localSymbols.addSymbolWithShape(sym, addr, shapes, true); + return; + } + // local array with computed bounds + assert(Fortran::lower::isExplicitShape(sym) || + Fortran::semantics::IsAllocatableOrPointer(sym)); + auto local = createNewLocal(loc, var, preAlloc, shapes); + localSymbols.addSymbolWithShape(sym, local, shapes); + return; + } + // if object is an array process the lower bound and extent values + llvm::SmallVector extents; + llvm::SmallVector lbounds; + populateLBoundsExtents(lbounds, extents, x.bounds); + if (isDummy || isResult) { + localSymbols.addSymbolWithBounds(sym, addr, extents, lbounds, true); + return; + } + // local array with computed bounds + assert(Fortran::lower::isExplicitShape(sym) || + Fortran::semantics::IsAllocatableOrPointer(sym)); + auto local = createNewLocal(loc, var, preAlloc, extents); + localSymbols.addSymbolWithBounds(sym, local, extents, lbounds); + }, + + //===--------------------------------------------------------------===// + + [&](const Fortran::lower::details::StaticArrayStaticChar &x) { + // if element type is a CHARACTER, determine the LEN value + auto charLen = x.charLen(); + mlir::Value addr; + mlir::Value len; + if (isDummy || isResult) { + auto symBox = lookupSymbol(sym); + auto unboxchar = charHelp.createUnboxChar(symBox.getAddr()); + addr = unboxchar.first; + // Set/override LEN with a constant + len = builder->createIntegerConstant(loc, idxTy, charLen); + } else { + // local CHARACTER variable + len = builder->createIntegerConstant(loc, idxTy, charLen); + } + + // object shape is constant + auto castTy = builder->getRefType(genType(var)); + if (addr) + addr = builder->createConvert(loc, castTy, addr); + + if (x.lboundAllOnes()) { + // if lower bounds are all ones, build simple shaped object + llvm::SmallVector shape; + for (auto i : x.shapes) + shape.push_back(builder->createIntegerConstant(loc, idxTy, i)); + mlir::Value local = + replace ? addr : createNewLocal(loc, var, preAlloc); + localSymbols.addCharSymbolWithShape(sym, local, len, shape, + replace); + return; + } + + // if object is an array process the lower bound and extent values + llvm::SmallVector extents; + llvm::SmallVector lbounds; + // construct constants and populate `bounds` + for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) { + lbounds.emplace_back( + builder->createIntegerConstant(loc, idxTy, fst)); + extents.emplace_back( + builder->createIntegerConstant(loc, idxTy, snd)); + } + + if (isDummy || isResult) { + localSymbols.addCharSymbolWithBounds(sym, addr, len, extents, + lbounds, true); + return; + } + // local CHARACTER array with computed bounds + assert(Fortran::lower::isExplicitShape(sym) || + Fortran::semantics::IsAllocatableOrPointer(sym)); + llvm::SmallVector shape = {len}; + shape.append(extents.begin(), extents.end()); + auto local = createNewLocal(loc, var, preAlloc, shape); + localSymbols.addCharSymbolWithBounds(sym, local, len, extents, + lbounds); + }, + + //===--------------------------------------------------------------===// + + [&](const Fortran::lower::details::StaticArrayDynamicChar &x) { + mlir::Value addr; + mlir::Value len; + bool mustBeDummy = false; + auto charLen = x.charLen(); + // if element type is a CHARACTER, determine the LEN value + if (isDummy || isResult) { + auto symBox = lookupSymbol(sym); + auto unboxchar = charHelp.createUnboxChar(symBox.getAddr()); + addr = unboxchar.first; + if (charLen) { + // Set/override LEN with an expression + len = createFIRExpr(loc, &*charLen); + } else { + // LEN is from the boxchar + len = unboxchar.second; + mustBeDummy = true; + } + } else { + // local CHARACTER variable + if (charLen) + len = createFIRExpr(loc, &*charLen); + else + len = builder->createIntegerConstant(loc, idxTy, sym.size()); + } + + // cast to the known constant parts from the declaration + auto castTy = builder->getRefType(genType(var)); + if (addr) + addr = builder->createConvert(loc, castTy, addr); - if (sba.isArray) { - // if object is an array process the lower bound and extent values - llvm::SmallVector extents; - llvm::SmallVector lbounds; - mustBeDummy = !isExplicitShape(sym) && - !Fortran::semantics::IsAllocatableOrPointer(sym); - if (sba.staticSize) { - // object shape is constant - auto castTy = builder->getRefType(genType(var)); - if (addr) - addr = builder->createConvert(loc, castTy, addr); - if (sba.lboundIsAllOnes()) { - // if lower bounds are all ones, build simple shaped object + if (x.lboundAllOnes()) { + // if lower bounds are all ones, build simple shaped object + llvm::SmallVector shape; + for (auto i : x.shapes) + shape.push_back(builder->createIntegerConstant(loc, idxTy, i)); + if (isDummy || isResult) { + localSymbols.addCharSymbolWithShape(sym, addr, len, shape, true); + return; + } + // local CHARACTER array with constant size + auto local = createNewLocal(loc, var, preAlloc); + localSymbols.addCharSymbolWithShape(sym, local, len, shape); + return; + } + + // if object is an array process the lower bound and extent values + llvm::SmallVector extents; + llvm::SmallVector lbounds; + + // construct constants and populate `bounds` + for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) { + lbounds.emplace_back( + builder->createIntegerConstant(loc, idxTy, fst)); + extents.emplace_back( + builder->createIntegerConstant(loc, idxTy, snd)); + } + if (isDummy || isResult) { + localSymbols.addCharSymbolWithBounds(sym, addr, len, extents, + lbounds, true); + return; + } + // local CHARACTER array with computed bounds + assert((!mustBeDummy) && + (Fortran::lower::isExplicitShape(sym) || + Fortran::semantics::IsAllocatableOrPointer(sym))); llvm::SmallVector shape; - for (auto i : sba.staticShape) - shape.push_back(builder->createIntegerConstant(loc, idxTy, i)); - if (sba.isChar) { + shape.push_back(len); + shape.append(extents.begin(), extents.end()); + auto local = createNewLocal(loc, var, preAlloc, shape); + localSymbols.addCharSymbolWithBounds(sym, local, len, extents, + lbounds); + }, + + //===--------------------------------------------------------------===// + + [&](const Fortran::lower::details::DynamicArrayStaticChar &x) { + mlir::Value addr; + mlir::Value len; + auto charLen = x.charLen(); + // if element type is a CHARACTER, determine the LEN value + if (isDummy || isResult) { + auto symBox = lookupSymbol(sym); + auto unboxchar = charHelp.createUnboxChar(symBox.getAddr()); + addr = unboxchar.first; + // Set/override LEN with a constant + len = builder->createIntegerConstant(loc, idxTy, charLen); + } else { + // local CHARACTER variable + len = builder->createIntegerConstant(loc, idxTy, charLen); + } + + // cast to the known constant parts from the declaration + auto castTy = builder->getRefType(genType(var)); + if (addr) + addr = builder->createConvert(loc, castTy, addr); + if (x.lboundAllOnes()) { + // if lower bounds are all ones, build simple shaped object + llvm::SmallVector shape; + populateShape(shape, x.bounds); if (isDummy || isResult) { localSymbols.addCharSymbolWithShape(sym, addr, len, shape, true); return; @@ -2152,104 +2350,94 @@ class FirConverter : public Fortran::lower::AbstractConverter { localSymbols.addCharSymbolWithShape(sym, local, len, shape); return; } + // if object is an array process the lower bound and extent values + llvm::SmallVector extents; + llvm::SmallVector lbounds; + populateLBoundsExtents(lbounds, extents, x.bounds); if (isDummy || isResult) { - localSymbols.addSymbolWithShape(sym, addr, shape, true); + localSymbols.addCharSymbolWithBounds(sym, addr, len, extents, + lbounds, true); return; } - // local array with constant size - auto local = createNewLocal(loc, var, preAlloc); - localSymbols.addSymbolWithShape(sym, local, shape); - return; - } - } else { - // cast to the known constant parts from the declaration - auto castTy = builder->getRefType(genType(var)); - if (addr) - addr = builder->createConvert(loc, castTy, addr); - } - // construct constants and populate `bounds` - for (const auto &i : llvm::zip(sba.staticLBound, sba.staticShape)) { - auto fst = builder->createIntegerConstant(loc, idxTy, std::get<0>(i)); - auto snd = builder->createIntegerConstant(loc, idxTy, std::get<1>(i)); - lbounds.emplace_back(fst); - extents.emplace_back(snd); - } + // local CHARACTER array with computed bounds + assert(Fortran::lower::isExplicitShape(sym) || + Fortran::semantics::IsAllocatableOrPointer(sym)); + llvm::SmallVector shape; + shape.push_back(len); + shape.append(extents.begin(), extents.end()); + auto local = createNewLocal(loc, var, preAlloc, shape); + localSymbols.addCharSymbolWithBounds(sym, local, len, extents, + lbounds); + }, - // default array case: populate `bounds` with lower and extent values - for (const auto &spec : sba.dynamicBound) { - auto low = spec->lbound().GetExplicit(); - auto high = spec->ubound().GetExplicit(); - if (low && high) { - // let the folder deal with the common `ub - 1 + 1` case - Fortran::semantics::SomeExpr lowEx{*low}; - auto lb = createFIRExpr(loc, &lowEx); - Fortran::semantics::SomeExpr highEx{*high}; - auto ub = createFIRExpr(loc, &highEx); - auto ty = ub.getType(); - auto diff = builder->create(loc, ty, ub, lb); - auto one = builder->createIntegerConstant(loc, ty, 1); - auto sz = builder->create(loc, ty, diff, one); - auto idx = builder->createConvert(loc, idxTy, sz); - lbounds.emplace_back(lb); - extents.emplace_back(idx); - continue; - } - if (low && spec->ubound().isAssumed()) { - // An assumed size array. The extent is not computed. - Fortran::semantics::SomeExpr lowEx{*low}; - auto lb = createFIRExpr(loc, &lowEx); - lbounds.emplace_back(lb); - extents.emplace_back(mlir::Value{}); - } - break; - } + //===--------------------------------------------------------------===// - if (sba.isChar) { - if (isDummy || isResult) { - localSymbols.addCharSymbolWithBounds(sym, addr, len, extents, lbounds, - true); - return; - } - // local CHARACTER array with computed bounds - assert(!mustBeDummy); - llvm::SmallVector shape; - shape.push_back(len); - shape.append(extents.begin(), extents.end()); - auto local = createNewLocal(loc, var, preAlloc, shape); - localSymbols.addCharSymbolWithBounds(sym, local, len, extents, lbounds); - return; - } - if (isDummy || isResult) { - localSymbols.addSymbolWithBounds(sym, addr, extents, lbounds, true); - return; - } - // local array with computed bounds - assert(!mustBeDummy); - auto local = createNewLocal(loc, var, preAlloc, extents); - localSymbols.addSymbolWithBounds(sym, local, extents, lbounds); - return; - } + [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) { + mlir::Value addr; + mlir::Value len; + auto charLen = x.charLen(); + // if element type is a CHARACTER, determine the LEN value + if (isDummy || isResult) { + auto symBox = lookupSymbol(sym); + auto unboxchar = charHelp.createUnboxChar(symBox.getAddr()); + addr = unboxchar.first; + if (charLen) { + // Set/override LEN with an expression + len = createFIRExpr(loc, &*charLen); + } else { + len = unboxchar.second; + } + } else { + // local CHARACTER variable + if (charLen) + len = createFIRExpr(loc, &*charLen); + else + len = builder->createIntegerConstant(loc, idxTy, sym.size()); + } - // not an array, so process as scalar argument - if (sba.isChar) { - if (isDummy || isResult) { - addCharSymbol(sym, addr, len, true); - return; - } - assert(!mustBeDummy); - auto charTy = genType(var); - fir::CharBoxValue local = preAlloc - ? fir::CharBoxValue(preAlloc, len) - : charHelp.createCharacterTemp(charTy, len); - addCharSymbol(sym, local.getBuffer(), local.getLen()); - return; - } - if (isDummy) { - addSymbol(sym, addr, true); - return; - } - auto local = createNewLocal(loc, var, preAlloc); - addSymbol(sym, local); + // cast to the known constant parts from the declaration + auto castTy = builder->getRefType(genType(var)); + if (addr) + addr = builder->createConvert(loc, castTy, addr); + if (x.lboundAllOnes()) { + // if lower bounds are all ones, build simple shaped object + llvm::SmallVector shape; + populateShape(shape, x.bounds); + if (isDummy || isResult) { + localSymbols.addCharSymbolWithShape(sym, addr, len, shape, true); + return; + } + // local CHARACTER array with constant size + auto local = createNewLocal(loc, var, preAlloc); + localSymbols.addCharSymbolWithShape(sym, local, len, shape); + return; + } + // Process the lower bound and extent values. + llvm::SmallVector extents; + llvm::SmallVector lbounds; + populateLBoundsExtents(lbounds, extents, x.bounds); + if (isDummy || isResult) { + localSymbols.addCharSymbolWithBounds(sym, addr, len, extents, + lbounds, true); + return; + } + // local CHARACTER array with computed bounds + assert(Fortran::lower::isExplicitShape(sym) || + Fortran::semantics::IsAllocatableOrPointer(sym)); + llvm::SmallVector shape; + shape.push_back(len); + shape.append(extents.begin(), extents.end()); + auto local = createNewLocal(loc, var, preAlloc, shape); + localSymbols.addCharSymbolWithBounds(sym, local, len, extents, + lbounds); + }, + + //===--------------------------------------------------------------===// + + [&](const Fortran::lower::BoxAnalyzer::None &) { + mlir::emitError(loc, "symbol analysis failed on ") + << toStringRef(sym.name()); + }); } using CommonBlockMap = @@ -2415,6 +2603,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { storeMap, *cmnBlkMap); } else if (var.isGlobal()) { instantiateGlobal(var, storeMap); + } else if (var.isAlias()) { + instantiateLocalAlias(var, storeMap); } else { instantiateLocal(var, storeMap); } diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index 09cec17f44bde..86d8a3d828fb1 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -236,8 +236,8 @@ void Fortran::lower::CallInterface::mapPassedEntities() { if constexpr (std::is_same_v) { assert(inputs.size() == func.front().getArguments().size() && "function previously created with different number of arguments"); - for (const auto &pair : llvm::zip(inputs, func.front().getArguments())) - mapBackInputToPassedEntity(std::get<0>(pair), std::get<1>(pair)); + for (auto [fst,snd] : llvm::zip(inputs, func.front().getArguments())) + mapBackInputToPassedEntity(fst, snd); } else { // On the caller side, map the index of the mlir argument position // to Fortran ActualArguments. @@ -357,12 +357,10 @@ class Fortran::lower::CallInterfaceImpl { // Handle arguments const auto &argumentEntities = getEntityContainer(interface.side().getCallDescription()); - for (const auto &pair : - llvm::zip(procedure.dummyArguments, argumentEntities)) { - const auto &dummyCharacteristic = std::get<0>(pair); + for (auto pair : llvm::zip(procedure.dummyArguments, argumentEntities)) { std::visit( Fortran::common::visitors{ - [&](const auto &dummy) { + [&](const auto &dummy) { const auto &entity = getDataObjectEntity(std::get<1>(pair)); handleImplicitDummy(dummy, entity); }, @@ -370,7 +368,7 @@ class Fortran::lower::CallInterfaceImpl { // nothing to do }, }, - dummyCharacteristic.u); + std::get<0>(pair).u); } } void buildExplicitInterface( diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index ca74522297c27..a6f1fbf43673e 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -811,12 +811,9 @@ class ExprLowering { idx.push_back(builder.createIntegerConstant(getLoc(), idxTy, i)); auto charVal = builder.create(getLoc(), chTy, constant, idx); - for (const auto &pair : llvm::zip(subscripts, con.lbounds())) { - const auto &dim = std::get<0>(pair); - const auto &lb = std::get<1>(pair); + for (auto [dim,lb] : llvm::zip(subscripts, con.lbounds())) idx.push_back( builder.createIntegerConstant(getLoc(), idxTy, dim - lb)); - } array = builder.create(getLoc(), arrayTy, array, charVal, idx); } @@ -834,12 +831,9 @@ class ExprLowering { auto constant = fir::getBase(genScalarLit(con.At(subscripts), con)); llvm::SmallVector idx; - for (const auto &pair : llvm::zip(subscripts, con.lbounds())) { - const auto &dim = std::get<0>(pair); - const auto &lb = std::get<1>(pair); + for (auto [dim,lb] : llvm::zip(subscripts, con.lbounds())) idx.push_back( builder.createIntegerConstant(getLoc(), idxTy, dim - lb)); - } auto insVal = builder.createConvert(getLoc(), eleTy, constant); array = builder.create(getLoc(), arrayTy, array, insVal, idx); @@ -1079,8 +1073,8 @@ class ExprLowering { assert(arr.getExtents().size() == aref.subscript().size()); unsigned idx = 0; unsigned dim = 0; - for (const auto &pair : llvm::zip(arr.getExtents(), aref.subscript())) { - auto subVal = genComponent(std::get<1>(pair)); + for (auto [ext,sub] : llvm::zip(arr.getExtents(), aref.subscript())) { + auto subVal = genComponent(sub); if (auto *trip = std::get_if(&subVal)) { // access A(i:j:k), decl A(m:n), iterspace (t1..) auto tlb = builder.createConvert(loc, idxTy, std::get<0>(*trip)); @@ -1093,7 +1087,7 @@ class ExprLowering { auto scaled = builder.create(loc, del, delta); auto prod = builder.create(loc, scaled, sum); total = builder.create(loc, prod, total); - if (auto ext = std::get<0>(pair)) + if (ext) delta = builder.create(loc, delta, ext); } else { auto *v = std::get_if(&subVal); @@ -1104,7 +1098,7 @@ class ExprLowering { auto diff = builder.create(loc, val, lb); auto prod = builder.create(loc, delta, diff); total = builder.create(loc, prod, total); - if (auto ext = std::get<0>(pair)) + if (ext) delta = builder.create(loc, delta, ext); } else { TODO(""); @@ -1161,10 +1155,10 @@ class ExprLowering { auto shapeType = fir::ShapeShiftType::get(builder.getContext(), arr.getExtents().size()); SmallVector shapeArgs; - for (const auto &pair : llvm::zip(arr.getLBounds(), arr.getExtents())) { - auto lb = builder.createConvert(loc, idxTy, std::get<0>(pair)); + for (auto [lbnd,ext] : llvm::zip(arr.getLBounds(), arr.getExtents())) { + auto lb = builder.createConvert(loc, idxTy, lbnd); shapeArgs.push_back(lb); - shapeArgs.push_back(std::get<1>(pair)); + shapeArgs.push_back(ext); } return builder.create(loc, shapeType, shapeArgs); }; @@ -1372,19 +1366,18 @@ class ExprLowering { // optional/alternate return arguments. Statement functions cannot be // recursive (directly or indirectly) so it is safe to add dummy symbols to // the local map here. - for (const auto &pair : + for (auto [arg,bind] : llvm::zip(details.dummyArgs(), procRef.arguments())) { - assert(std::get<0>(pair) && "alternate return in statement function"); - const auto &dummySymbol = *std::get<0>(pair); - assert(std::get<1>(pair) && "optional argument in statement function"); - const auto *expr = std::get<1>(pair)->UnwrapExpr(); + assert(arg && "alternate return in statement function"); + assert(bind && "optional argument in statement function"); + const auto *expr = bind->UnwrapExpr(); // TODO: assumed type in statement function, that surprisingly seems // allowed, probably because nobody thought of restricting this usage. // gfortran/ifort compiles this. assert(expr && "assumed type used as statement function argument"); // As per Fortran 2018 C1580, statement function arguments can only be // scalars, so just pass the box with the address. - symMap.addSymbol(dummySymbol, genExtAddr(*expr)); + symMap.addSymbol(*arg, genExtAddr(*expr)); } auto result = genval(details.stmtFunction().value()); LLVM_DEBUG(llvm::dbgs() << "stmt-function: " << result << '\n'); @@ -1516,9 +1509,8 @@ class ExprLowering { // Deal with potential mismatches in arguments types. Passing an array to // a scalar argument should for instance be tolerated here. - for (const auto &op : llvm::zip(caller.getInputs(), funcType.getInputs())) { - auto cast = builder.convertWithSemantics(getLoc(), std::get<1>(op), - std::get<0>(op)); + for (auto [fst,snd] : llvm::zip(caller.getInputs(), funcType.getInputs())) { + auto cast = builder.convertWithSemantics(getLoc(), snd, fst); operands.push_back(cast); } diff --git a/flang/lib/Lower/FIRBuilder.cpp b/flang/lib/Lower/FIRBuilder.cpp index b81cc06120d71..89577eac82df9 100644 --- a/flang/lib/Lower/FIRBuilder.cpp +++ b/flang/lib/Lower/FIRBuilder.cpp @@ -203,11 +203,9 @@ Fortran::lower::FirOpBuilder::createShape(mlir::Location loc, auto shapeTy = fir::ShapeShiftType::get(getContext(), box.getExtents().size()); llvm::SmallVector pairs; - for (const auto &pair : llvm::zip(box.getLBounds(), box.getExtents())) { - auto lb = createConvert(loc, idxTy, std::get<0>(pair)); - pairs.push_back(lb); - auto ext = createConvert(loc, idxTy, std::get<1>(pair)); - pairs.push_back(ext); + for (auto [fst,snd] : llvm::zip(box.getLBounds(), box.getExtents())) { + pairs.push_back(createConvert(loc, idxTy, fst)); + pairs.push_back(createConvert(loc, idxTy, snd)); } return create(loc, shapeTy, pairs); }; diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index a5c4e0e902002..7ce95307dc47d 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -240,11 +240,10 @@ void Fortran::lower::genDateAndTime(Fortran::lower::FirOpBuilder &builder, mlir::Value zoneLen; splitArg(zone, zoneBuffer, zoneLen); - llvm::SmallVector args{dateBuffer, timeBuffer, zoneBuffer, + llvm::SmallVector args{dateBuffer, timeBuffer, zoneBuffer, dateLen, timeLen, zoneLen}; - llvm::SmallVector operands; - for (const auto &op : llvm::zip(args, callee.getType().getInputs())) - operands.emplace_back( - builder.convertWithSemantics(loc, std::get<1>(op), std::get<0>(op))); + llvm::SmallVector operands; + for (auto [fst,snd] : llvm::zip(args, callee.getType().getInputs())) + operands.emplace_back(builder.convertWithSemantics(loc, snd, fst)); builder.create(loc, callee, operands); } From 5a68573cef8b7b9f6b558d2a977675ca0ab89801 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Wed, 7 Oct 2020 10:23:55 -0700 Subject: [PATCH 0292/1017] Mangle the attribute names on local variables so they can be used to recover the original symbols as done elsewhere. --- flang/lib/Lower/Bridge.cpp | 2 +- flang/test/Lower/OpenACC/acc-data.f90 | 6 +++--- flang/test/Lower/OpenACC/acc-parallel.f90 | 6 +++--- .../OpenMP/omp-parallel-copyin-clause.f90 | 16 +++++++-------- .../omp-parallel-firstprivate-clause.f90 | 16 +++++++-------- .../Lower/OpenMP/omp-parallel-if-clause.f90 | 4 ++-- .../OpenMP/omp-parallel-private-clause.f90 | 16 +++++++-------- .../test/Lower/OpenMP/omp-parallel-region.f90 | 18 ++++++++--------- .../OpenMP/omp-parallel-shared-clause.f90 | 16 +++++++-------- flang/test/Lower/dummy-procedure.f90 | 4 ++-- flang/test/Lower/entry.f90 | 20 +++++++++---------- flang/test/Lower/loops.f90 | 16 +++++++-------- flang/test/Lower/stmt-function.f90 | 6 +++--- flang/test/Lower/variable.f90 | 6 +++--- 14 files changed, 76 insertions(+), 76 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 1eebc20edbb4d..445c78d7dca45 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1790,7 +1790,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::ArrayRef shape = {}) { if (preAlloc) return preAlloc; - auto nm = var.getSymbol().name().ToString(); + auto nm = mangleName(var.getSymbol()); auto ty = genType(var); if (shape.size()) if (auto arrTy = ty.dyn_cast()) { diff --git a/flang/test/Lower/OpenACC/acc-data.f90 b/flang/test/Lower/OpenACC/acc-data.f90 index 588922c8ed730..58b8552fa3cc1 100644 --- a/flang/test/Lower/OpenACC/acc-data.f90 +++ b/flang/test/Lower/OpenACC/acc-data.f90 @@ -6,9 +6,9 @@ program acc_data real, dimension(10, 10) :: a, b, c logical :: ifCondition = .TRUE. -!CHECK: [[A:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "a"} -!CHECK: [[B:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "b"} -!CHECK: [[C:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "c"} +!CHECK: [[A:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Ea"} +!CHECK: [[B:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Eb"} +!CHECK: [[C:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Ec"} !$acc data if(.TRUE.) copy(a) !$acc end data diff --git a/flang/test/Lower/OpenACC/acc-parallel.f90 b/flang/test/Lower/OpenACC/acc-parallel.f90 index 111ee2ce932be..2e42ff162d13f 100644 --- a/flang/test/Lower/OpenACC/acc-parallel.f90 +++ b/flang/test/Lower/OpenACC/acc-parallel.f90 @@ -14,9 +14,9 @@ program acc_parallel logical :: ifCondition = .TRUE. real, dimension(10, 10) :: a, b, c -!CHECK: [[A:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "a"} -!CHECK: [[B:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "b"} -!CHECK: [[C:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "c"} +!CHECK: [[A:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Ea"} +!CHECK: [[B:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Eb"} +!CHECK: [[C:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Ec"} !$acc parallel !$acc end parallel diff --git a/flang/test/Lower/OpenMP/omp-parallel-copyin-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-copyin-clause.f90 index e59248d9c0df4..5db546169358b 100644 --- a/flang/test/Lower/OpenMP/omp-parallel-copyin-clause.f90 +++ b/flang/test/Lower/OpenMP/omp-parallel-copyin-clause.f90 @@ -7,20 +7,20 @@ ! RUN: FileCheck %s --check-prefix=LLVMIRDialect !FIRDialect: func @_QPcopyin_clause(%[[ARG1:.*]]: !fir.ref, %[[ARG2:.*]]: !fir.ref>) { -!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "alpha"} -!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "beta"} -!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "gama"} -!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "alpha_array"} +!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "{{.*}}Ealpha"} +!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "{{.*}}Ebeta"} +!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "{{.*}}Egama"} +!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "{{.*}}Ealpha_array"} !FIRDialect: omp.parallel copyin(%[[ALPHA]] : !fir.ref, %[[BETA]] : !fir.ref, %[[GAMA]] : !fir.ref, %[[ALPHA_ARRAY]] !: !fir.ref>, %[[ARG1]] : !fir.ref, %[[ARG2]] : !fir.ref>)) { !FIRDialect: omp.terminator !FIRDialect: } !LLVMDialect: llvm.func @_QPcopyin_clause(%[[ARG1:.*]]: !llvm.ptr, %[[ARG2:.*]]: !llvm.ptr>) { -!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "alpha"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "beta"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "gama"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "alpha_array"} : (!llvm.i64) -> !llvm.ptr> +!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ealpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ebeta"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Egama"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "{{.*}}Ealpha_array"} : (!llvm.i64) -> !llvm.ptr> !LLVMIRDialect: omp.parallel copyin(%[[ALPHA]] : !llvm.ptr, %[[BETA]] : !llvm.ptr, %[[GAMA]] : !llvm.ptr, !%[[ALPHA_ARRAY]] : !llvm.ptr>, %[[ARG1]] : !llvm.ptr, %[[ARG2]] : !llvm.ptr>) { !LLVMIRDialect: omp.terminator diff --git a/flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause.f90 index 9e7124911c556..af96b60f46c61 100644 --- a/flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause.f90 +++ b/flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause.f90 @@ -7,20 +7,20 @@ ! RUN: FileCheck %s --check-prefix=LLVMIRDialect !FIRDialect: func @_QPfirstprivate_clause(%[[ARG1:.*]]: !fir.ref, %[[ARG2:.*]]: !fir.ref>) { -!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "alpha"} -!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "beta"} -!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "gama"} -!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "alpha_array"} +!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "{{.*}}Ealpha"} +!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "{{.*}}Ebeta"} +!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "{{.*}}Egama"} +!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "{{.*}}Ealpha_array"} !FIRDialect: omp.parallel firstprivate(%[[ALPHA]] : !fir.ref, %[[BETA]] : !fir.ref, %[[GAMA]] : !fir.ref, !%[[ALPHA_ARRAY]] : !fir.ref>, %[[ARG1]] : !fir.ref, %[[ARG2]] : !fir.ref>)) { !FIRDialect: omp.terminator !FIRDialect: } !LLVMDialect: llvm.func @_QPfirstprivate_clause(%[[ARG1:.*]]: !llvm.ptr, %[[ARG2:.*]]: !llvm.ptr>) { -!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "alpha"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "beta"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "gama"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "alpha_array"} : (!llvm.i64) -> !llvm.ptr> +!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ealpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ebeta"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Egama"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "{{.*}}Ealpha_array"} : (!llvm.i64) -> !llvm.ptr> !LLVMIRDialect: omp.parallel firstprivate(%[[ALPHA]] : !llvm.ptr, %[[BETA]] : !llvm.ptr, %[[GAMA]] : !llvm.ptr, !%[[ALPHA_ARRAY]] : !llvm.ptr>, %[[ARG1]] : !llvm.ptr, %[[ARG2]] : !llvm.ptr>) { !LLVMIRDialect: omp.terminator diff --git a/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 index 75b9d9d524e8d..c1f5cd50c7b60 100644 --- a/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 +++ b/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 @@ -8,7 +8,7 @@ ! RUN: bbc -fopenmp -emit-fir %s -o - | \ ! RUN: tco | FileCheck %s --check-prefix=LLVMIR -!FIRDialect: %[[ALPHA:.*]] = fir.alloca i32 {name = "alpha"} +!FIRDialect: %[[ALPHA:.*]] = fir.alloca i32 {name = "{{.*}}Ealpha"} !FIRDialect: %[[CONSTANT_4:.*]] = constant 4 : i32 !FIRDialect: fir.store %[[CONSTANT_4]] to %[[ALPHA]] : !fir.ref !FIRDialect: %[[CONSTANT_0:.*]] = constant 0 : i32 @@ -20,7 +20,7 @@ !LLVMIRDialect: %[[CONSTANT_4:.*]] = llvm.mlir.constant(4 : i32) : !llvm.i32 !LLVMIRDialect: %[[CONSTANT_0:.*]] = llvm.mlir.constant(0 : i32) : !llvm.i32 -!LLVMIRDialect: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "alpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ealpha"} : (!llvm.i64) -> !llvm.ptr !LLVMIRDialect: llvm.store %[[CONSTANT_4]], %[[ALPHA]] : !llvm.ptr !LLVMIRDialect: %[[LD_ALPHA:.*]] = llvm.load %[[ALPHA]] : !llvm.ptr !LLVMIRDialect: %[[COND:.*]] = llvm.icmp "sle" %[[LD_ALPHA]], %[[CONSTANT_0]] : !llvm.i32 diff --git a/flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 index 9a1754ab77985..b5969426bbb53 100644 --- a/flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 +++ b/flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 @@ -7,20 +7,20 @@ ! RUN: FileCheck %s --check-prefix=LLVMIRDialect !FIRDialect: func @_QPprivate_clause(%[[ARG1:.*]]: !fir.ref, %[[ARG2:.*]]: !fir.ref>) { -!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "alpha"} -!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "beta"} -!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "gama"} -!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "alpha_array"} +!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "{{.*}}Ealpha"} +!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "{{.*}}Ebeta"} +!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "{{.*}}Egama"} +!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "{{.*}}Ealpha_array"} !FIRDialect-DAG: omp.parallel private(%[[ALPHA]] : !fir.ref, %[[BETA]] : !fir.ref, %[[GAMA]] : !fir.ref, !%[[ALPHA_ARRAY]] : !fir.ref>, %[[ARG1]] : !fir.ref, %[[ARG2]] : !fir.ref>)) { !FIRDialect: omp.terminator !FIRDialect: } !LLVMDialect: llvm.func @_QPprivate_clause(%[[ARG1:.*]]: !llvm.ptr, %[[ARG2:.*]]: !llvm.ptr>) { -!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "alpha"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "beta"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "gama"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "alpha_array"} : (!llvm.i64) -> !llvm.ptr> +!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ealpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ebeta"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Egama"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "{{.*}}Ealpha_array"} : (!llvm.i64) -> !llvm.ptr> !LLVMIRDialect: omp.parallel private(%[[ALPHA]] : !llvm.ptr, %[[BETA]] : !llvm.ptr, %[[GAMA]] : !llvm.ptr, !%[[ALPHA_ARRAY]] : !llvm.ptr>, %[[ARG1]] : !llvm.ptr, %[[ARG2]] : !llvm.ptr>) { !LLVMIRDialect: omp.terminator diff --git a/flang/test/Lower/OpenMP/omp-parallel-region.f90 b/flang/test/Lower/OpenMP/omp-parallel-region.f90 index 9a0d4f0db2ad7..138636f3d1056 100644 --- a/flang/test/Lower/OpenMP/omp-parallel-region.f90 +++ b/flang/test/Lower/OpenMP/omp-parallel-region.f90 @@ -15,15 +15,15 @@ program parallel a = 1 b = 2 -!FIRDialect: %[[VAR_A:.*]] = fir.alloca i32 {name = "a"} -!FIRDialect: %[[VAR_B:.*]] = fir.alloca i32 {name = "b"} -!FIRDialect: %[[VAR_C:.*]] = fir.alloca i32 {name = "c"} -!FIRDialect: %[[VAR_NUM_THREADS:.*]] = fir.alloca i32 {name = "num_threads"} - -!LLVMIRDialect: %[[VAR_A:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "a"} -!LLVMIRDialect: %[[VAR_B:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "b"} -!LLVMIRDialect: %[[VAR_C:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "c"} -!LLVMIRDialect: %[[VAR_NUM_THREADS:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "num_threads"} +!FIRDialect: %[[VAR_A:.*]] = fir.alloca i32 {name = "{{.*}}Ea"} +!FIRDialect: %[[VAR_B:.*]] = fir.alloca i32 {name = "{{.*}}Eb"} +!FIRDialect: %[[VAR_C:.*]] = fir.alloca i32 {name = "{{.*}}Ec"} +!FIRDialect: %[[VAR_NUM_THREADS:.*]] = fir.alloca i32 {name = "{{.*}}Enum_threads"} + +!LLVMIRDialect: %[[VAR_A:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ea"} +!LLVMIRDialect: %[[VAR_B:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Eb"} +!LLVMIRDialect: %[[VAR_C:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ec"} +!LLVMIRDialect: %[[VAR_NUM_THREADS:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Enum_threads"} !LLVMIR: %[[OMP_GLOBAL_THREAD_NUM:.*]] = call i32 @__kmpc_global_thread_num(%struct.ident_t* @{{.*}}) !LLVMIR: call void @__kmpc_push_num_threads(%struct.ident_t* @{{.*}}, i32 %[[OMP_GLOBAL_THREAD_NUM]], i32 %{{.*}}) diff --git a/flang/test/Lower/OpenMP/omp-parallel-shared-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-shared-clause.f90 index 2658dbbd2c6bb..8336bc671b93b 100644 --- a/flang/test/Lower/OpenMP/omp-parallel-shared-clause.f90 +++ b/flang/test/Lower/OpenMP/omp-parallel-shared-clause.f90 @@ -7,20 +7,20 @@ ! RUN: FileCheck %s --check-prefix=LLVMIRDialect !FIRDialect: func @_QPshared_clause(%[[ARG1:.*]]: !fir.ref, %[[ARG2:.*]]: !fir.ref>) { -!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "alpha"} -!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "beta"} -!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "gama"} -!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "alpha_array"} +!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "{{.*}}Ealpha"} +!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca i32 {name = "{{.*}}Ebeta"} +!FIRDialect-DAG: %[[GAMA:.*]] = fir.alloca i32 {name = "{{.*}}Egama"} +!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {name = "{{.*}}Ealpha_array"} !FIRDialect: omp.parallel shared(%[[ALPHA]] : !fir.ref, %[[BETA]] : !fir.ref, %[[GAMA]] : !fir.ref, %[[ALPHA_ARRAY]] !: !fir.ref>, %[[ARG1]] : !fir.ref, %[[ARG2]] : !fir.ref>)) { !FIRDialect: omp.terminator !FIRDialect: } !LLVMDialect: llvm.func @_QPshared_clause(%[[ARG1:.*]]: !llvm.ptr, %[[ARG2:.*]]: !llvm.ptr>) { -!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "alpha"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "beta"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "gama"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "alpha_array"} : (!llvm.i64) -> !llvm.ptr> +!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ealpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[BETA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ebeta"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[GAMA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Egama"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = llvm.alloca %{{.*}} x !llvm.array<10 x i32> {in_type = !fir.array<10xi32>, name = "{{.*}}Ealpha_array"} : (!llvm.i64) -> !llvm.ptr> !LLVMIRDialect: omp.parallel shared(%[[ALPHA]] : !llvm.ptr, %[[BETA]] : !llvm.ptr, %[[GAMA]] : !llvm.ptr, !%[[ALPHA_ARRAY]] : !llvm.ptr>, %[[ARG1]] : !llvm.ptr, %[[ARG2]] : !llvm.ptr>) { !LLVMIRDialect: omp.terminator diff --git a/flang/test/Lower/dummy-procedure.f90 b/flang/test/Lower/dummy-procedure.f90 index 71e2ce3c42d20..0fe3c164a1962 100644 --- a/flang/test/Lower/dummy-procedure.f90 +++ b/flang/test/Lower/dummy-procedure.f90 @@ -6,7 +6,7 @@ ! CHECK-LABEL: func @_QPfoo(%arg0: () -> ()) -> f32 real function foo(bar) real :: bar, x - ! CHECK: %[[x:.*]] = fir.alloca f32 {name = "x"} + ! CHECK: %[[x:.*]] = fir.alloca f32 {name = "{{.*}}Ex"} x = 42. ! CHECK: %[[funccast:.*]] = fir.convert %arg0 : (() -> ()) -> ((!fir.ref) -> f32) ! CHECK: fir.call %[[funccast]](%[[x]]) : (!fir.ref) -> f32 @@ -43,7 +43,7 @@ real function test_func() ! CHECK-LABEL: func @_QPfoo_sub(%arg0: () -> ()) subroutine foo_sub(bar_sub) - ! CHECK: %[[x:.*]] = fir.alloca f32 {name = "x"} + ! CHECK: %[[x:.*]] = fir.alloca f32 {name = "{{.*}}Ex"} x = 42. ! CHECK: %[[funccast:.*]] = fir.convert %arg0 : (() -> ()) -> ((!fir.ref) -> ()) ! CHECK: fir.call %[[funccast]](%[[x]]) : (!fir.ref) diff --git a/flang/test/Lower/entry.f90 b/flang/test/Lower/entry.f90 index 2a877708fc79a..356b7141fd8ce 100644 --- a/flang/test/Lower/entry.f90 +++ b/flang/test/Lower/entry.f90 @@ -16,8 +16,8 @@ program entries ! CHECK-LABEL: func @_QPss(%arg0: !fir.ref) subroutine ss(n1) - ! CHECK: fir.alloca i32 {name = "nx"} - ! CHECK: fir.alloca i32 {name = "ny"} + ! CHECK: fir.alloca i32 {name = "{{.*}}Enx"} + ! CHECK: fir.alloca i32 {name = "{{.*}}Eny"} integer n17, n2 nx = 100 n1 = nx + 10 @@ -25,34 +25,34 @@ subroutine ss(n1) ! CHECK-LABEL: func @_QPe1(%arg0: !fir.ref, %arg1: !fir.ref) entry e1(n2, n17) - ! CHECK: fir.alloca i32 {name = "nx"} - ! CHECK: fir.alloca i32 {name = "ny"} + ! CHECK: fir.alloca i32 {name = "{{.*}}Enx"} + ! CHECK: fir.alloca i32 {name = "{{.*}}Eny"} ny = 200 n2 = ny + 20 return ! CHECK-LABEL: func @_QPe2(%arg0: !fir.ref, %arg1: !fir.ref) entry e2(n3, n1) - ! CHECK: fir.alloca i32 {name = "nx"} - ! CHECK: fir.alloca i32 {name = "ny"} + ! CHECK: fir.alloca i32 {name = "{{.*}}Enx"} + ! CHECK: fir.alloca i32 {name = "{{.*}}Eny"} ! CHECK-LABEL: func @_QPe3(%arg0: !fir.ref) entry e3(n1) - ! CHECK: fir.alloca i32 {name = "nx"} - ! CHECK: fir.alloca i32 {name = "ny"} + ! CHECK: fir.alloca i32 {name = "{{.*}}Enx"} + ! CHECK: fir.alloca i32 {name = "{{.*}}Eny"} n1 = 30 end ! CHECK-LABEL: func @_QPjj(%arg0: !fir.ref) -> i32 function jj(n1) - ! CHECK: fir.alloca i32 {name = "jj"} + ! CHECK: fir.alloca i32 {name = "{{.*}}Ejj"} jj = 100 jj = jj + n1 return ! CHECK-LABEL: func @_QPrr(%arg0: !fir.ref) -> f32 entry rr(n2) - ! CHECK: fir.alloca i32 {name = "jj"} + ! CHECK: fir.alloca i32 {name = "{{.*}}Ejj"} rr = 200.0 rr = rr + n2 end diff --git a/flang/test/Lower/loops.f90 b/flang/test/Lower/loops.f90 index bb71370097e93..efe7b30531ce1 100644 --- a/flang/test/Lower/loops.f90 +++ b/flang/test/Lower/loops.f90 @@ -1,16 +1,16 @@ ! RUN: bbc -emit-fir -o - %s | FileCheck %s - ! CHECK-DAG: fir.alloca !fir.array<5x5x5xi32> {name = "a"} - ! CHECK-DAG: fir.alloca i8 {name = "i"} ! CHECK-DAG: fir.alloca i16 {name = "i"} - ! CHECK-DAG: fir.alloca i32 {name = "i"} - ! CHECK-DAG: fir.alloca i32 {name = "i"} - ! CHECK-DAG: fir.alloca i8 {name = "j"} - ! CHECK-DAG: fir.alloca i32 {name = "j"} - ! CHECK-DAG: fir.alloca i32 {name = "j"} ! CHECK-DAG: fir.alloca i8 {name = "k"} + ! CHECK-DAG: fir.alloca i8 {name = "j"} + ! CHECK-DAG: fir.alloca i8 {name = "i"} ! CHECK-DAG: fir.alloca i32 {name = "k"} - ! CHECK-DAG: fir.alloca i32 {name = "k"} + ! CHECK-DAG: fir.alloca i32 {name = "j"} + ! CHECK-DAG: fir.alloca i32 {name = "i"} + ! CHECK-DAG: fir.alloca !fir.array<5x5x5xi32> {name = "{{.*}}Ea"} + ! CHECK-DAG: fir.alloca i32 {name = "{{.*}}Ei"} + ! CHECK-DAG: fir.alloca i32 {name = "{{.*}}Ej"} + ! CHECK-DAG: fir.alloca i32 {name = "{{.*}}Ek"} integer(4) :: a(5,5,5), i, j, k, asum, xsum i = 100 diff --git a/flang/test/Lower/stmt-function.f90 b/flang/test/Lower/stmt-function.f90 index f86e655e2c4fd..7a5288b4a68a7 100644 --- a/flang/test/Lower/stmt-function.f90 +++ b/flang/test/Lower/stmt-function.f90 @@ -41,9 +41,9 @@ real function test_stmt_1(x, a) real :: res1, res2 func1(arg1) = a + foo(arg1) func2(arg2) = func1(arg2) + b - ! CHECK-DAG: %[[bmem:.*]] = fir.alloca f32 {name = "b"} - ! CHECK-DAG: %[[res1:.*]] = fir.alloca f32 {name = "res1"} - ! CHECK-DAG: %[[res2:.*]] = fir.alloca f32 {name = "res2"} + ! CHECK-DAG: %[[bmem:.*]] = fir.alloca f32 {name = "{{.*}}Eb"} + ! CHECK-DAG: %[[res1:.*]] = fir.alloca f32 {name = "{{.*}}Eres1"} + ! CHECK-DAG: %[[res2:.*]] = fir.alloca f32 {name = "{{.*}}Eres2"} b = 5 diff --git a/flang/test/Lower/variable.f90 b/flang/test/Lower/variable.f90 index 35517a09a27d0..0c9f2bcea494a 100644 --- a/flang/test/Lower/variable.f90 +++ b/flang/test/Lower/variable.f90 @@ -2,11 +2,11 @@ ! CHECK-LABEL: func @_QPs() { subroutine s - ! CHECK-DAG: fir.alloca !fir.heap {name = "ally"} + ! CHECK-DAG: fir.alloca !fir.heap {name = "{{.*}}Eally"} integer, allocatable :: ally - ! CHECK-DAG: fir.alloca !fir.ptr {name = "pointy"} + ! CHECK-DAG: fir.alloca !fir.ptr {name = "{{.*}}Epointy"} integer, pointer :: pointy - ! CHECK-DAG: fir.alloca i32 {name = "bullseye", target} + ! CHECK-DAG: fir.alloca i32 {name = "{{.*}}Ebullseye", target} integer, target :: bullseye ! CHECK: return end subroutine s From 6a3bec9f1ba2ac199651a773f4a01ce2b0555f19 Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Wed, 7 Oct 2020 10:47:28 -0700 Subject: [PATCH 0293/1017] Update entry point test with character arguments (#475) --- flang/test/Lower/entry.f90 | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/flang/test/Lower/entry.f90 b/flang/test/Lower/entry.f90 index 356b7141fd8ce..c1c351cb2efd6 100644 --- a/flang/test/Lower/entry.f90 +++ b/flang/test/Lower/entry.f90 @@ -1,8 +1,26 @@ ! RUN: bbc -emit-fir -o - %s | FileCheck %s +! CHECK-LABEL: func @_QPcompare1(%arg0: !fir.ref>, %arg1: !fir.boxchar<1>, %arg2: !fir.boxchar<1>) +subroutine compare1(x, c1, c2) + character(*) c1, c2, d1, d2 + logical x, y + x = c1 < c2 + return + +! CHECK-LABEL: func @_QPcompare2(%arg0: !fir.ref>, %arg1: !fir.boxchar<1>, %arg2: !fir.boxchar<1>) +entry compare2(y, d2, d1) + y = d1 < d2 +end + program entries character(10) hh, qq, m + character(len=4) s1, s2 integer mm + logical r + s1 = 'a111' + s2 = 'a222' + call compare1(r, s1, s2); print*, r + call compare2(r, s1, s2); print*, r call ss(mm); print*, mm call e1(mm, 17); print*, mm call e2(17, mm); print*, mm @@ -57,14 +75,12 @@ function jj(n1) rr = rr + n2 end -! CHECK-LABEL: func @_QPhh(%arg0: !fir.ref>, %arg1: index, %arg2: -! !fir.boxchar<1>) -> !fir.boxchar<1> +! CHECK-LABEL: func @_QPhh(%arg0: !fir.ref>, %arg1: index, %arg2: !fir.boxchar<1>) -> !fir.boxchar<1> function hh(c1) character(10) c1, hh, qq hh = c1 return -! CHECK-LABEL: func @_QPqq(%arg0: !fir.ref>, %arg1: index, %arg2: -! !fir.boxchar<1>) -> !fir.boxchar<1> +! CHECK-LABEL: func @_QPqq(%arg0: !fir.ref>, %arg1: index, %arg2: !fir.boxchar<1>) -> !fir.boxchar<1> entry qq(c1) qq = c1 end From e5111661826f453e0a1a675e5a627fbe283ff40c Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 7 Oct 2020 14:31:07 -0700 Subject: [PATCH 0294/1017] add some descriptor tests remove unnecessary assertion --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 1 - flang/test/Fir/box.fir | 54 +++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 1 deletion(-) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 90b5fff8ecc0e..f7f632ab48389 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -319,7 +319,6 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { // fir.array --> llvm<"[...[c x any]]"> mlir::LLVM::LLVMType convertSequenceType(fir::SequenceType seq) { - assert(seq.hasConstantInterior() && "cannot lower type to LLVM IR"); auto baseTy = unwrap(convertType(seq.getEleTy())); auto shape = seq.getShape(); auto constRows = seq.getConstantRows(); diff --git a/flang/test/Fir/box.fir b/flang/test/Fir/box.fir index 04ec2bbbe3689..5438407a8446b 100644 --- a/flang/test/Fir/box.fir +++ b/flang/test/Fir/box.fir @@ -49,3 +49,57 @@ func @fa(%a : !fir.ref>) { // CHECK: ret void return } + +// Boxing of a scalar character of dynamic length +// CHECK-LABEL: define { i8*, i64, i32, i8, i8, i8, i8 }* @b1( +// CHECK-SAME: i8* %[[arg0:.*]], i64 %[[arg1:.*]]) +func @b1(%arg0 : !fir.ref>>, %arg1 : index) -> !fir.box>> { + // CHECK: store i8* %[[arg0]], i8** %{{.*}}, align + // CHECK: store i64 %[[arg1]], i64* %{{.*}}, align + // CHECK: store i32 20180515, i32* % + %x = fir.embox %arg0 typeparams %arg1 : (!fir.ref>>, index) -> !fir.box>> + return %x : !fir.box>> +} + +// Boxing of a dynamic array of character with static length (5) +// CHECK-LABEL: define { [5 x i8]*, i64, i32, i8, i8, i8, i8 }* @b2( +// CHECK-SAME: [5 x i8]* %[[arg0:.*]], i64 %[[arg1:.*]]) +func @b2(%arg0 : !fir.ref>>, %arg1 : index) -> !fir.box>> { + %1 = fir.shape %arg1 : (index) -> !fir.shape<1> + // CHECK: store [5 x i8]* %[[arg0]], [5 x i8]** %{{.*}}, align + // CHECK: store i64 5, i64* %{{.*}}, align + // CHECK: store i32 20180515, i32* % + // CHECK: store i64 %[[arg1]], i64* %{{.*}}, align + // CHECK: store i64 5, i64* %{{.*}}, align + %2 = fir.embox %arg0(%1) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> + return %2 : !fir.box>> +} + +// Boxing of a dynamic array of character of dynamic length +// CHECK-LABEL: define { i8*, i64, i32, i8, i8, i8, i8 }* @b3( +// CHECK-SAME: i8* %[[arg0:.*]], i64 %[[arg1:.*]], i64 %[[arg2:.*]]) +func @b3(%arg0 : !fir.ref>>, %arg1 : index, %arg2 : index) -> !fir.box>> { + %1 = fir.shape %arg2 : (index) -> !fir.shape<1> + // CHECK: store i8* %[[arg0]], i8** %{{.*}}, align + // CHECK: store i64 %[[arg1]], i64* %{{.*}}, align + // CHECK: store i32 20180515, i32* % + // CHECK: store i64 %[[arg2]], i64* %{{.*}}, align + // CHECK: store i64 %[[arg1]], i64* %{{.*}}, align + %2 = fir.embox %arg0(%1) typeparams %arg1 : (!fir.ref>>, !fir.shape<1>, index) -> !fir.box>> + return %2 : !fir.box>> +} + +// Boxing of a static array of character of dynamic length +// CHECK-LABEL: define { i8*, i64, i32, i8, i8, i8, i8 }* @b4( +// CHECK-SAME: i8* %[[arg0:.*]], i64 %[[arg1:.*]]) +func @b4(%arg0 : !fir.ref>>, %arg1 : index) -> !fir.box>> { + %c_7 = constant 7 : index + %1 = fir.shape %c_7 : (index) -> !fir.shape<1> + // CHECK: store i8* %[[arg0]], i8** %{{.*}}, align + // CHECK: store i64 %[[arg1]], i64* %{{.*}}, align + // CHECK: store i32 20180515, i32* % + // CHECK: store i64 7, i64* %{{.*}}, align + // CHECK: store i64 %[[arg1]], i64* %{{.*}}, align + %x = fir.embox %arg0(%1) typeparams %arg1 : (!fir.ref>>, !fir.shape<1>, index) -> !fir.box>> + return %x : !fir.box>> +} From 62623d4c2bc968424032442e2769b8ff3b165050 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Thu, 8 Oct 2020 10:31:14 +0530 Subject: [PATCH 0295/1017] Fix for #480 [flang][OpenMP] Lower Flush construct to llvmir --- flang/test/Lower/OpenMP/omp-flush.f90 | 87 +++++++++++++++++++ .../Lower/OpenMP/omp-parallel-if-clause.f90 | 65 +++++++------- 2 files changed, 121 insertions(+), 31 deletions(-) create mode 100644 flang/test/Lower/OpenMP/omp-flush.f90 diff --git a/flang/test/Lower/OpenMP/omp-flush.f90 b/flang/test/Lower/OpenMP/omp-flush.f90 new file mode 100644 index 0000000000000..afe39097df01d --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-flush.f90 @@ -0,0 +1,87 @@ +! This test checks lowering of OpenMP Flush Directive. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMIRDialect +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: tco | FileCheck %s --check-prefix=LLVMIR + +program flush + + integer :: a,b,c + +!FIRDialect-LABEL:func @_QQmain() { +!FIRDialect: %{{.*}} = fir.alloca i32 {name = "{{.*}}Ea"} +!FIRDialect: %{{.*}} = fir.alloca i32 {name = "{{.*}}Eb"} +!FIRDialect: %{{.*}} = fir.alloca i32 {name = "{{.*}}Ec"} + +!LLVMIRDialect-LABEL: llvm.func @_QQmain() { +!LLVMIRDialect: %{{.*}} = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ea"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect: %{{.*}} = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Eb"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect: %{{.*}} = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ec"} : (!llvm.i64) -> !llvm.ptr + +!LLVMIR-LABEL: define void @_QQmain() {{.*}} { +!LLVMIR: %{{.*}} = alloca i32, i64 1, align 4 +!LLVMIR: %{{.*}} = alloca i32, i64 1, align 4 +!LLVMIR: %{{.*}} = alloca i32, i64 1, align 4 +!LLVMIR: call i32 @__kmpc_global_thread_num(%struct.ident_t* @{{.*}}) +!LLVMIR: br label %omp_parallel +!$OMP PARALLEL +!FIRDialect: omp.parallel { + +!LLVMIRDialect: omp.parallel { + +!LLVMIR-LABEL: define internal void @_QQmain..omp_par +!LLVMIR: call void @__kmpc_flush(%struct.ident_t* @{{.*}}) +!$OMP FLUSH(a,b,c) +!$OMP FLUSH +!FIRDialect: omp.flush(%{{.*}}, %{{.*}}, %{{.*}} : !fir.ref, !fir.ref, !fir.ref) +!FIRDialect: omp.flush +!FIRDialect: %{{.*}} = fir.load %{{.*}} : !fir.ref +!FIRDialect: %{{.*}} = fir.load %{{.*}} : !fir.ref +!FIRDialect: %{{.*}} = addi %{{.*}}, %{{.*}} : i32 +!FIRDialect: fir.store %{{.*}} to %{{.*}} : !fir.ref + +!LLVMIRDialect: omp.flush(%{{.*}}, %{{.*}}, %{{.*}} : !llvm.ptr, !llvm.ptr, !llvm.ptr) +!LLVMIRDialect: omp.flush +!LLVMIRDialect: %{{.*}} = llvm.load %{{.*}} : !llvm.ptr +!LLVMIRDialect: %{{.*}} = llvm.load %{{.*}} : !llvm.ptr +!LLVMIRDialect: %{{.*}} = llvm.add %{{.*}}, %{{.*}} : !llvm.i32 +!LLVMIRDialect: llvm.store %{{.*}}, %{{.*}} : !llvm.ptr + c = a + b +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMIRDialect: omp.terminator +!LLVMIRDialect: } +!$OMP END PARALLEL + +!$OMP FLUSH(a,b,c) +!$OMP FLUSH +!FIRDialect: omp.flush(%{{.*}}, %{{.*}}, %{{.*}} : !fir.ref, !fir.ref, !fir.ref) +!FIRDialect: omp.flush +!FIRDialect: %{{.*}} = fir.load %{{.*}} : !fir.ref +!FIRDialect: %{{.*}} = fir.load %{{.*}} : !fir.ref +!FIRDialect: %{{.*}} = addi %{{.*}}, %{{.*}} : i32 +!FIRDialect: fir.store %{{.*}} to %{{.*}} : !fir.ref + +!LLVMIRDialect: omp.flush(%{{.*}}, %{{.*}}, %{{.*}} : !llvm.ptr, !llvm.ptr, !llvm.ptr) +!LLVMIRDialect: omp.flush +!LLVMIRDialect: %{{.*}} = llvm.load %{{.*}} : !llvm.ptr +!LLVMIRDialect: %{{.*}} = llvm.load %{{.*}} : !llvm.ptr +!LLVMIRDialect: %{{.*}} = llvm.add %{{.*}}, %{{.*}} : !llvm.i32 +!LLVMIRDialect: llvm.store %{{.*}}, %{{.*}} : !llvm.ptr + + c = a + b +!$OMP FLUSH(a,b,c) +!$OMP FLUSH +!FIRDialect: omp.flush(%{{.*}}, %{{.*}}, %{{.*}} : !fir.ref, !fir.ref, !fir.ref) +!FIRDialect: omp.flush + +!LLVMIRDialect: omp.flush(%{{.*}}, %{{.*}}, %{{.*}} : !llvm.ptr, !llvm.ptr, !llvm.ptr) +!LLVMIRDialect: omp.flush + + print*, "After Flushing" + +end program diff --git a/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 index c1f5cd50c7b60..218d220c8f3c6 100644 --- a/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 +++ b/flang/test/Lower/OpenMP/omp-parallel-if-clause.f90 @@ -8,37 +8,40 @@ ! RUN: bbc -fopenmp -emit-fir %s -o - | \ ! RUN: tco | FileCheck %s --check-prefix=LLVMIR -!FIRDialect: %[[ALPHA:.*]] = fir.alloca i32 {name = "{{.*}}Ealpha"} -!FIRDialect: %[[CONSTANT_4:.*]] = constant 4 : i32 -!FIRDialect: fir.store %[[CONSTANT_4]] to %[[ALPHA]] : !fir.ref -!FIRDialect: %[[CONSTANT_0:.*]] = constant 0 : i32 -!FIRDialect: %[[LD_ALPHA:.*]] = fir.load %0 : !fir.ref -!FIRDialect: %[[COND:.*]] = cmpi "sle", %[[LD_ALPHA]], %[[CONSTANT_0]] : i32 -!FIRDialect: omp.parallel if(%[[COND]] : i1) { -!FIRDialect: omp.terminator -!FIRDialect: } - -!LLVMIRDialect: %[[CONSTANT_4:.*]] = llvm.mlir.constant(4 : i32) : !llvm.i32 -!LLVMIRDialect: %[[CONSTANT_0:.*]] = llvm.mlir.constant(0 : i32) : !llvm.i32 -!LLVMIRDialect: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ealpha"} : (!llvm.i64) -> !llvm.ptr -!LLVMIRDialect: llvm.store %[[CONSTANT_4]], %[[ALPHA]] : !llvm.ptr -!LLVMIRDialect: %[[LD_ALPHA:.*]] = llvm.load %[[ALPHA]] : !llvm.ptr -!LLVMIRDialect: %[[COND:.*]] = llvm.icmp "sle" %[[LD_ALPHA]], %[[CONSTANT_0]] : !llvm.i32 -!LLVMIRDialect: omp.parallel if(%[[COND]] : !llvm.i1) { -!LLVMIRDialect: omp.terminator -!LLVMIRDialect: } - -!LLVMIR: %[[ALPHA:.*]] = alloca i32, i64 1 -!LLVMIR: store i32 4, i32* %[[ALPHA]], align 4 -!LLVMIR: %[[LD_ALPHA:.*]] = load i32, i32* %[[ALPHA]], align 4 -!LLVMIR: %[[COND:.*]] = icmp sle i32 %[[LD_ALPHA]], 0 -!LLVMIR: br i1 %[[COND]], label %[[PARALLEL:.*]], label %[[SERIAL:.*]] -!LLVMIR: [[PARALLEL]]: -!LLVMIR: br label %omp_parallel -!LLVMIR: [[SERIAL]]: -!LLVMIR: call void @__kmpc_serialized_parallel -!LLVMIR: call void @_QQmain..omp_par -!LLVMIR: call void @__kmpc_end_serialized_parallel +!FIRDialect-LABEL: func @_QQmain() { +!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {name = "{{.*}}Ealpha"} +!FIRDialect-DAG: %[[CONSTANT_4:.*]] = constant 4 : i32 +!FIRDialect-DAG: fir.store %[[CONSTANT_4]] to %[[ALPHA]] : !fir.ref +!FIRDialect-DAG: %[[CONSTANT_0:.*]] = constant 0 : i32 +!FIRDialect-DAG: %[[LD_ALPHA:.*]] = fir.load %[[ALPHA]] : !fir.ref +!FIRDialect: %[[COND:.*]] = cmpi "sle", %[[LD_ALPHA]], %[[CONSTANT_0]] : i32 +!FIRDialect: omp.parallel if(%[[COND]] : i1) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMIRDialect-LABEL: llvm.func @_QQmain() { +!LLVMIRDialect-DAG: %[[CONSTANT_4:.*]] = llvm.mlir.constant(4 : i32) : !llvm.i32 +!LLVMIRDialect-DAG: %[[CONSTANT_0:.*]] = llvm.mlir.constant(0 : i32) : !llvm.i32 +!LLVMIRDialect-DAG: %[[ALPHA:.*]] = llvm.alloca %{{.*}} x !llvm.i32 {in_type = i32, name = "{{.*}}Ealpha"} : (!llvm.i64) -> !llvm.ptr +!LLVMIRDialect-DAG: llvm.store %[[CONSTANT_4]], %[[ALPHA]] : !llvm.ptr +!LLVMIRDialect-DAG: %[[LD_ALPHA:.*]] = llvm.load %[[ALPHA]] : !llvm.ptr +!LLVMIRDialect: %[[COND:.*]] = llvm.icmp "sle" %[[LD_ALPHA]], %[[CONSTANT_0]] : !llvm.i32 +!LLVMIRDialect: omp.parallel if(%[[COND]] : !llvm.i1) { +!LLVMIRDialect: omp.terminator +!LLVMIRDialect: } + +!LLVMIR-LABEL: define void @_QQmain() +!LLVMIR-DAG: %[[ALPHA:.*]] = alloca i32, i64 1 +!LLVMIR-DAG: store i32 4, i32* %[[ALPHA]], align 4 +!LLVMIR-DAG: %[[LD_ALPHA:.*]] = load i32, i32* %[[ALPHA]], align 4 +!LLVMIR-DAG: %[[COND:.*]] = icmp sle i32 %[[LD_ALPHA]], 0 +!LLVMIR: br i1 %[[COND]], label %[[PARALLEL:.*]], label %[[SERIAL:.*]] +!LLVMIR: [[PARALLEL]]: +!LLVMIR: br label %omp_parallel +!LLVMIR: [[SERIAL]]: +!LLVMIR: call void @__kmpc_serialized_parallel +!LLVMIR: call void @_QQmain..omp_par +!LLVMIR: call void @__kmpc_end_serialized_parallel program ifclause integer :: alpha From 87fd6bbd661c6f769ddf3e32406b4929c37dfab4 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 8 Oct 2020 15:22:40 -0700 Subject: [PATCH 0296/1017] fixes #464 -- missing attribute values on equivalenced variable --- flang/lib/Lower/Bridge.cpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 445c78d7dca45..1e8f6292ad2ad 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1900,7 +1900,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto varTy = builder->getRefType(genType(*st.vars[0])); auto result = builder->createConvert(loc, varTy, addr); storeMap[off] = result; - addSymbol(*st.vars[0], result); + mapSymbolAttributes(Fortran::lower::pft::Variable{*st.vars[0]}, storeMap, + result); return; } // Allocate an anonymous block of memory. From 4dca15b6a4d457a5cf40309cafd40c30af5f4c05 Mon Sep 17 00:00:00 2001 From: zacharyselk Date: Fri, 25 Sep 2020 08:28:28 -0600 Subject: [PATCH 0297/1017] Added InsertOnRangeOp to FIR The InsertOnRangeOp has been created and added to the fir dialect. This operation is used to condence a series of identical InsertValueOps into a single operation. Resolved round 1 review comments Addressed some syntactic issues Added global test, minimum run length, and argument checks Testing global arrays --- flang/lib/Lower/ConvertExpr.cpp | 86 +++++++++++++++++++++---- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 74 ++++++++++++++++++++- flang/test/Lower/array.f90 | 59 +++++++++++++++++ 3 files changed, 205 insertions(+), 14 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index a6f1fbf43673e..4392c53e03951 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -789,7 +789,7 @@ class ExprLowering { llvm::SmallVector lbounds; llvm::SmallVector extents; auto idxTy = builder.getIndexType(); - for (const auto &[lb, extent] : llvm::zip(con.lbounds(), con.shape())) { + for (auto [lb, extent] : llvm::zip(con.lbounds(), con.shape())) { lbounds.push_back(builder.createIntegerConstant(getLoc(), idxTy, lb - 1)); extents.push_back(builder.createIntegerConstant(getLoc(), idxTy, extent)); } @@ -811,7 +811,7 @@ class ExprLowering { idx.push_back(builder.createIntegerConstant(getLoc(), idxTy, i)); auto charVal = builder.create(getLoc(), chTy, constant, idx); - for (auto [dim,lb] : llvm::zip(subscripts, con.lbounds())) + for (auto [dim, lb] : llvm::zip(subscripts, con.lbounds())) idx.push_back( builder.createIntegerConstant(getLoc(), idxTy, dim - lb)); array = builder.create(getLoc(), arrayTy, array, @@ -827,16 +827,77 @@ class ExprLowering { auto arrayTy = fir::SequenceType::get(shape, eleTy); mlir::Value array = builder.create(getLoc(), arrayTy); Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); + bool foundRange = false; + mlir::Value rangeValue; + llvm::SmallVector rangeStartIdx; + Fortran::evaluate::ConstantSubscripts rangeStartSubscripts; + uint64_t elemsInRange = 0; + const uint64_t minRangeSize = 2; + do { auto constant = fir::getBase(genScalarLit(con.At(subscripts), con)); - llvm::SmallVector idx; - for (auto [dim,lb] : llvm::zip(subscripts, con.lbounds())) - idx.push_back( - builder.createIntegerConstant(getLoc(), idxTy, dim - lb)); + auto createIndexes = [&](Fortran::evaluate::ConstantSubscripts subs) { + llvm::SmallVector idx; + for (auto [dim, lb] : llvm::zip(subs, con.lbounds())) + // Add normalized upper bound index to idx. + idx.push_back( + builder.createIntegerConstant(getLoc(), idxTy, dim - lb)); + + return idx; + }; + + auto idx = createIndexes(subscripts); auto insVal = builder.createConvert(getLoc(), eleTy, constant); - array = builder.create(getLoc(), arrayTy, array, - insVal, idx); + auto nextSubs = subscripts; + + // Check to see if the next value is the same as the current value + bool nextIsSame = con.IncrementSubscripts(nextSubs) && + con.At(subscripts) == con.At(nextSubs); + bool newRange = (nextIsSame != foundRange) && !foundRange; + bool endOfRange = (nextIsSame != foundRange) && foundRange; + bool continueRange = nextIsSame && foundRange; + + if (newRange) { + // Mark the start of the range + rangeStartIdx = idx; + rangeStartSubscripts = subscripts; + rangeValue = insVal; + foundRange = true; + elemsInRange = 1; + } else if (endOfRange) { + ++elemsInRange; + if (elemsInRange >= minRangeSize) { + // Zip together the upper and lower bounds of the range for each + // index in the form [lb0, up0, lb1, up1, ... , lbn, upn] to pass + // to the InserOnEangeOp. + llvm::SmallVector zippedRange; + for (size_t i = 0; i < idx.size(); ++i) { + zippedRange.push_back(rangeStartIdx[i]); + zippedRange.push_back(idx[i]); + } + array = builder.create( + getLoc(), arrayTy, array, rangeValue, zippedRange); + } else { + while (true) { + idx = createIndexes(rangeStartSubscripts); + array = builder.create( + getLoc(), arrayTy, array, rangeValue, idx); + if (rangeStartSubscripts == subscripts) + break; + con.IncrementSubscripts(rangeStartSubscripts); + } + } + foundRange = false; + } else if (continueRange) { + // Loop until the end of the range is found. + ++elemsInRange; + continue; + } else /* no range */ { + // If a range has not been found then insert the current value. + array = builder.create(getLoc(), arrayTy, array, + insVal, idx); + } } while (con.IncrementSubscripts(subscripts)); return fir::ArrayBoxValue{array, extents, lbounds}; } @@ -1073,7 +1134,7 @@ class ExprLowering { assert(arr.getExtents().size() == aref.subscript().size()); unsigned idx = 0; unsigned dim = 0; - for (auto [ext,sub] : llvm::zip(arr.getExtents(), aref.subscript())) { + for (auto [ext, sub] : llvm::zip(arr.getExtents(), aref.subscript())) { auto subVal = genComponent(sub); if (auto *trip = std::get_if(&subVal)) { // access A(i:j:k), decl A(m:n), iterspace (t1..) @@ -1155,7 +1216,7 @@ class ExprLowering { auto shapeType = fir::ShapeShiftType::get(builder.getContext(), arr.getExtents().size()); SmallVector shapeArgs; - for (auto [lbnd,ext] : llvm::zip(arr.getLBounds(), arr.getExtents())) { + for (auto [lbnd, ext] : llvm::zip(arr.getLBounds(), arr.getExtents())) { auto lb = builder.createConvert(loc, idxTy, lbnd); shapeArgs.push_back(lb); shapeArgs.push_back(ext); @@ -1366,7 +1427,7 @@ class ExprLowering { // optional/alternate return arguments. Statement functions cannot be // recursive (directly or indirectly) so it is safe to add dummy symbols to // the local map here. - for (auto [arg,bind] : + for (auto [arg, bind] : llvm::zip(details.dummyArgs(), procRef.arguments())) { assert(arg && "alternate return in statement function"); assert(bind && "optional argument in statement function"); @@ -1509,7 +1570,8 @@ class ExprLowering { // Deal with potential mismatches in arguments types. Passing an array to // a scalar argument should for instance be tolerated here. - for (auto [fst,snd] : llvm::zip(caller.getInputs(), funcType.getInputs())) { + for (auto [fst, snd] : + llvm::zip(caller.getInputs(), funcType.getInputs())) { auto cast = builder.convertWithSemantics(getLoc(), snd, fst); operands.push_back(cast); } diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index f7f632ab48389..f81cfe6358aec 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -1643,13 +1643,83 @@ struct InsertValueOpConversion /// InsertOnRange inserts a value into a sequence over a range of offsets. struct InsertOnRangeOpConversion - : public FIROpAndTypeConversion { + : public FIROpAndTypeConversion, + public ValueOpCommon { using FIROpAndTypeConversion::FIROpAndTypeConversion; + // Increments an array of subscripts in a row major fasion. + void incrementSubscripts(const SmallVector &dims, + SmallVector &subscripts) const { + for (size_t i = dims.size(); i > 0; --i) { + if (++subscripts[i - 1] < dims[i - 1]) { + return; + } + subscripts[i - 1] = 0; + } + } + mlir::LogicalResult doRewrite(fir::InsertOnRangeOp range, mlir::Type ty, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - TODO(""); + assert(fir::allConstants(operands.drop_front(2))); + + llvm::SmallVector lowerBound; + llvm::SmallVector upperBound; + llvm::SmallVector dims; + auto type = operands[0].getType().dyn_cast(); + + // Iterativly extract the array dimensions from it's type. + while (type.isArrayTy()) { + dims.push_back(type.getArrayNumElements()); + type = type.getArrayElementType(); + } + + // Unzip the upper and lower bound subscripts. + for (std::size_t i = 2; i + 1 < operands.size(); i += 2) { + lowerBound.push_back(ExtractValueOpConversion::getValue(operands[i])); + upperBound.push_back(ExtractValueOpConversion::getValue(operands[i + 1])); + } + + llvm::SmallVector lBounds; + llvm::SmallVector uBounds; + + // Extract the integer value from the attribute bounds and convert to row + // major format. + for (size_t i = lowerBound.size(); i > 0; --i) { + lBounds.push_back(lowerBound[i - 1].cast().getInt()); + uBounds.push_back(upperBound[i - 1].cast().getInt()); + } + + auto subscripts(lBounds); + auto loc = range.getLoc(); + mlir::Value lastOp = operands[0]; + mlir::Value insertVal = operands[1]; + + while (subscripts != uBounds) { + // Convert uint64_t's to Attribute's. + llvm::SmallVector subscriptAttrs; + for (const auto &subscript : subscripts) + subscriptAttrs.push_back( + IntegerAttr::get(rewriter.getI64Type(), subscript)); + mlir::ArrayRef arrayRef(subscriptAttrs); + lastOp = rewriter.create( + loc, ty, lastOp, insertVal, + ArrayAttr::get(arrayRef, range.getContext())); + + incrementSubscripts(dims, subscripts); + } + + // Convert uint64_t's to Attribute's. + llvm::SmallVector subscriptAttrs; + for (const auto &subscript : subscripts) + subscriptAttrs.push_back( + IntegerAttr::get(rewriter.getI64Type(), subscript)); + mlir::ArrayRef arrayRef(subscriptAttrs); + + rewriter.replaceOpWithNewOp( + range, ty, lastOp, insertVal, + ArrayAttr::get(arrayRef, range.getContext())); + return success(); } }; diff --git a/flang/test/Lower/array.f90 b/flang/test/Lower/array.f90 index 7822096f026f4..a1ccb042066d8 100644 --- a/flang/test/Lower/array.f90 +++ b/flang/test/Lower/array.f90 @@ -14,6 +14,7 @@ subroutine s(i,j,k,ii,jj,kk,a1,a2,a3,a4,a5,a6,a7) integer a6(6:i,j:*) real a7(i:70,7:j,k:80) + ! CHECK-LABEL: BeginExternalListOutput ! CHECK-DAG: fir.load %arg3 : ! CHECK-DAG: %[[i1:.*]] = subi %{{.*}}, %[[one:c1.*]] : @@ -72,4 +73,62 @@ subroutine s(i,j,k,ii,jj,kk,a1,a2,a3,a4,a5,a6,a7) ! CHECK: fir.coordinate_of %[[a7]], %[[t7]] : ! CHECK-LABEL: EndIoStatement print *, a7(kk, jj, ii) + end subroutine s + +! CHECK-LABEL range +subroutine range() + ! Compile-time initalized arrays + ! CHECK-DAG: %[[c3_i32:.*]] = constant 3 : i32 + ! CHECK-DAG: %[[c9_i32:.*]] = constant 9 : i32 + ! CHECK-DAG: %[[c0:.*]] = constant 0 : index + ! CHECK-DAG: %[[c1:.*]] = constant 1 : index + ! CHECK-DAG: %[[c2:.*]] = constant 2 : index + ! CHECK-DAG: %[[c3:.*]] = constant 3 : index + ! CHECK-DAG: %[[c9:.*]] = constant 9 : index + integer, dimension(10) :: a0 + real, dimension(2,3) :: a1 + integer, dimension(3,4) :: a2 + + ! CHECK: %[[r1:.*]] = fir.insert_value %{{.*}}, %{{.*}}, %{{.*}} : + ! CHECK: %[[r2:.*]] = fir.insert_value %[[r1]], %{{.*}}, %{{.*}} : + ! CHECK: %[[r3:.*]] = fir.insert_on_range %[[r2]], %[[c3_i32]], %[[c2]], %[[c9]] : + a0 = (/1, 2, 3, 3, 3, 3, 3, 3, 3, 3/) + ! CHECK: %{{.*}} = fir.insert_on_range %{{[0-9]+}}, %{{.*}}, %[[c0]], %[[c1]], %[[c0]], %[[c2]] : + a1 = reshape((/3.5, 3.5, 3.5, 3.5, 3.5, 3.5/), shape(a1)) + ! CHECK: %[[r4:.*]] = fir.insert_value %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}} : + ! CHECK: %[[r5:.*]] = fir.insert_on_range %[[r4]], %[[c3_i32]], %[[c1]], %[[c2]], %[[c0]], %[[c0]] : + ! CHECK: %[[r6:.*]] = fir.insert_value %[[r5]], %{{.*}}, %{{.*}}, %{{.*}} : + ! CHECK: %[[r7:.*]] = fir.insert_on_range %[[r6]], %[[c3_i32]], %[[c1]], %[[c1]], %[[c1]], %[[c2]] : + ! CHECK: %[[r8:.*]] = fir.insert_on_range %[[r7]], %[[c9_i32]], %[[c2]], %[[c1]], %[[c2]], %[[c3]] : + ! CHECK: %[[r9:.*]] = fir.insert_value %[[r8]], %{{.*}}, %{{.*}}, %{{.*}} : + a2 = reshape((/1, 3, 3, 5, 3, 3, 3, 3, 9, 9, 9, 8/), shape(a2)) + +end subroutine range + +! CHECK-LABEL rangeGlobal +subroutine rangeGlobal() + ! CHECK-DAG: %[[c1_i32:.*]] = constant 1 : i32 + ! CHECK-DAG: %[[c2_i32:.*]] = constant 2 : i32 + ! CHECK-DAG: %[[c3_i32:.*]] = constant 3 : i32 + ! CHECK-DAG: %[[c0:.*]] = constant 0 : index + ! CHECK-DAG: %[[c1:.*]] = constant 1 : index + ! CHECK-DAG: %[[c2:.*]] = constant 2 : index + ! CHECK-DAG: %[[c3:.*]] = constant 3 : index + ! CHECK-DAG: %[[c4:.*]] = constant 4 : index + ! CHECK-DAG: %[[c5:.*]] = constant 5 : index + ! CHECK: %{{.*}} = fir.insert_on_range %{{.*}}, %[[c1_i32]], %[[c0]], %[[c1]] : + ! CHECK: %{{.*}} = fir.insert_on_range %{{.*}}, %[[c2_i32]], %[[c2]], %[[c3]] : + ! CHECK: %{{.*}} = fir.insert_on_range %{{.*}}, %[[c3_i32]], %[[c4]], %[[c5]] : + integer, dimension(6) :: a0 = (/ 1, 1, 2, 2, 3, 3 /) + +end subroutine rangeGlobal + +block data + real :: x(5,5) + common /block/ x + data x(1,1), x(2,1), x(3,1) / 1, 1, 0 / + data x(1,2), x(2,2), x(4,2) / 1, 1, 2.4 / + data x(1,3), x(2,3), x(4,3) / 1, 1, 2.4 / + data x(4,4) / 2.4 / +end From 0976ffcfd21b5d3e316dfddede689cbe873ad0e6 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 8 Oct 2020 18:51:40 -0700 Subject: [PATCH 0298/1017] rebase fallout --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index f81cfe6358aec..9ab54146c1a96 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -644,8 +644,10 @@ struct AllocMemOpConversion : public FIROpConversion { size = rewriter.create(loc, ity, size, opnd); heap.setAttr("callee", rewriter.getSymbolRefAttr(mallocFunc)); SmallVector args{size}; - rewriter.replaceOpWithNewOp(heap, ty, args, - heap.getAttrs()); + auto malloc = rewriter.create( + loc, getVoidPtrType(heap.getContext()), args, heap.getAttrs()); + rewriter.replaceOpWithNewOp(heap, ty, + malloc.getResult(0)); return success(); } }; @@ -1649,7 +1651,7 @@ struct InsertOnRangeOpConversion // Increments an array of subscripts in a row major fasion. void incrementSubscripts(const SmallVector &dims, - SmallVector &subscripts) const { + SmallVector &subscripts) const { for (size_t i = dims.size(); i > 0; --i) { if (++subscripts[i - 1] < dims[i - 1]) { return; From 0a54dea7aefbc90ad39e16646c64535f5945487c Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Tue, 13 Oct 2020 14:02:10 -0700 Subject: [PATCH 0299/1017] Modify loop generation code to focus on loop nests. (#472) * Modify loop generation code to focus on loop nests Looking at loops nests rather than individual loops makes do concurrent code generation a little nicer; makes the infrastructure usable for forall code generation; minimizes the additional changes needed for supporting forall constructs and statements; and allows forall assignment statement processing to be localized in one function. That (currently very small) function can then choose to generate either explicit control flow, or higher level array accesses, or some combination of the two. Temporization of forall assignments - (temp = rhs) + (lhs = temp) - is a largely orthogonal issue. Assignments that don't need temporization will now work, albeit with compilation time warnings about temporization. --- flang/lib/Lower/Bridge.cpp | 487 +++++++++++++++++---------------- flang/lib/Lower/PFTBuilder.cpp | 10 - 2 files changed, 255 insertions(+), 242 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 1e8f6292ad2ad..ce9a38cd29d1a 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -63,10 +63,14 @@ namespace { struct IncrementLoopInfo { template explicit IncrementLoopInfo(Fortran::semantics::Symbol &sym, const T &lower, - const T &upper, const std::optional &step) + const T &upper, const std::optional &step, + bool isUnordered = false) : loopVariableSym{sym}, lowerExpr{Fortran::semantics::GetExpr(lower)}, upperExpr{Fortran::semantics::GetExpr(upper)}, - stepExpr{Fortran::semantics::GetExpr(step)} {} + stepExpr{Fortran::semantics::GetExpr(step)}, isUnordered{isUnordered} {} + + IncrementLoopInfo(IncrementLoopInfo &&) = default; + IncrementLoopInfo &operator=(IncrementLoopInfo &&x) { return x; } bool isStructured() const { return !headerBlock; } @@ -76,9 +80,7 @@ struct IncrementLoopInfo { const Fortran::semantics::SomeExpr *upperExpr; const Fortran::semantics::SomeExpr *stepExpr; const Fortran::semantics::SomeExpr *maskExpr = nullptr; - bool isUnordered = false; - bool isOutermost = true; - bool isInnermost = true; + bool isUnordered; // do concurrent, forall llvm::SmallVector localInitSymList; mlir::Value loopVariable = nullptr; mlir::Value stepValue = nullptr; // possible uses in multiple blocks @@ -94,6 +96,8 @@ struct IncrementLoopInfo { mlir::Block *bodyBlock = nullptr; // first loop body block mlir::Block *exitBlock = nullptr; // loop exit target block }; + +using IncrementLoopNestInfo = llvm::SmallVector; } // namespace // Retrieve a copy of a character literal string from a SomeExpr. @@ -591,22 +595,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->create(toLocation(), res, indexList, blockList); } - void genFIR(const Fortran::parser::IfStmt &stmt) { - auto &eval = getEval(); - if (eval.lowerAsUnstructured()) { - genFIRConditionalBranch( - std::get(stmt.t), - eval.lexicalSuccessor, eval.controlSuccessor); - return; - } - - // Generate fir.if. - auto pair = genIfCondition(&stmt, /*withElse=*/false); - genFIR(*eval.lexicalSuccessor, /*unstructuredContext=*/false); - eval.lexicalSuccessor->skip = true; - builder->restoreInsertionPoint(pair.first); - } - void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) { auto &eval = getEval(); auto selectExpr = createFIRExpr( @@ -717,6 +705,30 @@ class FirConverter : public Fortran::lower::AbstractConverter { builder->create(loc, selectExpr, indexList, blockList); } + /// Collect DO CONCURRENT or FORALL loop control information. + IncrementLoopNestInfo getConcurrentControl( + const Fortran::parser::ConcurrentHeader &header, + const std::list &localityList = {}) { + IncrementLoopNestInfo incrementLoopNestInfo; + for (const auto &control : + std::get>(header.t)) + incrementLoopNestInfo.emplace_back( + *std::get<0>(control.t).symbol, std::get<1>(control.t), + std::get<2>(control.t), std::get<3>(control.t), true); + auto &info = incrementLoopNestInfo.back(); + info.maskExpr = Fortran::semantics::GetExpr( + std::get>(header.t)); + for (const auto &x : localityList) { + if (const auto *localInitList = + std::get_if(&x.u)) + for (const auto &x : localInitList->v) + info.localInitSymList.push_back(x.symbol); + if (std::get_if(&x.u)) + TODO("do concurrent locality specs not implemented"); + } + return incrementLoopNestInfo; + } + /// Generate FIR for a DO construct. There are six variants: /// - unstructured infinite and while loops /// - structured and unstructured increment loops @@ -735,7 +747,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { unstructuredContext ? doStmtEval.localBlocks[0] : nullptr; auto *bodyBlock = doStmtEval.lexicalSuccessor->block; auto *exitBlock = doStmtEval.parentConstruct->constructExit->block; - llvm::SmallVector incrementLoopInfo; + IncrementLoopNestInfo incrementLoopNestInfo; const Fortran::parser::ScalarLogicalExpr *whileCondition = nullptr; bool infiniteLoop = !loopControl.has_value(); if (infiniteLoop) { @@ -751,11 +763,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { std::get_if( &loopControl->u)) { // Non-concurrent increment loop. - incrementLoopInfo.emplace_back(*bounds->name.thing.symbol, bounds->lower, - bounds->upper, bounds->step); + auto &info = incrementLoopNestInfo.emplace_back( + *bounds->name.thing.symbol, bounds->lower, bounds->upper, + bounds->step); if (unstructuredContext) { maybeStartBlock(preheaderBlock); - auto &info = incrementLoopInfo.back(); info.hasRealControl = info.loopVariableSym.GetType()->IsNumeric( Fortran::common::TypeCategory::Real); info.headerBlock = headerBlock; @@ -767,226 +779,223 @@ class FirConverter : public Fortran::lower::AbstractConverter { std::get_if( &loopControl->u); assert(concurrent && "invalid DO loop variant"); - if (unstructuredContext) + incrementLoopNestInfo = getConcurrentControl( + std::get(concurrent->t), + std::get>(concurrent->t)); + if (unstructuredContext) { maybeStartBlock(preheaderBlock); - const auto &header = - std::get(concurrent->t); - auto &concurrentControlList = - std::get>(header.t); - auto dims = concurrentControlList.size(); - auto &endDoStmtEval = *doStmtEval.controlSuccessor; - auto beginBlocks = doStmtEval.localBlocks.begin(); - auto endBlocks = endDoStmtEval.localBlocks.end(); - decltype(dims) d = 0; - for (const auto &control : concurrentControlList) { - incrementLoopInfo.emplace_back( - *std::get<0>(control.t).symbol, std::get<1>(control.t), - std::get<2>(control.t), std::get<3>(control.t)); - auto &info = incrementLoopInfo.back(); - info.isUnordered = true; - info.isOutermost = ++d == 1; - info.isInnermost = d == dims; - if (info.isInnermost) { - for (const auto &x : - std::get>( - concurrent->t)) { - if (const auto *localInitList = - std::get_if(&x.u)) - for (const auto &x : localInitList->v) - info.localInitSymList.push_back(x.symbol); - if (std::get_if(&x.u)) - llvm_unreachable("do concurrent locality specs not implemented"); + auto &endDoStmtEval = *doStmtEval.controlSuccessor; + auto beginBlocks = doStmtEval.localBlocks.begin(); + auto endBlocks = endDoStmtEval.localBlocks.end(); + for (auto &info : incrementLoopNestInfo) { + // The original loop body provides the body and latch blocks of the + // innermost dimension. The (first) body block of a non-innermost + // dimension is the preheader block of the immediately enclosed + // dimension. The latch block of a non-innermost dimension is the + // exit block of the immediately enclosed dimension. Blocks are + // generated "in order". + auto isInnermost = &info == &incrementLoopNestInfo.back(); + auto isOutermost = &info == &incrementLoopNestInfo.front(); + info.headerBlock = *beginBlocks++; + info.bodyBlock = isInnermost ? bodyBlock : *beginBlocks++; + info.exitBlock = isOutermost ? exitBlock : *--endBlocks; + if (info.maskExpr) { + assert(endDoStmtEval.block && + "missing masked concurrent loop latch block"); + info.maskBlock = *beginBlocks++; } } - if (!unstructuredContext) - continue; - // Unstructured concurrent loop - The original loop body provides the - // body and latch blocks of the innermost dimension. The (first) body - // block of a non-innermost dimension is the preheader block of the - // immediately enclosed dimension. The latch block of a non-innermost - // dimension is the exit block of the immediately enclosed dimension. - // Blocks are generated "in order". - info.headerBlock = *beginBlocks++; - info.bodyBlock = info.isInnermost ? bodyBlock : *beginBlocks++; - info.exitBlock = info.isOutermost ? exitBlock : *--endBlocks; - } - if (auto *maskExpr = Fortran::semantics::GetExpr( - std::get>( - header.t))) { - auto &info = incrementLoopInfo.back(); - info.maskExpr = maskExpr; - if (unstructuredContext) { - assert(endDoStmtEval.block && - "missing masked concurrent loop latch block"); - info.maskBlock = *beginBlocks++; - } + assert(beginBlocks == doStmtEval.localBlocks.end() && + "concurrent header+body+mask block count mismatch"); + assert(endBlocks == endDoStmtEval.localBlocks.begin() && + "concurrent latch block count mismatch"); } - assert(beginBlocks == doStmtEval.localBlocks.end() && - "concurrent header+body+mask block count mismatch"); - assert(endBlocks == endDoStmtEval.localBlocks.begin() && - "concurrent latch block count mismatch"); } - // Generate increment loop begin code. - // (Infinite and while loop begin code has already been generated.) - for (auto &info : incrementLoopInfo) - genFIRIncrementLoopBegin(info); + // Increment loop begin code. (Infinite/while code was already generated.) + if (!infiniteLoop && !whileCondition) + genFIRIncrementLoopBegin(incrementLoopNestInfo); - // Generate loop body code. The NonLabelDoStmt and EndDoStmt genFIR calls - // are nops, since their code is generated directly here. However, their - // genFIR wrapper calls are needed for block management in some cases. + // Loop body code - NonLabelDoStmt and EndDoStmt code is generated here. + // Their genFIR calls are nops except for block management in some cases. for (auto &e : eval.getNestedEvaluations()) genFIR(e, unstructuredContext); - // Generate loop end code. - if (infiniteLoop || whileCondition) { + // Loop end code. + if (infiniteLoop || whileCondition) genFIRBranch(headerBlock); - } else { - for (auto d = incrementLoopInfo.size(); d > 0;) - genFIRIncrementLoopEnd(incrementLoopInfo[--d]); - } + else + genFIRIncrementLoopEnd(incrementLoopNestInfo); } /// Generate FIR to begin a structured or unstructured increment loop. - void genFIRIncrementLoopBegin(IncrementLoopInfo &info) { + void genFIRIncrementLoopBegin(IncrementLoopNestInfo &incrementLoopNestInfo) { + assert(!incrementLoopNestInfo.empty() && "empty loop nest"); auto loc = toLocation(); - info.loopVariable = createTemp(loc, info.loopVariableSym); - auto controlType = info.isStructured() ? builder->getIndexType() - : genType(info.loopVariableSym); + auto controlType = incrementLoopNestInfo[0].isStructured() + ? builder->getIndexType() + : genType(incrementLoopNestInfo[0].loopVariableSym); + auto hasRealControl = incrementLoopNestInfo[0].hasRealControl; auto genControlValue = [&](const Fortran::semantics::SomeExpr *expr) { if (expr) return builder->createConvert(loc, controlType, createFIRExpr(loc, expr)); - if (!info.hasRealControl) + if (!hasRealControl) return builder->createIntegerConstant(loc, controlType, 1); // step auto one = builder->createIntegerConstant(loc, builder->getIndexType(), 1); return builder->createConvert(loc, controlType, one); // real step }; - auto lowerValue = genControlValue(info.lowerExpr); - auto upperValue = genControlValue(info.upperExpr); - info.stepValue = genControlValue(info.stepExpr); - - auto genLocalInitAssignments = [&]() { + auto genLocalInitAssignments = [](IncrementLoopInfo &info) { for (const auto *sym : info.localInitSymList) { - llvm_unreachable("do concurrent locality specs not implemented"); const auto *hostDetails = sym->detailsIf(); assert(hostDetails && "missing local_init variable host variable"); [[maybe_unused]] const Fortran::semantics::Symbol &hostSym = hostDetails->symbol(); + TODO("do concurrent locality specs not implemented"); // assign sym = hostSym } }; + for (auto &info : incrementLoopNestInfo) { + info.loopVariable = createTemp(loc, info.loopVariableSym); + auto lowerValue = genControlValue(info.lowerExpr); + auto upperValue = genControlValue(info.upperExpr); + info.stepValue = genControlValue(info.stepExpr); + + // Structured loop - generate fir.do_loop. + if (info.isStructured()) { + info.doLoop = builder->create( + loc, lowerValue, upperValue, info.stepValue, info.isUnordered, + ArrayRef{lowerValue}); // initial doLoop result value + builder->setInsertionPointToStart(info.doLoop.getBody()); + // Update the loop variable value, as it may have non-index references. + auto value = builder->createConvert(loc, genType(info.loopVariableSym), + info.doLoop.getInductionVar()); + builder->create(loc, value, info.loopVariable); + if (info.maskExpr) { + auto ifOp = builder->create( + loc, createFIRExpr(loc, info.maskExpr), /*withElseRegion=*/false); + builder->setInsertionPointToStart(&ifOp.thenRegion().front()); + } + genLocalInitAssignments(info); + continue; + } - // Structured loop - generate fir.do_loop. - if (info.isStructured()) { - info.doLoop = builder->create( - loc, lowerValue, upperValue, info.stepValue, info.isUnordered, - ArrayRef{lowerValue}); // initial doLoop result value - builder->setInsertionPointToStart(info.doLoop.getBody()); - // Update the loop variable value, as it may have non-index references. - auto value = builder->createConvert(loc, genType(info.loopVariableSym), - info.doLoop.getInductionVar()); - builder->create(loc, value, info.loopVariable); + // Unstructured loop preheader - initialize tripVariable and loopVariable. + mlir::Value tripCount; + if (info.hasRealControl) { + auto diff1 = builder->create(loc, upperValue, lowerValue); + auto diff2 = builder->create(loc, diff1, info.stepValue); + tripCount = builder->create(loc, diff2, info.stepValue); + controlType = builder->getIndexType(); + tripCount = builder->createConvert(loc, controlType, tripCount); + } else { + auto diff1 = builder->create(loc, upperValue, lowerValue); + auto diff2 = builder->create(loc, diff1, info.stepValue); + tripCount = + builder->create(loc, diff2, info.stepValue); + } + if (fir::isAlwaysExecuteLoopBody()) { // minimum tripCount is 1 + auto one = builder->createIntegerConstant(loc, controlType, 1); + auto cond = builder->create(loc, CmpIPredicate::slt, + tripCount, one); + tripCount = builder->create(loc, cond, one, tripCount); + } + info.tripVariable = builder->createTemporary(loc, controlType); + builder->create(loc, tripCount, info.tripVariable); + builder->create(loc, lowerValue, info.loopVariable); + + // Unstructured loop header - generate loop condition and mask. + // Note - Currently there is no way to tag a loop as a concurrent loop. + startBlock(info.headerBlock); + tripCount = builder->create(loc, info.tripVariable); + auto zero = builder->createIntegerConstant(loc, controlType, 0); + auto cond = builder->create(loc, mlir::CmpIPredicate::sgt, + tripCount, zero); if (info.maskExpr) { - auto ifOp = builder->create( - loc, createFIRExpr(loc, info.maskExpr), /*withElseRegion=*/false); - builder->setInsertionPointToStart(&ifOp.thenRegion().front()); + genFIRConditionalBranch(cond, info.maskBlock, info.exitBlock); + startBlock(info.maskBlock); + auto latchBlock = getEval().getLastNestedEvaluation().block; + assert(latchBlock && "missing masked concurrent loop latch block"); + genFIRConditionalBranch(createFIRExpr(loc, info.maskExpr), + info.bodyBlock, latchBlock); + } else { + genFIRConditionalBranch(cond, info.bodyBlock, info.exitBlock); + if (&info != &incrementLoopNestInfo.back()) // not innermost + startBlock(info.bodyBlock); // preheader block of enclosed dimension + } + if (!info.localInitSymList.empty()) { + auto insertPt = builder->saveInsertionPoint(); + builder->setInsertionPointToStart(info.bodyBlock); + genLocalInitAssignments(info); + builder->restoreInsertionPoint(insertPt); } - genLocalInitAssignments(); - return; - } - - // Unstructured loop preheader - initialize tripVariable and loopVariable. - mlir::Value tripCount; - if (info.hasRealControl) { - auto delta1 = builder->create(loc, upperValue, lowerValue); - auto delta2 = builder->create(loc, delta1, info.stepValue); - tripCount = builder->create(loc, delta2, info.stepValue); - controlType = builder->getIndexType(); - tripCount = builder->createConvert(loc, controlType, tripCount); - } else { - auto delta1 = builder->create(loc, upperValue, lowerValue); - auto delta2 = builder->create(loc, delta1, info.stepValue); - tripCount = - builder->create(loc, delta2, info.stepValue); - } - if (fir::isAlwaysExecuteLoopBody()) { // minimum tripCount is 1 - auto one = builder->createIntegerConstant(loc, controlType, 1); - auto cond = builder->create(loc, CmpIPredicate::slt, - tripCount, one); - tripCount = builder->create(loc, cond, one, tripCount); - } - info.tripVariable = builder->createTemporary(loc, controlType); - builder->create(loc, tripCount, info.tripVariable); - builder->create(loc, lowerValue, info.loopVariable); - - // Unstructured loop header - generate loop condition and mask. - // Note - Currently there is no way to tag a loop as a concurrent loop. - startBlock(info.headerBlock); - tripCount = builder->create(loc, info.tripVariable); - auto zero = builder->createIntegerConstant(loc, controlType, 0); - auto cond = builder->create(loc, mlir::CmpIPredicate::sgt, - tripCount, zero); - if (info.maskExpr) { - genFIRConditionalBranch(cond, info.maskBlock, info.exitBlock); - startBlock(info.maskBlock); - auto latchBlock = getEval().getLastNestedEvaluation().block; - assert(latchBlock && "missing masked concurrent loop latch block"); - genFIRConditionalBranch(createFIRExpr(loc, info.maskExpr), info.bodyBlock, - latchBlock); - } else { - genFIRConditionalBranch(cond, info.bodyBlock, info.exitBlock); - if (!info.isInnermost) - startBlock(info.bodyBlock); // preheader block of enclosed dimension - } - if (!info.localInitSymList.empty()) { - auto insertPt = builder->saveInsertionPoint(); - builder->setInsertionPointToStart(info.bodyBlock); - genLocalInitAssignments(); - builder->restoreInsertionPoint(insertPt); } } /// Generate FIR to end a structured or unstructured increment loop. - void genFIRIncrementLoopEnd(IncrementLoopInfo &info) { + void genFIRIncrementLoopEnd(IncrementLoopNestInfo &incrementLoopNestInfo) { + assert(!incrementLoopNestInfo.empty() && "empty loop nest"); auto loc = toLocation(); - if (info.isStructured()) { - // End fir.do_loop. A concurrent loop result is illegitimate/irrelevant. - builder->setInsertionPointToEnd(info.doLoop.getBody()); - auto result = info.doLoop.getInductionVar(); - if (!info.isUnordered) - result = builder->create(loc, result, info.doLoop.step()); - builder->create(loc, result); - builder->setInsertionPointAfter(info.doLoop); - if (info.isUnordered) - return; - // The loop control variable may be used after loop execution. - auto lcv = builder->createConvert(loc, genType(info.loopVariableSym), - info.doLoop.getResult(0)); - builder->create(loc, lcv, info.loopVariable); - return; + for (auto it = incrementLoopNestInfo.rbegin(), + rend = incrementLoopNestInfo.rend(); + it != rend; ++it) { + auto &info = *it; + if (info.isStructured()) { + // End fir.do_loop; an unordered loop result is illegitimate/irrelevant. + builder->setInsertionPointToEnd(info.doLoop.getBody()); + auto result = info.doLoop.getInductionVar(); + if (!info.isUnordered) + result = + builder->create(loc, result, info.doLoop.step()); + builder->create(loc, result); + builder->setInsertionPointAfter(info.doLoop); + if (info.isUnordered) + continue; + // The loop control variable may be used after loop execution. + auto lcv = builder->createConvert(loc, genType(info.loopVariableSym), + info.doLoop.getResult(0)); + builder->create(loc, lcv, info.loopVariable); + continue; + } + + // Unstructured loop - decrement tripVariable and step loopVariable. + mlir::Value tripCount = + builder->create(loc, info.tripVariable); + auto tripVarType = info.hasRealControl ? builder->getIndexType() + : genType(info.loopVariableSym); + auto one = builder->createIntegerConstant(loc, tripVarType, 1); + tripCount = builder->create(loc, tripCount, one); + builder->create(loc, tripCount, info.tripVariable); + mlir::Value value = builder->create(loc, info.loopVariable); + if (info.hasRealControl) + value = builder->create(loc, value, info.stepValue); + else + value = builder->create(loc, value, info.stepValue); + builder->create(loc, value, info.loopVariable); + + genFIRBranch(info.headerBlock); + if (&info != &incrementLoopNestInfo.front()) // not outermost + startBlock(info.exitBlock); // latch block of enclosing dimension } + } - // Unstructured loop - decrement tripVariable and step loopVariable. - mlir::Value tripCount = - builder->create(loc, info.tripVariable); - auto tripVarType = info.hasRealControl ? builder->getIndexType() - : genType(info.loopVariableSym); - auto one = builder->createIntegerConstant(loc, tripVarType, 1); - tripCount = builder->create(loc, tripCount, one); - builder->create(loc, tripCount, info.tripVariable); - mlir::Value value = builder->create(loc, info.loopVariable); - if (info.hasRealControl) - value = builder->create(loc, value, info.stepValue); - else - value = builder->create(loc, value, info.stepValue); - builder->create(loc, value, info.loopVariable); + /// Generate structured or unstructured FIR for an IF statement.. + void genFIR(const Fortran::parser::IfStmt &stmt) { + auto &eval = getEval(); + if (eval.lowerAsUnstructured()) { + genFIRConditionalBranch( + std::get(stmt.t), + eval.lexicalSuccessor, eval.controlSuccessor); + return; + } - genFIRBranch(info.headerBlock); - if (!info.isOutermost) - startBlock(info.exitBlock); // latch block of enclosing dimension + // Generate fir.if. + auto pair = genIfCondition(&stmt, /*withElse=*/false); + genFIR(*eval.lexicalSuccessor, /*unstructuredContext=*/false); + eval.lexicalSuccessor->skip = true; + builder->restoreInsertionPoint(pair.first); } /// Generate structured or unstructured FIR for an IF construct. @@ -1044,26 +1053,37 @@ class FirConverter : public Fortran::lower::AbstractConverter { genFIR(e); } - /// Lower FORALL construct (See 10.2.4) - void genFIR(const Fortran::parser::ForallConstruct &forall) { - auto &stmt = std::get< + /// Generate FIR for a FORALL statement.. + void genFIR(const Fortran::parser::ForallStmt &forallStmt) { + auto incrementLoopNestInfo = getConcurrentControl( + std::get< + Fortran::common::Indirection>( + forallStmt.t) + .value()); + auto &forallAssignment = std::get>(forallStmt.t); + genFIR(incrementLoopNestInfo, forallAssignment.statement); + } + + /// Generate FIR for a FORALL construct. + void genFIR(const Fortran::parser::ForallConstruct &forallConstruct) { + auto &forallConstructStmt = std::get< Fortran::parser::Statement>( - forall.t); - setCurrentPosition(stmt.source); - auto &fas = stmt.statement; - [[maybe_unused]] auto &ctrl = + forallConstruct.t); + setCurrentPosition(forallConstructStmt.source); + auto incrementLoopNestInfo = getConcurrentControl( std::get< Fortran::common::Indirection>( - fas.t) - .value(); - for (auto &s : - std::get>(forall.t)) { + forallConstructStmt.statement.t) + .value()); + for (auto &s : std::get>( + forallConstruct.t)) { std::visit( Fortran::common::visitors{ [&](const Fortran::parser::Statement< Fortran::parser::ForallAssignmentStmt> &b) { setCurrentPosition(b.source); - genFIR(b.statement); + genFIR(incrementLoopNestInfo, b.statement); }, [&](const Fortran::parser::Statement &b) { @@ -1081,11 +1101,16 @@ class FirConverter : public Fortran::lower::AbstractConverter { }, s.u); } - TODO(""); } - void genFIR(const Fortran::parser::ForallAssignmentStmt &s) { + /// Generate FIR for a FORALL assignment statement. + void genFIR(IncrementLoopNestInfo &incrementLoopNestInfo, + const Fortran::parser::ForallAssignmentStmt &s) { + genFIRIncrementLoopBegin(incrementLoopNestInfo); + mlir::emitWarning(toLocation(), "Forall assignments are not temporized, " + "so may be invalid\n"); std::visit([&](auto &b) { genFIR(b); }, s.u); + genFIRIncrementLoopEnd(incrementLoopNestInfo); } void genFIR(const Fortran::parser::CompilerDirective &) { @@ -1179,14 +1204,20 @@ class FirConverter : public Fortran::lower::AbstractConverter { valueList, blockList); } - void genFIR(const Fortran::parser::CaseStmt &) {} // nop - void genFIR(const Fortran::parser::EndSelectStmt &) {} // nop - void genFIR(const Fortran::parser::NonLabelDoStmt &) {} // nop - void genFIR(const Fortran::parser::EndDoStmt &) {} // nop - void genFIR(const Fortran::parser::IfThenStmt &) {} // nop - void genFIR(const Fortran::parser::ElseIfStmt &) {} // nop - void genFIR(const Fortran::parser::ElseStmt &) {} // nop - void genFIR(const Fortran::parser::EndIfStmt &) {} // nop + // Nop statements - Code is generated elsewhere, often at the construct level. + void genFIR(const Fortran::parser::CaseStmt &) {} // nop + void genFIR(const Fortran::parser::EndSelectStmt &) {} // nop + void genFIR(const Fortran::parser::ContinueStmt &) {} // nop + void genFIR(const Fortran::parser::NonLabelDoStmt &) {} // nop + void genFIR(const Fortran::parser::EndDoStmt &) {} // nop + void genFIR(const Fortran::parser::EntryStmt &) {} // nop + void genFIR(const Fortran::parser::IfThenStmt &) {} // nop + void genFIR(const Fortran::parser::ElseIfStmt &) {} // nop + void genFIR(const Fortran::parser::ElseStmt &) {} // nop + void genFIR(const Fortran::parser::EndIfStmt &) {} // nop + void genFIR(const Fortran::parser::ForallConstructStmt &) {} // nop + void genFIR(const Fortran::parser::ForallAssignmentStmt &s) {} // nop + void genFIR(const Fortran::parser::EndForallStmt &) {} // nop void genFIR(const Fortran::parser::AssociateConstruct &) { TODO(""); } void genFIR(const Fortran::parser::AssociateStmt &) { TODO(""); } @@ -1354,8 +1385,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { //===--------------------------------------------------------------------===// - void genFIR(const Fortran::parser::ContinueStmt &) {} // nop - void genFIR(const Fortran::parser::EventPostStmt &stmt) { genEventPostStatement(*this, stmt); } @@ -1560,10 +1589,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::EndWhereStmt &) { TODO(""); } void genFIR(const Fortran::parser::WhereStmt &) { TODO(""); } - void genFIR(const Fortran::parser::ForallConstructStmt &) { TODO(""); } - void genFIR(const Fortran::parser::EndForallStmt &) { TODO(""); } - void genFIR(const Fortran::parser::ForallStmt &) { TODO(""); } - void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) { genAssignment(*stmt.typedAssignment->v); } @@ -1607,8 +1632,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { // data transfer statement. } - void genFIR(const Fortran::parser::EntryStmt &) {} // nop - void genFIR(const Fortran::parser::PauseStmt &stmt) { genPauseStatement(*this, stmt); } @@ -1671,7 +1694,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(Fortran::lower::pft::Evaluation &eval, bool unstructuredContext = true) { if (eval.skip) - return; // rhs of {Forall,If,Where}Stmt has already been processed + return; // rhs of IfStmt has already been processed if (unstructuredContext) { // When transitioning from unstructured to structured code, diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 931dd3f6d12ea..856ba342dc2bf 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -131,16 +131,6 @@ class PFTBuilder { } // Get rid of production wrapper - bool Pre(const parser::UnlabeledStatement - &statement) { - addEvaluation(std::visit( - [&](const auto &x) { - return lower::pft::Evaluation{ - x, parentVariantStack.back(), statement.source, {}}; - }, - statement.statement.u)); - return false; - } bool Pre(const parser::Statement &statement) { addEvaluation(std::visit( [&](const auto &x) { From c6007070d219d6f69fba2754d7c8a2fdc547aba9 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 13 Oct 2020 05:59:56 -0700 Subject: [PATCH 0300/1017] Replace some asserts by array expressions TODOs --- flang/lib/Lower/ConvertExpr.cpp | 40 ++++++++++++++++++++------------- 1 file changed, 25 insertions(+), 15 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 4392c53e03951..414526d9e2f4b 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -88,7 +88,7 @@ class ExprLowering { auto e = genval(expr); if (auto *r = e.getUnboxed()) return *r; - llvm::report_fatal_error("value is not unboxed"); + return {}; } /// Convert parser's INTEGER relational operators to MLIR. TODO: using @@ -170,12 +170,10 @@ class ExprLowering { mlir::Value createBinaryOp(const fir::ExtendedValue &left, const fir::ExtendedValue &right) { if (auto *lhs = left.getUnboxed()) - if (auto *rhs = right.getUnboxed()) { - assert(lhs && rhs && "argument did not lower"); + if (auto *rhs = right.getUnboxed()) return builder.create(getLoc(), *lhs, *rhs); - } // binary ops can appear in array contexts - TODO(""); + TODO("Array expression binary operation"); } template mlir::Value createBinaryOp(const A &ex) { @@ -430,7 +428,8 @@ class ExprLowering { fir::ExtendedValue genval(const Fortran::evaluate::ComplexComponent &part) { auto lhs = genunbox(part.left()); - assert(lhs && "boxed type not handled"); + if (!lhs) + TODO("Array expression complex component"); return extractComplexPart(lhs, part.isImaginaryPart); } @@ -438,7 +437,8 @@ class ExprLowering { fir::ExtendedValue genval( const Fortran::evaluate::Negate> &op) { auto input = genunbox(op.left()); - assert(input && "boxed value not handled"); + if (!input) + TODO("Array expression negation"); if constexpr (TC == Fortran::common::TypeCategory::Integer) { // Currently no Standard/FIR op for integer negation. auto zero = genIntegerConstant(builder.getContext(), 0); @@ -515,7 +515,8 @@ class ExprLowering { auto ty = converter.genType(TC, KIND); auto lhs = genunbox(op.left()); auto rhs = genunbox(op.right()); - assert(lhs && rhs && "boxed value not handled"); + if (!lhs || !rhs) + TODO("Array expression power"); return Fortran::lower::genPow(builder, getLoc(), ty, lhs, rhs); } @@ -526,7 +527,8 @@ class ExprLowering { auto ty = converter.genType(TC, KIND); auto lhs = genunbox(op.left()); auto rhs = genunbox(op.right()); - assert(lhs && rhs && "boxed value not handled"); + if (!lhs || !rhs) + TODO("Array expression power"); return Fortran::lower::genPow(builder, getLoc(), ty, lhs, rhs); } @@ -541,7 +543,8 @@ class ExprLowering { genval(const Fortran::evaluate::ComplexConstructor &op) { auto lhs = genunbox(op.left()); auto rhs = genunbox(op.right()); - assert(lhs && rhs && "boxed value not handled"); + if (!lhs || !rhs) + TODO("Array expression complex ctor"); return createComplex(KIND, lhs, rhs); } @@ -564,7 +567,8 @@ class ExprLowering { &op) { auto lhs = genunbox(op.left()); auto rhs = genunbox(op.right()); - assert(lhs && rhs && "boxed value not handled"); + if (!lhs || !rhs) + TODO("Array expression extremum"); llvm::SmallVector operands{lhs, rhs}; if (op.ordering == Fortran::evaluate::Ordering::Greater) return Fortran::lower::genMax(builder, getLoc(), operands); @@ -596,7 +600,8 @@ class ExprLowering { llvm_unreachable("relation undefined for complex"); auto lhs = genunbox(op.left()); auto rhs = genunbox(op.right()); - assert(lhs && rhs && "boxed value not handled"); + if (!lhs || !rhs) + TODO("Array expression comparisons"); return createComplexCompare(lhs, rhs, eq); } else { static_assert(TC == Fortran::common::TypeCategory::Character); @@ -616,7 +621,8 @@ class ExprLowering { TC2> &convert) { auto ty = converter.genType(TC1, KIND); auto operand = genunbox(convert.left()); - assert(operand && "boxed value not handled"); + if (!operand) + TODO("Array expression conversion"); return builder.createConvert(getLoc(), ty, operand); } @@ -633,7 +639,8 @@ class ExprLowering { fir::ExtendedValue genval(const Fortran::evaluate::Not &op) { auto *context = builder.getContext(); auto logical = genunbox(op.left()); - assert(logical && "boxed value not handled"); + if (!logical) + TODO("Array expression negation"); auto one = genBoolConstant(context, true); auto val = builder.createConvert(getLoc(), builder.getI1Type(), logical); return builder.create(getLoc(), val, one); @@ -645,7 +652,8 @@ class ExprLowering { auto i1Type = builder.getI1Type(); auto slhs = genunbox(op.left()); auto srhs = genunbox(op.right()); - assert(slhs && srhs && "boxed value not handled"); + if (!slhs || !srhs) + TODO("Array expression logical operation"); auto lhs = builder.createConvert(getLoc(), i1Type, slhs); auto rhs = builder.createConvert(getLoc(), i1Type, srhs); switch (op.logicalOperator) { @@ -989,6 +997,8 @@ class ExprLowering { mlir::Value upper; if (auto up = trip.upper()) upper = genunbox(*up); + if (!upper || !lower) + llvm::report_fatal_error("triplet not lowered to unboxed values"); return {lower, upper, genunbox(trip.stride())}; } From f4964a87f0d684b2b7f2c8d3a8d40a7b4ef38ef9 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 13 Oct 2020 13:31:00 -0700 Subject: [PATCH 0301/1017] Tighten type checking and correct complex type mismatches. --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 96 +++++++++++++------------ 1 file changed, 49 insertions(+), 47 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 9ab54146c1a96..2397e2daf269a 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -1026,6 +1026,12 @@ struct ConstfOpConversion : public FIROpConversion { } }; +static mlir::Type getComplexEleTy(mlir::Type complex) { + if (auto cc = complex.dyn_cast()) + return cc.getElementType(); + return complex.cast().getElementType(); +} + /// convert value of from-type to value of to-type struct ConvertOpConversion : public FIROpConversion { using FIROpConversion::FIROpConversion; @@ -1076,11 +1082,9 @@ struct ConvertOpConversion : public FIROpConversion { convert.getContext()); auto one = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), convert.getContext()); - auto rp = - rewriter.create(loc, fromTy_, op0, zero); - auto ip = - rewriter.create(loc, fromTy_, op0, one); auto ty = convertType(getComplexEleTy(convert.value().getType())); + auto rp = rewriter.create(loc, ty, op0, zero); + auto ip = rewriter.create(loc, ty, op0, one); auto nt = convertType(getComplexEleTy(convert.res().getType())); auto fromBits = unwrap(ty).getPrimitiveSizeInBits(); auto toBits = unwrap(nt).getPrimitiveSizeInBits(); @@ -1137,12 +1141,6 @@ struct ConvertOpConversion : public FIROpConversion { } return emitError(loc) << "cannot convert " << fromTy_ << " to " << toTy_; } - - static mlir::Type getComplexEleTy(mlir::Type complex) { - if (auto cc = complex.dyn_cast()) - return cc.getElementType(); - return complex.cast().getElementType(); - } }; /// virtual call to a method in a dispatch table @@ -2661,13 +2659,14 @@ mlir::LLVM::InsertValueOp complexSum(OPTY sumop, OperandTy opnds, auto ctx = sumop.getContext(); auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + auto eleTy = lowering.convertType(getComplexEleTy(sumop.getType())); auto ty = lowering.convertType(sumop.getType()); - auto x = rewriter.create(loc, ty, a, c0); - auto x_ = rewriter.create(loc, ty, b, c0); - auto rx = rewriter.create(loc, ty, x, x_); - auto y = rewriter.create(loc, ty, a, c1); - auto y_ = rewriter.create(loc, ty, b, c1); - auto ry = rewriter.create(loc, ty, y, y_); + auto x = rewriter.create(loc, eleTy, a, c0); + auto y = rewriter.create(loc, eleTy, a, c1); + auto x_ = rewriter.create(loc, eleTy, b, c0); + auto y_ = rewriter.create(loc, eleTy, b, c1); + auto rx = rewriter.create(loc, eleTy, x, x_); + auto ry = rewriter.create(loc, eleTy, y, y_); auto r = rewriter.create(loc, ty); auto r_ = rewriter.create(loc, ty, r, rx, c0); return rewriter.create(loc, ty, r_, ry, c1); @@ -2721,17 +2720,18 @@ struct MulcOpConversion : public FIROpConversion { auto ctx = mulc.getContext(); auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + auto eleTy = convertType(getComplexEleTy(mulc.getType())); auto ty = convertType(mulc.getType()); - auto x = rewriter.create(loc, ty, a, c0); - auto x_ = rewriter.create(loc, ty, b, c0); - auto xx_ = rewriter.create(loc, ty, x, x_); - auto y = rewriter.create(loc, ty, a, c1); - auto yx_ = rewriter.create(loc, ty, y, x_); - auto y_ = rewriter.create(loc, ty, b, c1); - auto xy_ = rewriter.create(loc, ty, x, y_); - auto ri = rewriter.create(loc, ty, xy_, yx_); - auto yy_ = rewriter.create(loc, ty, y, y_); - auto rr = rewriter.create(loc, ty, xx_, yy_); + auto x = rewriter.create(loc, eleTy, a, c0); + auto y = rewriter.create(loc, eleTy, a, c1); + auto x_ = rewriter.create(loc, eleTy, b, c0); + auto y_ = rewriter.create(loc, eleTy, b, c1); + auto xx_ = rewriter.create(loc, eleTy, x, x_); + auto yx_ = rewriter.create(loc, eleTy, y, x_); + auto xy_ = rewriter.create(loc, eleTy, x, y_); + auto ri = rewriter.create(loc, eleTy, xy_, yx_); + auto yy_ = rewriter.create(loc, eleTy, y, y_); + auto rr = rewriter.create(loc, eleTy, xx_, yy_); auto ra = rewriter.create(loc, ty); auto r_ = rewriter.create(loc, ty, ra, rr, c0); auto r = rewriter.create(loc, ty, r_, ri, c1); @@ -2745,10 +2745,10 @@ struct MulcOpConversion : public FIROpConversion { struct DivcOpConversion : public FIROpConversion { using FIROpConversion::FIROpConversion; + // Should this just call __divdc3? Just generate inline code for now. mlir::LogicalResult matchAndRewrite(fir::DivcOp divc, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - // TODO: should this just call __divdc3 ? // given: (x + iy) / (x' + iy') // result: ((xx'+yy')/d) + i((yx'-xy')/d) where d = x'x' + y'y' auto a = operands[0]; @@ -2757,22 +2757,23 @@ struct DivcOpConversion : public FIROpConversion { auto ctx = divc.getContext(); auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); + auto eleTy = convertType(getComplexEleTy(divc.getType())); auto ty = convertType(divc.getType()); - auto x = rewriter.create(loc, ty, a, c0); - auto x_ = rewriter.create(loc, ty, b, c0); - auto xx_ = rewriter.create(loc, ty, x, x_); - auto x_x_ = rewriter.create(loc, ty, x_, x_); - auto y = rewriter.create(loc, ty, a, c1); - auto yx_ = rewriter.create(loc, ty, y, x_); - auto y_ = rewriter.create(loc, ty, b, c1); - auto xy_ = rewriter.create(loc, ty, x, y_); - auto yy_ = rewriter.create(loc, ty, y, y_); - auto y_y_ = rewriter.create(loc, ty, y_, y_); - auto d = rewriter.create(loc, ty, x_x_, y_y_); - auto rrn = rewriter.create(loc, ty, xx_, yy_); - auto rin = rewriter.create(loc, ty, yx_, xy_); - auto rr = rewriter.create(loc, ty, rrn, d); - auto ri = rewriter.create(loc, ty, rin, d); + auto x = rewriter.create(loc, eleTy, a, c0); + auto y = rewriter.create(loc, eleTy, a, c1); + auto x_ = rewriter.create(loc, eleTy, b, c0); + auto y_ = rewriter.create(loc, eleTy, b, c1); + auto xx_ = rewriter.create(loc, eleTy, x, x_); + auto x_x_ = rewriter.create(loc, eleTy, x_, x_); + auto yx_ = rewriter.create(loc, eleTy, y, x_); + auto xy_ = rewriter.create(loc, eleTy, x, y_); + auto yy_ = rewriter.create(loc, eleTy, y, y_); + auto y_y_ = rewriter.create(loc, eleTy, y_, y_); + auto d = rewriter.create(loc, eleTy, x_x_, y_y_); + auto rrn = rewriter.create(loc, eleTy, xx_, yy_); + auto rin = rewriter.create(loc, eleTy, yx_, xy_); + auto rr = rewriter.create(loc, eleTy, rrn, d); + auto ri = rewriter.create(loc, eleTy, rin, d); auto ra = rewriter.create(loc, ty); auto r_ = rewriter.create(loc, ty, ra, rr, c0); auto r = rewriter.create(loc, ty, r_, ri, c1); @@ -2792,15 +2793,16 @@ struct NegcOpConversion : public FIROpConversion { // given: -(x + iy) // result: -x - iy auto ctxt = neg.getContext(); + auto eleTy = convertType(getComplexEleTy(neg.getType())); auto ty = convertType(neg.getType()); auto loc = neg.getLoc(); - auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctxt); auto &o0 = operands[0]; - auto rp = rewriter.create(loc, ty, o0, c0); - auto nrp = rewriter.create(loc, ty, rp); + auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctxt); auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctxt); - auto ip = rewriter.create(loc, ty, o0, c1); - auto nip = rewriter.create(loc, ty, ip); + auto rp = rewriter.create(loc, eleTy, o0, c0); + auto ip = rewriter.create(loc, eleTy, o0, c1); + auto nrp = rewriter.create(loc, eleTy, rp); + auto nip = rewriter.create(loc, eleTy, ip); auto r = rewriter.create(loc, ty, o0, nrp, c0); rewriter.replaceOpWithNewOp(neg, ty, r, nip, c1); return success(); From 427ddb58c0e9312ac6e87d5f0cf06b189a992fa4 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 16 Oct 2020 14:47:25 -0700 Subject: [PATCH 0302/1017] Do some misc. code cleanup. --- .../include/flang/Optimizer/Transforms/Passes.td | 16 ---------------- flang/lib/Lower/Coarray.cpp | 2 ++ .../lib/Optimizer/Transforms/AffineDemotion.cpp | 6 ++++-- 3 files changed, 6 insertions(+), 18 deletions(-) diff --git a/flang/include/flang/Optimizer/Transforms/Passes.td b/flang/include/flang/Optimizer/Transforms/Passes.td index 5f6e09ba6a778..8e21fc971ebb3 100644 --- a/flang/include/flang/Optimizer/Transforms/Passes.td +++ b/flang/include/flang/Optimizer/Transforms/Passes.td @@ -66,22 +66,6 @@ def MemRefDataFlowOpt : FunctionPass<"fir-memref-dataflow-opt"> { let constructor = "::fir::createMemDataFlowOptPass()"; } -def FirLoopResultOpt : FunctionPass<"fir-loop-result-opt"> { - let summary = "Optimizes fir do_loop by removing unused final iteration values."; - let constructor = "fir::createFirLoopResultOptPass()"; - -} - -def MemRefDataFlowOpt : FunctionPass<"flang-memref-dataflow-opt"> { - let summary = "Perform store/load forwarding and potentially removing dead stores"; - let description = [{ - This pass performs store to load forwarding to eliminate memory - accesses and potentially the entire allocation if all the accesses are - forwarded. - }]; - let constructor = "fir::createMemDataFlowOptPass()"; -} - def BasicCSE : FunctionPass<"basic-cse"> { let summary = "Basic common sub-expression elimination."; let description = [{ diff --git a/flang/lib/Lower/Coarray.cpp b/flang/lib/Lower/Coarray.cpp index b1eef2d05d240..43b3b6dfb8086 100644 --- a/flang/lib/Lower/Coarray.cpp +++ b/flang/lib/Lower/Coarray.cpp @@ -56,7 +56,9 @@ void Fortran::lower::genFormTeamStatement( fir::ExtendedValue Fortran::lower::CoarrayExprHelper::genAddr( const Fortran::evaluate::CoarrayRef &expr) { + (void)converter; (void)symMap; + (void)loc; TODO("co-array address"); } diff --git a/flang/lib/Optimizer/Transforms/AffineDemotion.cpp b/flang/lib/Optimizer/Transforms/AffineDemotion.cpp index 34e9fb4ee9de3..0eb942f476b05 100644 --- a/flang/lib/Optimizer/Transforms/AffineDemotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffineDemotion.cpp @@ -80,10 +80,12 @@ class ConvertConversion : public mlir::OpRewritePattern { // due to index calculation moving to affine maps we still need to // add converts for sequence types this has a side effect of losing // some information about arrays with known dimensions by creating: - // fir.convert %arg0 : (!fir.ref>) -> !fir.ref> + // fir.convert %arg0 : (!fir.ref>) -> + // !fir.ref> if (auto refTy = op.value().getType().dyn_cast()) if (auto arrTy = refTy.getEleTy().dyn_cast()) { - fir::SequenceType::Shape flatShape = {fir::SequenceType::getUnknownExtent()}; + fir::SequenceType::Shape flatShape = { + fir::SequenceType::getUnknownExtent()}; auto flatArrTy = fir::SequenceType::get(flatShape, arrTy.getEleTy()); auto flatTy = fir::ReferenceType::get(flatArrTy); rewriter.replaceOpWithNewOp(op, flatTy, op.value()); From 5bab29b52b4c6447557deaa40830ba09ec3f5f51 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 16 Oct 2020 14:53:36 -0700 Subject: [PATCH 0303/1017] Fix a couple of warnings. --- flang/lib/Optimizer/Transforms/CSE.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/CSE.cpp b/flang/lib/Optimizer/Transforms/CSE.cpp index 5146f1f30aff1..f649cfa1c6b9b 100644 --- a/flang/lib/Optimizer/Transforms/CSE.cpp +++ b/flang/lib/Optimizer/Transforms/CSE.cpp @@ -92,11 +92,11 @@ struct SimpleOperationInfo : public llvm::DenseMapInfo { // Compare operands. if (lhs->isCommutative()) { SmallVector lops; - for (const auto &lod : lhs->getOperands()) + for (auto lod : lhs->getOperands()) lops.push_back(lod.getAsOpaquePointer()); llvm::sort(lops.begin(), lops.end()); SmallVector rops; - for (const auto &rod : rhs->getOperands()) + for (auto rod : rhs->getOperands()) rops.push_back(rod.getAsOpaquePointer()); llvm::sort(rops.begin(), rops.end()); if (!std::equal(lops.begin(), lops.end(), rops.begin())) From 020ada7208a08547f65c84f885beffe10dd30087 Mon Sep 17 00:00:00 2001 From: Sourabh Singh Tomar Date: Wed, 14 Oct 2020 22:15:30 +0530 Subject: [PATCH 0304/1017] [flang][OpenMP] Lower attribute based clauses --- .../OpenMP/omp-parallel-default-clause.f90 | 51 ++++++++++++++++++ .../OpenMP/omp-parallel-procbind-clause.f90 | 52 +++++++++++++++++++ 2 files changed, 103 insertions(+) create mode 100644 flang/test/Lower/OpenMP/omp-parallel-default-clause.f90 create mode 100644 flang/test/Lower/OpenMP/omp-parallel-procbind-clause.f90 diff --git a/flang/test/Lower/OpenMP/omp-parallel-default-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-default-clause.f90 new file mode 100644 index 0000000000000..e116c63499209 --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-default-clause.f90 @@ -0,0 +1,51 @@ +! This test checks lowering of OpenMP parallel Directive with +! `DEFAULT` clause present with different values. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMDialect + +subroutine default_clause() + +!FIRDialect: omp.parallel default(private) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: omp.parallel default(private) { +!LLVMDialect: omp.terminator +!LLVMialect: } +!$OMP PARALLEL DEFAULT(PRIVATE) +!$OMP END PARALLEL + +!FIRDialect: omp.parallel default(firstprivate) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: omp.parallel default(firstprivate) { +!LLVMDialect: omp.terminator +!LLVMialect: } +!$OMP PARALLEL DEFAULT(FIRSTPRIVATE) +!$OMP END PARALLEL + +!FIRDialect: omp.parallel default(shared) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: omp.parallel default(shared) { +!LLVMDialect: omp.terminator +!LLVMialect: } +!$OMP PARALLEL DEFAULT(SHARED) +!$OMP END PARALLEL + +!FIRDialect: omp.parallel default(none) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: omp.parallel default(none) { +!LLVMDialect: omp.terminator +!LLVMialect: } +!$OMP PARALLEL DEFAULT(NONE) +!$OMP END PARALLEL + +end subroutine diff --git a/flang/test/Lower/OpenMP/omp-parallel-procbind-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-procbind-clause.f90 new file mode 100644 index 0000000000000..2a7b71e4b0f47 --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-procbind-clause.f90 @@ -0,0 +1,52 @@ +! This test checks lowering of OpenMP parallel Directive with +! `PROC_BIND` clause present with different values. + +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect +! RUN: bbc -fopenmp -emit-llvm %s -o - | \ +! RUN: FileCheck %s --check-prefix=LLVMDialect +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: tco | FileCheck %s --check-prefix=LLVMIR + +subroutine procbind_clause() + +!FIRDialect: omp.parallel proc_bind(master) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: omp.parallel proc_bind(master) { +!LLVMDialect: omp.terminator +!LLVMialect: } + +!! Value 2 denotes master. +!LLVMIR: call void @__kmpc_push_proc_bind(%struct.ident_t* @{{.*}}, i32 %omp_global_thread_num, i32 2) +!$OMP PARALLEL PROC_BIND(MASTER) +!$OMP END PARALLEL + +!FIRDialect: omp.parallel proc_bind(close) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: omp.parallel proc_bind(close) { +!LLVMDialect: omp.terminator +!LLVMialect: } + +!! Value 3 denotes close. +!LLVMIR: call void @__kmpc_push_proc_bind(%struct.ident_t* @{{.*}}, i32 %{{.*}}, i32 3) +!$OMP PARALLEL PROC_BIND(CLOSE) +!$OMP END PARALLEL + +!FIRDialect: omp.parallel proc_bind(spread) { +!FIRDialect: omp.terminator +!FIRDialect: } + +!LLVMDialect: omp.parallel proc_bind(spread) { +!LLVMDialect: omp.terminator +!LLVMialect: } + +!! Value 4 denotes spread. +!LLVMIR: call void @__kmpc_push_proc_bind(%struct.ident_t* @{{.*}}, i32 %{{.*}}, i32 4) +!$OMP PARALLEL PROC_BIND(SPREAD) +!$OMP END PARALLEL + +end subroutine From 8c3ca825cae14e256c1272d6bd9105426f457ccc Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Fri, 16 Oct 2020 07:30:09 -0700 Subject: [PATCH 0305/1017] Do not reflect the size of character in boxchar length When passing a character array in an implicit interface we were multiplying the array size with the length to compute the boxchar length. It gives the actual storage length, but was not in line with what other compilers do, leading to link time incompatibility on F77 programs. We were anyway not dividing back the length for character array dummy on the callee size so this did not work correctly between flang compiled programs. There are internal cases in IO where we still do want to transform contiguous array into a scalar, add test to avoid regressions when passing array as format. --- flang/include/flang/Lower/CharacterExpr.h | 3 ++- flang/lib/Lower/ConvertExpr.cpp | 2 +- flang/test/Lower/implicit-interface.f90 | 14 +++++++++++++- flang/test/Lower/read-write-buffer.f90 | 21 ++++++++++++++++++++- 4 files changed, 36 insertions(+), 4 deletions(-) diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index 34a6220bcb20a..2c9d16cb4c080 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -75,7 +75,8 @@ class CharacterExprHelper { /// \p len is converted to the integer type for character lengths if needed. mlir::Value createEmboxChar(mlir::Value addr, mlir::Value len); mlir::Value createEmbox(const fir::CharBoxValue &str); - /// Embox a string array. The length is sizeof(str)*len(str). + /// Embox a string array. Note that the size/shape of the array is not + /// retrievable from the resulting mlir::Value. mlir::Value createEmbox(const fir::CharArrayBoxValue &str); /// Convert character array to a scalar by reducing the extents into the diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 414526d9e2f4b..3397e9d7a89fc 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1486,7 +1486,7 @@ class ExprLowering { if (!argVal) mlir::emitError( getLoc(), - "Lowering internal error: passing non trivial value by by value"); + "Lowering internal error: passing non trivial value by value"); else caller.placeInput(arg, *argVal); continue; diff --git a/flang/test/Lower/implicit-interface.f90 b/flang/test/Lower/implicit-interface.f90 index 3cfb6301ee7fa..1fa8a1794b568 100644 --- a/flang/test/Lower/implicit-interface.f90 +++ b/flang/test/Lower/implicit-interface.f90 @@ -6,11 +6,23 @@ function char_return_callee(i) integer :: i end function -! CHECK-LABEL: func @_QPchar_return_caller(!fir.ref>, index, !fir.ref) -> !fir.boxchar<1> +! CHECK-LABEL: @_QPtest_char_return_caller() subroutine test_char_return_caller character(10) :: char_return_caller + ! CHECK: fir.call @_QPchar_return_caller({{.*}}) : (!fir.ref>, index, !fir.ref) -> !fir.boxchar<1> print *, char_return_caller(5) end subroutine +! CHECK-LABEL: func @_QPtest_passing_char_array() +subroutine test_passing_char_array + character(len=3) :: x(4) + call sub_taking_a_char_array(x) + ! CHECK-DAG: %[[xarray:.*]] = fir.alloca !fir.array<3x4x!fir.char<1>> + ! CHECK-DAG: %[[c3:.*]] = constant 3 : index + ! CHECK-DAG: %[[xbuff:.*]] = fir.convert %[[xarray]] : (!fir.ref>>) -> !fir.ref> + ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[xbuff]], %[[c3]] : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.call @_QPsub_taking_a_char_array(%[[boxchar]]) : (!fir.boxchar<1>) -> () +end subroutine + ! TODO more implicit interface cases with/without explicit interface diff --git a/flang/test/Lower/read-write-buffer.f90 b/flang/test/Lower/read-write-buffer.f90 index ca28282dafe29..a41b44d361310 100644 --- a/flang/test/Lower/read-write-buffer.f90 +++ b/flang/test/Lower/read-write-buffer.f90 @@ -1,6 +1,24 @@ ! RUN: bbc -emit-fir %s -o - | FileCheck %s -! A test to check the buffer and it's length. +! Test that we are passing the correct length when using character array as +! Format (Fortran 2018 12.6.2.2 point 3) +! CHECK-LABEL: func @_QPtest_array_format +subroutine test_array_format + ! CHECK-DAG: %[[c2:.*]] = constant 2 : index + ! CHECK-DAG: %[[c10:.*]] = constant 10 : index + ! CHECK-DAG: %[[mem:.*]] = fir.alloca !fir.array<10x2x!fir.char<1>> + character(10) :: array(2) + array(1) ="(15HThis i" + array(2) ="s a test.)" + ! CHECK-DAG: %[[fmtLen:.*]] = muli %[[c10]], %[[c2]] : index + ! CHECK-DAG: %[[scalarFmt:.*]] = fir.convert %[[mem]] : (!fir.ref>>) -> !fir.ref>> + ! CHECK-DAG: %[[fmtArg:.*]] = fir.convert %[[scalarFmt]] : (!fir.ref>>) -> !fir.ref + ! CHECK-DAG: %[[fmtLenArg:.*]] = fir.convert %[[fmtLen]] : (index) -> i64 + ! CHECK: fir.call @_FortranAioBeginExternalFormattedOutput(%[[fmtArg]], %[[fmtLenArg]], {{.*}}) + write(*, array) +end subroutine + +! A test to check the buffer and it's length. ! CHECK-LABEL: @_QPsome subroutine some() character(LEN=255):: buffer @@ -14,3 +32,4 @@ subroutine some() ! CHECK: %[[lit:.*]] = fir.string_lit "compiler"(8) : !fir.char<1> ! CHECK: fir.has_value %[[lit]] : !fir.array<8x!fir.char<1>> ! CHECK: } + From 97276b7c2a35ae8dbe4496f8ac3bc4e03134a6e6 Mon Sep 17 00:00:00 2001 From: Eric Date: Mon, 19 Oct 2020 12:12:51 -0700 Subject: [PATCH 0306/1017] fixes #491 --- flang/include/flang/Lower/Todo.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/include/flang/Lower/Todo.h b/flang/include/flang/Lower/Todo.h index e18bab4ea31fc..734ae453c78f3 100644 --- a/flang/include/flang/Lower/Todo.h +++ b/flang/include/flang/Lower/Todo.h @@ -56,7 +56,7 @@ #define TODO_NOLOCDEFN(ToDoMsg, ToDoFile, ToDoLine) \ do { \ llvm::report_fatal_error( \ - __FILE__ ":" TODOQUOTE(__LINE__) ": not yet implemented " ToDoMsg); \ + ToDoFile ":" TODOQUOTE(ToDoLine) ": not yet implemented " ToDoMsg); \ } while (false) #define TODO_NOLOC(ToDoMsg) TODO_NOLOCDEFN(ToDoMsg, __FILE__, __LINE__) From 47f641d1c02192bc0701556e1892098f470fa04a Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 16 Oct 2020 17:20:18 -0700 Subject: [PATCH 0307/1017] move the type converter into a separate file. --- flang/lib/Optimizer/CodeGen/CodeGen.cpp | 491 +++----------------- flang/lib/Optimizer/CodeGen/TypeConverter.h | 351 ++++++++++++++ 2 files changed, 425 insertions(+), 417 deletions(-) create mode 100644 flang/lib/Optimizer/CodeGen/TypeConverter.h diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 2397e2daf269a..cd50b2608153a 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -83,348 +83,11 @@ using AttributeTy = ArrayRef; static constexpr unsigned defaultAlign = 8; -namespace { - -/// FIR type converter -/// This converts FIR types to LLVM types (for now) -class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { -public: - FIRToLLVMTypeConverter(mlir::ModuleOp module) - : LLVMTypeConverter(module.getContext()), - kindMapping(*fir::getKindMapping(module)), - uniquer(*fir::getNameUniquer(module)), - specifics(fir::CodeGenSpecifics::get(module.getContext(), - *fir::getTargetTriple(module), - *fir::getKindMapping(module))) { - LLVM_DEBUG(llvm::dbgs() << "FIR type converter\n"); - - // Each conversion should return a value of type mlir::LLVM::LLVMType. - addConversion([&](fir::BoxType box) { return convertBoxType(box); }); - addConversion([&](fir::BoxCharType boxchar) { - LLVM_DEBUG(llvm::dbgs() << "type convert: " << boxchar << '\n'); - return unwrap( - convertType(specifics->boxcharMemoryType(boxchar.getEleTy()))); - }); - addConversion( - [&](fir::BoxProcType boxproc) { return convertBoxProcType(boxproc); }); - addConversion( - [&](fir::CharacterType charTy) { return convertCharType(charTy); }); - addConversion( - [&](mlir::ComplexType cmplx) { return convertComplexType(cmplx); }); - addConversion( - [&](fir::ComplexType cmplx) { return convertComplexType(cmplx); }); - addConversion( - [&](fir::RecordType derived) { return convertRecordType(derived); }); - addConversion([&](fir::FieldType field) { - return mlir::LLVM::LLVMType::getInt32Ty(field.getContext()); - }); - addConversion([&](fir::HeapType heap) { return convertPointerLike(heap); }); - addConversion([&](fir::IntegerType intTy) { - return mlir::LLVM::LLVMType::getIntNTy( - &getContext(), kindMapping.getIntegerBitsize(intTy.getFKind())); - }); - addConversion([&](fir::LenType field) { - return mlir::LLVM::LLVMType::getInt32Ty(field.getContext()); - }); - addConversion([&](fir::LogicalType boolTy) { - return mlir::LLVM::LLVMType::getIntNTy( - &getContext(), kindMapping.getLogicalBitsize(boolTy.getFKind())); - }); - addConversion( - [&](fir::PointerType pointer) { return convertPointerLike(pointer); }); - addConversion( - [&](fir::RealType real) { return convertRealType(real.getFKind()); }); - addConversion( - [&](fir::ReferenceType ref) { return convertPointerLike(ref); }); - addConversion([&](fir::SequenceType sequence) { - return convertSequenceType(sequence); - }); - addConversion([&](fir::TypeDescType tdesc) { - return convertTypeDescType(tdesc.getContext()); - }); - addConversion([&](fir::VectorType vecTy) { - return mlir::LLVM::LLVMType::getVectorTy( - unwrap(convertType(vecTy.getEleTy())), vecTy.getLen()); - }); - addConversion([&](mlir::TupleType tuple) { - LLVM_DEBUG(llvm::dbgs() << "type convert: " << tuple << '\n'); - SmallVector inMembers; - tuple.getFlattenedTypes(inMembers); - SmallVector members; - for (auto mem : inMembers) - members.push_back(convertType(mem).cast()); - return mlir::LLVM::LLVMType::getStructTy(&getContext(), members); - }); - addConversion([&](mlir::NoneType none) { - return mlir::LLVM::LLVMStructType::getLiteral(none.getContext(), - llvm::None); - }); - - // FIXME: https://reviews.llvm.org/D82831 introduced an automatic - // materliazation of conversion around function calls that is not working - // well with fir lowering to llvm (incorrect llvm.mlir.cast are inserted). - // Workaround until better analysis: register a handler that does not insert - // any conversions. - addSourceMaterialization( - [&](mlir::OpBuilder &builder, mlir::Type resultType, - mlir::ValueRange inputs, - mlir::Location loc) -> llvm::Optional { - if (inputs.size() != 1) - return llvm::None; - return inputs[0]; - }); - // Similar FIXME workaround here (needed for compare.fir/select-type.fir - // tests). - addTargetMaterialization( - [&](mlir::OpBuilder &builder, mlir::Type resultType, - mlir::ValueRange inputs, - mlir::Location loc) -> llvm::Optional { - if (inputs.size() != 1) - return llvm::None; - return inputs[0]; - }); - } - - // i32 is used here because LLVM wants i32 constants when indexing into struct - // types. Indexing into other aggregate types is more flexible. - mlir::LLVM::LLVMType offsetType() { - return mlir::LLVM::LLVMType::getInt32Ty(&getContext()); - } - - // i64 can be used to index into aggregates like arrays - mlir::LLVM::LLVMType indexType() { - return mlir::LLVM::LLVMType::getInt64Ty(&getContext()); - } - - // TODO - bool requiresExtendedDesc() { return false; } - - // This corresponds to the descriptor as defined ISO_Fortran_binding.h and the - // addendum defined in descriptor.h. - mlir::LLVM::LLVMType convertBoxType(fir::BoxType box, int rank = -1) { - // (buffer*, ele-size, rank, type-descriptor, attribute, [dims]) - SmallVector parts; - mlir::Type ele = box.getEleTy(); - auto eleTy = unwrap(convertType(ele)); - // buffer* - if (ele.isa() && eleTy.isPointerTy()) - parts.push_back(eleTy); - else - parts.push_back(eleTy.getPointerTo()); - parts.push_back(fir::getDescFieldTypeModel<1>()(&getContext())); - parts.push_back(fir::getDescFieldTypeModel<2>()(&getContext())); - parts.push_back(fir::getDescFieldTypeModel<3>()(&getContext())); - parts.push_back(fir::getDescFieldTypeModel<4>()(&getContext())); - parts.push_back(fir::getDescFieldTypeModel<5>()(&getContext())); - parts.push_back(fir::getDescFieldTypeModel<6>()(&getContext())); - if (rank > 0) { - auto rowTy = fir::getDescFieldTypeModel<7>()(&getContext()); - parts.push_back(mlir::LLVM::LLVMType::getArrayTy(rowTy, rank)); - } - // opt-type-ptr: i8* (see fir.tdesc) - if (requiresExtendedDesc()) { - parts.push_back(fir::getExtendedDescFieldTypeModel<8>()(&getContext())); - parts.push_back(fir::getExtendedDescFieldTypeModel<9>()(&getContext())); - auto rowTy = fir::getExtendedDescFieldTypeModel<10>()(&getContext()); - unsigned numLenParams = 0; // FIXME - parts.push_back(mlir::LLVM::LLVMType::getArrayTy(rowTy, numLenParams)); - } - return mlir::LLVM::LLVMType::getStructTy(&getContext(), parts) - .getPointerTo(); - } - - // fir.boxproc --> llvm<"{ any*, i8* }"> - mlir::LLVM::LLVMType convertBoxProcType(fir::BoxProcType boxproc) { - auto funcTy = convertType(boxproc.getEleTy()); - auto ptrTy = unwrap(funcTy).getPointerTo(); - auto i8Ty = mlir::LLVM::LLVMType::getInt8Ty(&getContext()); - SmallVector tuple{ptrTy, i8Ty}; - return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); - } - - unsigned characterBitsize(fir::CharacterType charTy) { - return kindMapping.getCharacterBitsize(charTy.getFKind()); - } - - // fir.char --> llvm<"ix*"> where ix is scaled by kind mapping - mlir::LLVM::LLVMType convertCharType(fir::CharacterType charTy) { - return mlir::LLVM::LLVMType::getIntNTy(&getContext(), - characterBitsize(charTy)); - } - - // Convert a complex value's element type based on its Fortran kind. - mlir::LLVM::LLVMType convertComplexPartType(fir::KindTy kind) { - auto realID = kindMapping.getComplexTypeID(kind); - return fromRealTypeID(realID, kind); - } - - // Use the target specifics to figure out how to map complex to LLVM IR. The - // use of complex values in function signatures is handled before conversion - // to LLVM IR dialect here. - // - // fir.complex | std.complex --> llvm<"{t,t}"> - template - mlir::LLVM::LLVMType convertComplexType(C cmplx) { - LLVM_DEBUG(llvm::dbgs() << "type convert: " << cmplx << '\n'); - auto eleTy = cmplx.getElementType(); - return unwrap(convertType(specifics->complexMemoryType(eleTy))); - } - - // Get the default size of INTEGER. (The default size might have been set on - // the command line.) - mlir::LLVM::LLVMType getDefaultInt() { - return mlir::LLVM::LLVMType::getIntNTy( - &getContext(), - kindMapping.getIntegerBitsize(kindMapping.defaultIntegerKind())); - } - - template - mlir::LLVM::LLVMType convertPointerLike(A &ty) { - mlir::Type eleTy = ty.getEleTy(); - // A sequence type is a special case. A sequence of runtime size on its - // interior dimensions lowers to a memory reference. In that case, we - // degenerate the array and do not want a the type to become `T**` but - // merely `T*`. - if (auto seqTy = eleTy.dyn_cast()) { - if (!seqTy.hasConstantShape()) { - if (seqTy.hasConstantInterior()) - return unwrap(convertType(seqTy)); - eleTy = seqTy.getEleTy(); - } - } - return unwrap(convertType(eleTy)).getPointerTo(); - } - - // convert a front-end kind value to either a std or LLVM IR dialect type - // fir.real --> llvm.anyfloat where anyfloat is a kind mapping - mlir::LLVM::LLVMType convertRealType(fir::KindTy kind) { - return fromRealTypeID(kindMapping.getRealTypeID(kind), kind); - } - - // fir.type --> llvm<"%name = { ty... }"> - mlir::LLVM::LLVMType convertRecordType(fir::RecordType derived) { - auto name = derived.getName(); - // The cache is needed to keep a unique mapping from name -> StructType - auto iter = identStructCache.find(name); - if (iter != identStructCache.end()) - return iter->second; - auto st = mlir::LLVM::LLVMStructType::getIdentified(&getContext(), name); - identStructCache[name] = st; - SmallVector members; - for (auto mem : derived.getTypeList()) - members.push_back(convertType(mem.second).cast()); - mlir::LLVM::LLVMType::setStructTyBody(st, members); - return st; - } - - // fir.array --> llvm<"[...[c x any]]"> - mlir::LLVM::LLVMType convertSequenceType(fir::SequenceType seq) { - auto baseTy = unwrap(convertType(seq.getEleTy())); - auto shape = seq.getShape(); - auto constRows = seq.getConstantRows(); - if (constRows) { - decltype(constRows) i = constRows; - for (auto e : shape) { - baseTy = mlir::LLVM::LLVMType::getArrayTy(baseTy, e); - if (--i == 0) - break; - } - if (seq.hasConstantShape()) - return baseTy; - } - return baseTy.getPointerTo(); - } - - // fir.tdesc --> llvm<"i8*"> - // FIXME: for now use a void*, however pointer identity is not sufficient for - // the f18 object v. class distinction - mlir::LLVM::LLVMType convertTypeDescType(mlir::MLIRContext *ctx) { - return mlir::LLVM::LLVMType::getInt8PtrTy(&getContext()); - } - - /// Convert llvm::Type::TypeID to mlir::LLVM::LLVMType - mlir::LLVM::LLVMType fromRealTypeID(llvm::Type::TypeID typeID, - fir::KindTy kind) { - switch (typeID) { - case llvm::Type::TypeID::HalfTyID: - return mlir::LLVM::LLVMType::getHalfTy(&getContext()); - case llvm::Type::TypeID::FloatTyID: - return mlir::LLVM::LLVMType::getFloatTy(&getContext()); - case llvm::Type::TypeID::DoubleTyID: - return mlir::LLVM::LLVMType::getDoubleTy(&getContext()); - case llvm::Type::TypeID::X86_FP80TyID: - return mlir::LLVM::LLVMType::getX86_FP80Ty(&getContext()); - case llvm::Type::TypeID::FP128TyID: - return mlir::LLVM::LLVMType::getFP128Ty(&getContext()); - default: - emitError(UnknownLoc::get(&getContext())) - << "unsupported type: !fir.real<" << kind << ">"; - return {}; - } - } - - /// HACK: cloned from LLVMTypeConverter since this is private there - mlir::LLVM::LLVMType unwrap(mlir::Type type) { - if (!type) - return nullptr; - auto *mlirContext = type.getContext(); - auto wrappedLLVMType = type.dyn_cast(); - if (!wrappedLLVMType) - emitError(UnknownLoc::get(mlirContext), - "conversion resulted in a non-LLVM type"); - return wrappedLLVMType; - } - - /// Returns false iff the sequence type has a shape and the shape is constant. - static bool unknownShape(fir::SequenceType::Shape shape) { - // does the shape even exist? - auto size = shape.size(); - if (size == 0) - return true; - // if it exists, are any dimensions deferred? - for (decltype(size) i = 0, sz = size; i < sz; ++i) - if (shape[i] == fir::SequenceType::getUnknownExtent()) - return true; - return false; - } - - /// Does this record type have dynamically inlined subobjects? Note: this - /// should not look through references as they are not inlined. - static bool dynamicallySized(fir::RecordType seqTy) { - for (auto field : seqTy.getTypeList()) { - if (auto arr = field.second.dyn_cast()) { - if (unknownShape(arr.getShape())) - return true; - } else if (auto rec = field.second.dyn_cast()) { - if (dynamicallySized(rec)) - return true; - } - } - return false; - } - - static bool dynamicallySized(mlir::Type ty) { - if (auto arr = ty.dyn_cast()) - ty = arr.getEleTy(); - if (auto rec = ty.dyn_cast()) - return dynamicallySized(rec); - return false; - } +// fir::LLVMTypeConverter for converting to LLVM IR dialect types. +#include "TypeConverter.h" - fir::NameUniquer &getUniquer() { return uniquer; } - - fir::KindMapping &getKindMap() { return kindMapping; } - -private: - fir::KindMapping kindMapping; - fir::NameUniquer &uniquer; - std::unique_ptr specifics; - static StringMap identStructCache; -}; - -// instantiate static data member -StringMap FIRToLLVMTypeConverter::identStructCache; -} // namespace +// Instantiate static data member of the type converter. +StringMap fir::LLVMTypeConverter::identStructCache; /// remove `omitNames` (by name) from the attribute dictionary static SmallVector @@ -453,7 +116,7 @@ template class FIROpConversion : public mlir::OpConversionPattern { public: explicit FIROpConversion(mlir::MLIRContext *ctx, - FIRToLLVMTypeConverter &lowering) + fir::LLVMTypeConverter &lowering) : mlir::OpConversionPattern(lowering, ctx, 1) {} protected: @@ -521,8 +184,8 @@ class FIROpConversion : public mlir::OpConversionPattern { return rewriter.create(loc, ty, base, cv); } - FIRToLLVMTypeConverter &lowerTy() const { - return *static_cast(this->getTypeConverter()); + fir::LLVMTypeConverter &lowerTy() const { + return *static_cast(this->getTypeConverter()); } }; @@ -1259,6 +922,19 @@ struct EmboxCommonConversion : public FIROpConversion { return boxPtrTy.getPointerElementTy().getStructElementType(i); } + int getCFIAttr(fir::BoxType boxTy) const { + auto eleTy = boxTy.getEleTy(); + if (eleTy.isa()) + return CFI_attribute_pointer; + if (eleTy.isa()) + return CFI_attribute_allocatable; + return CFI_attribute_other; + } + + bool isDerivedType(fir::BoxType boxTy) const { + return boxTy.getEleTy().isa(); + } + // Get the element size and CFI type code of the boxed value. std::tuple getSizeAndTypeCode( mlir::Location loc, mlir::ConversionPatternRewriter &rewriter, @@ -1350,25 +1026,18 @@ struct EmboxCommonConversion : public FIROpConversion { // fail: unhandled case TODO(""); } -}; -/// Create a generic box on a memory reference. This conversions lowers the -/// abstract box to the appropriate, initialized descriptor. -struct EmboxOpConversion : public EmboxCommonConversion { - using EmboxCommonConversion::EmboxCommonConversion; - - mlir::LogicalResult - matchAndRewrite(fir::EmboxOp embox, OperandTy operands, - mlir::ConversionPatternRewriter &rewriter) const override { - // There should be no dims on this embox op - assert(!embox.getShape()); - - auto loc = embox.getLoc(); - auto boxTy = embox.getType().dyn_cast(); - assert(boxTy); - auto ty = unwrap(lowerTy().convertBoxType(boxTy, 0)); + template + std::tuple + consDescriptorPrefix(BOX box, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter, unsigned rank, + unsigned dropFront) const { + auto loc = box.getLoc(); + auto boxTy = box.getType().template dyn_cast(); + assert(boxTy && "embox must have box type"); + auto ty = this->unwrap(this->lowerTy().convertBoxType(boxTy, rank)); auto alloca = genAllocaWithType(loc, ty, defaultAlign, rewriter); - auto c0 = genConstantOffset(loc, rewriter, 0); + auto c0 = this->genConstantOffset(loc, rewriter, 0); // Basic pattern to write a field in the descriptor auto storeField = [&](unsigned fldIndex, mlir::Value value, @@ -1391,17 +1060,37 @@ struct EmboxOpConversion : public EmboxCommonConversion { // Write each of the fields with the appropriate values storeField(0, operands[0], bitCast); auto [eleSize, cfiTy] = getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy(), - operands.drop_front(1)); + operands.drop_front(dropFront)); storeField(1, eleSize, intCast); - auto version = genConstantOffset(loc, rewriter, CFI_VERSION); - storeField(2, version, intCast); - storeField(3, /*rank*/ c0, intCast); + storeField(2, this->genConstantOffset(loc, rewriter, CFI_VERSION), intCast); + storeField(3, this->genConstantOffset(loc, rewriter, rank), intCast); storeField(4, cfiTy, intCast); - auto attr = genConstantOffset(loc, rewriter, CFI_attribute_other); - storeField(5, attr, intCast); - storeField(6, /*addend*/ c0, intCast); + storeField(5, this->genConstantOffset(loc, rewriter, getCFIAttr(boxTy)), + intCast); + storeField(6, this->genConstantOffset(loc, rewriter, isDerivedType(boxTy)), + intCast); + return {alloca, eleSize}; + } +}; + +/// Create a generic box on a memory reference. This conversions lowers the +/// abstract box to the appropriate, initialized descriptor. +struct EmboxOpConversion : public EmboxCommonConversion { + using EmboxCommonConversion::EmboxCommonConversion; - rewriter.replaceOp(embox, alloca.getResult()); + mlir::LogicalResult + matchAndRewrite(fir::EmboxOp embox, OperandTy operands, + mlir::ConversionPatternRewriter &rewriter) const override { + // There should be no dims on this embox op + assert(!embox.getShape()); + auto boxTy = embox.getType().dyn_cast(); + auto [alloca, eleSize] = + consDescriptorPrefix(embox, operands, rewriter, /*rank=*/0, + /*dropFront=*/1); + if (isDerivedType(boxTy)) + TODO("derived type"); + + rewriter.replaceOp(embox, alloca); return success(); } }; @@ -1413,59 +1102,24 @@ struct XEmboxOpConversion : public EmboxCommonConversion { mlir::LogicalResult matchAndRewrite(fir::XEmboxOp xbox, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - auto loc = xbox.getLoc(); auto rank = xbox.getRank(); - auto boxTy = xbox.getType().dyn_cast(); - assert(boxTy); - auto ty = unwrap(lowerTy().convertBoxType(boxTy, rank)); - auto alloca = genAllocaWithType(loc, ty, defaultAlign, rewriter); - auto c0 = genConstantOffset(loc, rewriter, 0); - - // Basic pattern to write a field in the descriptor - auto storeField = [&](unsigned fldIndex, mlir::Value value, - const std::function &applyCast) { - auto fldTy = getBoxEleTy(ty, fldIndex); - auto fldPtr = genGEPToField(loc, fldTy, rewriter, alloca, c0, fldIndex); - auto fld = applyCast(fldTy, value); - rewriter.create(loc, fld, fldPtr); - }; - auto bitCast = [&](mlir::LLVM::LLVMType ty, - mlir::Value val) -> mlir::Value { - return rewriter.create(loc, ty, val); - }; - auto intCast = [&](mlir::LLVM::LLVMType ty, - mlir::Value val) -> mlir::Value { - return integerCast(loc, rewriter, ty, val); - }; - - // Write each of the fields with the appropriate values - storeField(0, operands[0], bitCast); - auto [eleSize, cfiTy] = - getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy(), - operands.drop_front(xbox.lenParamOffset() + 1)); - storeField(1, eleSize, intCast); - auto version = genConstantOffset(loc, rewriter, CFI_VERSION); - storeField(2, version, intCast); - auto rankVal = genConstantOffset(loc, rewriter, rank); - storeField(3, rankVal, intCast); - storeField(4, cfiTy, intCast); - auto attr = genConstantOffset(loc, rewriter, CFI_attribute_other); - storeField(5, attr, intCast); - storeField(6, /*addend*/ c0, intCast); - + auto [alloca, eleSize] = consDescriptorPrefix( + xbox, operands, rewriter, rank, xbox.lenParamOffset() + 1); // Generate the triples in the dims field of the descriptor auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(xbox.getContext()); auto i64PtrTy = i64Ty.getPointerTo(); - assert(xbox.shapeOperands().size()); + assert(xbox.shapeOperands().size() && "must have a shape"); unsigned shapeOff = 1; bool hasShift = xbox.shiftOperands().size(); unsigned shiftOff = shapeOff + xbox.shapeOperands().size(); bool hasSlice = xbox.sliceOperands().size(); unsigned sliceOff = shiftOff + xbox.shiftOperands().size(); + auto loc = xbox.getLoc(); mlir::Value zero = genConstantIndex(loc, i64Ty, rewriter, 0); mlir::Value one = genConstantIndex(loc, i64Ty, rewriter, 1); mlir::Value prevDim = integerCast(loc, rewriter, i64Ty, eleSize); + auto c0 = genConstantOffset(loc, rewriter, 0); + auto boxTy = xbox.getType().dyn_cast(); for (unsigned d = 0; d < rank; ++d) { // store lower bound (normally 0) auto f70p = genGEPToField(loc, i64PtrTy, rewriter, alloca, c0, 7, d, 0); @@ -1514,6 +1168,9 @@ struct XEmboxOpConversion : public EmboxCommonConversion { if (hasSlice) sliceOff += 3; } + if (isDerivedType(boxTy)) + TODO("derived type"); + // Convert descriptor to the prefix type for strong typing. auto desc = rewriter.create( loc, lowerTy().convertType(boxTy), alloca); rewriter.replaceOp(xbox, desc.getResult()); @@ -1855,12 +1512,12 @@ struct CoordinateOpConversion // If the base has dynamic shape, it has to be boxed as the dimension // information is saved in the box. - if (FIRToLLVMTypeConverter::dynamicallySized(cpnTy)) { + if (fir::LLVMTypeConverter::dynamicallySized(cpnTy)) { TODO(""); return success(); } } else { - if (FIRToLLVMTypeConverter::dynamicallySized(cpnTy)) + if (fir::LLVMTypeConverter::dynamicallySized(cpnTy)) return mlir::emitError(loc, "bare reference to unknown shape"); } if (!hasSubdimension) @@ -2003,7 +1660,7 @@ struct CoordinateOpConversion for (; i < sz; ++i) { auto nxtOpnd = coors[i]; if (auto arrTy = type.dyn_cast()) { - if (FIRToLLVMTypeConverter::unknownShape(arrTy.getShape())) + if (fir::LLVMTypeConverter::unknownShape(arrTy.getShape())) return false; i += arrTy.getDimension() - 1; type = arrTy.getEleTy(); @@ -2368,7 +2025,7 @@ struct SelectCaseOpConversion : public FIROpConversion { }; template -void selectMatchAndRewrite(FIRToLLVMTypeConverter &lowering, OP select, +void selectMatchAndRewrite(fir::LLVMTypeConverter &lowering, OP select, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) { // We could target the LLVM switch instruction, but it isn't part of the @@ -2576,7 +2233,7 @@ struct UnreachableOpConversion : public FIROpConversion { template void lowerRealBinaryOp(BINOP binop, OperandTy operands, mlir::ConversionPatternRewriter &rewriter, - FIRToLLVMTypeConverter &lowering) { + fir::LLVMTypeConverter &lowering) { auto ty = lowering.convertType(binop.getType()); rewriter.replaceOpWithNewOp(binop, ty, operands); } @@ -2652,7 +2309,7 @@ struct NegfOpConversion : public FIROpConversion { template mlir::LLVM::InsertValueOp complexSum(OPTY sumop, OperandTy opnds, mlir::ConversionPatternRewriter &rewriter, - FIRToLLVMTypeConverter &lowering) { + fir::LLVMTypeConverter &lowering) { auto a = opnds[0]; auto b = opnds[1]; auto loc = sumop.getLoc(); @@ -2827,7 +2484,7 @@ struct FIRToLLVMLoweringPass return; auto *context = getModule().getContext(); - FIRToLLVMTypeConverter typeConverter{getModule()}; + fir::LLVMTypeConverter typeConverter{getModule()}; auto loc = mlir::UnknownLoc::get(context); mlir::OwningRewritePatternList pattern; pattern.insert< diff --git a/flang/lib/Optimizer/CodeGen/TypeConverter.h b/flang/lib/Optimizer/CodeGen/TypeConverter.h new file mode 100644 index 0000000000000..c8c144b08e844 --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/TypeConverter.h @@ -0,0 +1,351 @@ +//===-- TypeConverter.h -- type conversion ----------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef OPTIMIZER_CODEGEN_TYPECONVERTER_H +#define OPTIMIZER_CODEGEN_TYPECONVERTER_H + +namespace fir { + +/// FIR type converter +/// This converts FIR types to LLVM types (for now) +class LLVMTypeConverter : public mlir::LLVMTypeConverter { +public: + LLVMTypeConverter(mlir::ModuleOp module) + : mlir::LLVMTypeConverter(module.getContext()), + kindMapping(*getKindMapping(module)), uniquer(*getNameUniquer(module)), + specifics(CodeGenSpecifics::get(module.getContext(), + *getTargetTriple(module), + *getKindMapping(module))) { + LLVM_DEBUG(llvm::dbgs() << "FIR type converter\n"); + + // Each conversion should return a value of type mlir::LLVM::LLVMType. + addConversion([&](BoxType box) { return convertBoxType(box); }); + addConversion([&](BoxCharType boxchar) { + LLVM_DEBUG(llvm::dbgs() << "type convert: " << boxchar << '\n'); + return unwrap( + convertType(specifics->boxcharMemoryType(boxchar.getEleTy()))); + }); + addConversion( + [&](BoxProcType boxproc) { return convertBoxProcType(boxproc); }); + addConversion( + [&](fir::CharacterType charTy) { return convertCharType(charTy); }); + addConversion( + [&](mlir::ComplexType cmplx) { return convertComplexType(cmplx); }); + addConversion( + [&](fir::ComplexType cmplx) { return convertComplexType(cmplx); }); + addConversion( + [&](fir::RecordType derived) { return convertRecordType(derived); }); + addConversion([&](fir::FieldType field) { + return mlir::LLVM::LLVMType::getInt32Ty(field.getContext()); + }); + addConversion([&](HeapType heap) { return convertPointerLike(heap); }); + addConversion([&](fir::IntegerType intTy) { + return mlir::LLVM::LLVMType::getIntNTy( + &getContext(), kindMapping.getIntegerBitsize(intTy.getFKind())); + }); + addConversion([&](LenType field) { + return mlir::LLVM::LLVMType::getInt32Ty(field.getContext()); + }); + addConversion([&](fir::LogicalType boolTy) { + return mlir::LLVM::LLVMType::getIntNTy( + &getContext(), kindMapping.getLogicalBitsize(boolTy.getFKind())); + }); + addConversion( + [&](fir::PointerType pointer) { return convertPointerLike(pointer); }); + addConversion( + [&](fir::RealType real) { return convertRealType(real.getFKind()); }); + addConversion( + [&](fir::ReferenceType ref) { return convertPointerLike(ref); }); + addConversion( + [&](SequenceType sequence) { return convertSequenceType(sequence); }); + addConversion([&](TypeDescType tdesc) { + return convertTypeDescType(tdesc.getContext()); + }); + addConversion([&](fir::VectorType vecTy) { + return mlir::LLVM::LLVMType::getVectorTy( + unwrap(convertType(vecTy.getEleTy())), vecTy.getLen()); + }); + addConversion([&](mlir::TupleType tuple) { + LLVM_DEBUG(llvm::dbgs() << "type convert: " << tuple << '\n'); + SmallVector inMembers; + tuple.getFlattenedTypes(inMembers); + SmallVector members; + for (auto mem : inMembers) + members.push_back(convertType(mem).cast()); + return mlir::LLVM::LLVMType::getStructTy(&getContext(), members); + }); + addConversion([&](mlir::NoneType none) { + return mlir::LLVM::LLVMStructType::getLiteral(none.getContext(), + llvm::None); + }); + + // FIXME: https://reviews.llvm.org/D82831 introduced an automatic + // materialization of conversion around function calls that is not working + // well with fir lowering to llvm (incorrect llvm.mlir.cast are inserted). + // Workaround until better analysis: register a handler that does not insert + // any conversions. + addSourceMaterialization( + [&](mlir::OpBuilder &builder, mlir::Type resultType, + mlir::ValueRange inputs, + mlir::Location loc) -> llvm::Optional { + if (inputs.size() != 1) + return llvm::None; + return inputs[0]; + }); + // Similar FIXME workaround here (needed for compare.fir/select-type.fir + // tests). + addTargetMaterialization( + [&](mlir::OpBuilder &builder, mlir::Type resultType, + mlir::ValueRange inputs, + mlir::Location loc) -> llvm::Optional { + if (inputs.size() != 1) + return llvm::None; + return inputs[0]; + }); + } + + // i32 is used here because LLVM wants i32 constants when indexing into struct + // types. Indexing into other aggregate types is more flexible. + mlir::LLVM::LLVMType offsetType() { + return mlir::LLVM::LLVMType::getInt32Ty(&getContext()); + } + + // i64 can be used to index into aggregates like arrays + mlir::LLVM::LLVMType indexType() { + return mlir::LLVM::LLVMType::getInt64Ty(&getContext()); + } + + // TODO + bool requiresExtendedDesc() { return false; } + + // This corresponds to the descriptor as defined ISO_Fortran_binding.h and the + // addendum defined in descriptor.h. + mlir::LLVM::LLVMType convertBoxType(BoxType box, int rank = -1) { + // (buffer*, ele-size, rank, type-descriptor, attribute, [dims]) + SmallVector parts; + mlir::Type ele = box.getEleTy(); + auto eleTy = unwrap(convertType(ele)); + // buffer* + if (ele.isa() && eleTy.isPointerTy()) + parts.push_back(eleTy); + else + parts.push_back(eleTy.getPointerTo()); + parts.push_back(getDescFieldTypeModel<1>()(&getContext())); + parts.push_back(getDescFieldTypeModel<2>()(&getContext())); + parts.push_back(getDescFieldTypeModel<3>()(&getContext())); + parts.push_back(getDescFieldTypeModel<4>()(&getContext())); + parts.push_back(getDescFieldTypeModel<5>()(&getContext())); + parts.push_back(getDescFieldTypeModel<6>()(&getContext())); + if (rank > 0) { + auto rowTy = getDescFieldTypeModel<7>()(&getContext()); + parts.push_back(mlir::LLVM::LLVMType::getArrayTy(rowTy, rank)); + } + // opt-type-ptr: i8* (see fir.tdesc) + if (requiresExtendedDesc()) { + parts.push_back(getExtendedDescFieldTypeModel<8>()(&getContext())); + parts.push_back(getExtendedDescFieldTypeModel<9>()(&getContext())); + auto rowTy = getExtendedDescFieldTypeModel<10>()(&getContext()); + unsigned numLenParams = 0; // FIXME + parts.push_back(mlir::LLVM::LLVMType::getArrayTy(rowTy, numLenParams)); + } + return mlir::LLVM::LLVMType::getStructTy(&getContext(), parts) + .getPointerTo(); + } + + // fir.boxproc --> llvm<"{ any*, i8* }"> + mlir::LLVM::LLVMType convertBoxProcType(BoxProcType boxproc) { + auto funcTy = convertType(boxproc.getEleTy()); + auto ptrTy = unwrap(funcTy).getPointerTo(); + auto i8Ty = mlir::LLVM::LLVMType::getInt8Ty(&getContext()); + SmallVector tuple{ptrTy, i8Ty}; + return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); + } + + unsigned characterBitsize(fir::CharacterType charTy) { + return kindMapping.getCharacterBitsize(charTy.getFKind()); + } + + // fir.char --> llvm<"ix*"> where ix is scaled by kind mapping + mlir::LLVM::LLVMType convertCharType(fir::CharacterType charTy) { + return mlir::LLVM::LLVMType::getIntNTy(&getContext(), + characterBitsize(charTy)); + } + + // Convert a complex value's element type based on its Fortran kind. + mlir::LLVM::LLVMType convertComplexPartType(fir::KindTy kind) { + auto realID = kindMapping.getComplexTypeID(kind); + return fromRealTypeID(realID, kind); + } + + // Use the target specifics to figure out how to map complex to LLVM IR. The + // use of complex values in function signatures is handled before conversion + // to LLVM IR dialect here. + // + // fir.complex | std.complex --> llvm<"{t,t}"> + template + mlir::LLVM::LLVMType convertComplexType(C cmplx) { + LLVM_DEBUG(llvm::dbgs() << "type convert: " << cmplx << '\n'); + auto eleTy = cmplx.getElementType(); + return unwrap(convertType(specifics->complexMemoryType(eleTy))); + } + + // Get the default size of INTEGER. (The default size might have been set on + // the command line.) + mlir::LLVM::LLVMType getDefaultInt() { + return mlir::LLVM::LLVMType::getIntNTy( + &getContext(), + kindMapping.getIntegerBitsize(kindMapping.defaultIntegerKind())); + } + + template + mlir::LLVM::LLVMType convertPointerLike(A &ty) { + mlir::Type eleTy = ty.getEleTy(); + // A sequence type is a special case. A sequence of runtime size on its + // interior dimensions lowers to a memory reference. In that case, we + // degenerate the array and do not want a the type to become `T**` but + // merely `T*`. + if (auto seqTy = eleTy.dyn_cast()) { + if (!seqTy.hasConstantShape()) { + if (seqTy.hasConstantInterior()) + return unwrap(convertType(seqTy)); + eleTy = seqTy.getEleTy(); + } + } + return unwrap(convertType(eleTy)).getPointerTo(); + } + + // convert a front-end kind value to either a std or LLVM IR dialect type + // fir.real --> llvm.anyfloat where anyfloat is a kind mapping + mlir::LLVM::LLVMType convertRealType(fir::KindTy kind) { + return fromRealTypeID(kindMapping.getRealTypeID(kind), kind); + } + + // fir.type --> llvm<"%name = { ty... }"> + mlir::LLVM::LLVMType convertRecordType(fir::RecordType derived) { + auto name = derived.getName(); + // The cache is needed to keep a unique mapping from name -> StructType + auto iter = identStructCache.find(name); + if (iter != identStructCache.end()) + return iter->second; + auto st = mlir::LLVM::LLVMStructType::getIdentified(&getContext(), name); + identStructCache[name] = st; + SmallVector members; + for (auto mem : derived.getTypeList()) + members.push_back(convertType(mem.second).cast()); + mlir::LLVM::LLVMType::setStructTyBody(st, members); + return st; + } + + // fir.array --> llvm<"[...[c x any]]"> + mlir::LLVM::LLVMType convertSequenceType(SequenceType seq) { + auto baseTy = unwrap(convertType(seq.getEleTy())); + auto shape = seq.getShape(); + auto constRows = seq.getConstantRows(); + if (constRows) { + decltype(constRows) i = constRows; + for (auto e : shape) { + baseTy = mlir::LLVM::LLVMType::getArrayTy(baseTy, e); + if (--i == 0) + break; + } + if (seq.hasConstantShape()) + return baseTy; + } + return baseTy.getPointerTo(); + } + + // fir.tdesc --> llvm<"i8*"> + // FIXME: for now use a void*, however pointer identity is not sufficient for + // the f18 object v. class distinction + mlir::LLVM::LLVMType convertTypeDescType(mlir::MLIRContext *ctx) { + return mlir::LLVM::LLVMType::getInt8PtrTy(&getContext()); + } + + /// Convert llvm::Type::TypeID to mlir::LLVM::LLVMType + mlir::LLVM::LLVMType fromRealTypeID(llvm::Type::TypeID typeID, + fir::KindTy kind) { + switch (typeID) { + case llvm::Type::TypeID::HalfTyID: + return mlir::LLVM::LLVMType::getHalfTy(&getContext()); + case llvm::Type::TypeID::FloatTyID: + return mlir::LLVM::LLVMType::getFloatTy(&getContext()); + case llvm::Type::TypeID::DoubleTyID: + return mlir::LLVM::LLVMType::getDoubleTy(&getContext()); + case llvm::Type::TypeID::X86_FP80TyID: + return mlir::LLVM::LLVMType::getX86_FP80Ty(&getContext()); + case llvm::Type::TypeID::FP128TyID: + return mlir::LLVM::LLVMType::getFP128Ty(&getContext()); + default: + emitError(UnknownLoc::get(&getContext())) + << "unsupported type: !fir.real<" << kind << ">"; + return {}; + } + } + + /// HACK: cloned from LLVMTypeConverter since this is private there + mlir::LLVM::LLVMType unwrap(mlir::Type type) { + if (!type) + return nullptr; + auto *mlirContext = type.getContext(); + auto wrappedLLVMType = type.dyn_cast(); + if (!wrappedLLVMType) + emitError(UnknownLoc::get(mlirContext), + "conversion resulted in a non-LLVM type"); + return wrappedLLVMType; + } + + /// Returns false iff the sequence type has a shape and the shape is constant. + static bool unknownShape(SequenceType::Shape shape) { + // does the shape even exist? + auto size = shape.size(); + if (size == 0) + return true; + // if it exists, are any dimensions deferred? + for (decltype(size) i = 0, sz = size; i < sz; ++i) + if (shape[i] == SequenceType::getUnknownExtent()) + return true; + return false; + } + + /// Does this record type have dynamically inlined subobjects? Note: this + /// should not look through references as they are not inlined. + static bool dynamicallySized(fir::RecordType seqTy) { + for (auto field : seqTy.getTypeList()) { + if (auto arr = field.second.dyn_cast()) { + if (unknownShape(arr.getShape())) + return true; + } else if (auto rec = field.second.dyn_cast()) { + if (dynamicallySized(rec)) + return true; + } + } + return false; + } + + static bool dynamicallySized(mlir::Type ty) { + if (auto arr = ty.dyn_cast()) + ty = arr.getEleTy(); + if (auto rec = ty.dyn_cast()) + return dynamicallySized(rec); + return false; + } + + NameUniquer &getUniquer() { return uniquer; } + + KindMapping &getKindMap() { return kindMapping; } + +private: + KindMapping kindMapping; + NameUniquer &uniquer; + std::unique_ptr specifics; + static StringMap identStructCache; +}; + +} // namespace fir + +#endif // OPTIMIZER_CODEGEN_TYPECONVERTER_H From 61c01d1a645bc0363d50dcca7f5a46a728b10e1c Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 20 Oct 2020 08:40:46 -0700 Subject: [PATCH 0308/1017] rebase fallout --- flang/unittests/Decimal/CMakeLists.txt | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/flang/unittests/Decimal/CMakeLists.txt b/flang/unittests/Decimal/CMakeLists.txt index 028bcbf7a3508..d301a9d3628c5 100644 --- a/flang/unittests/Decimal/CMakeLists.txt +++ b/flang/unittests/Decimal/CMakeLists.txt @@ -1,9 +1,5 @@ set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}) -add_executable(quick-sanity-test - quick-sanity-test.cpp -) - -target_link_libraries(quick-sanity-test +add_flang_nongtest_unittest(quick-sanity-test FortranDecimal ) @@ -12,5 +8,3 @@ add_flang_nongtest_unittest(thorough-test SLOW_TEST FortranDecimal ) - -add_test(NAME Sanity COMMAND quick-sanity-test) From 0d478b00e27c1faae21b2f64643b24de3e2678b7 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 20 Oct 2020 08:13:46 -0700 Subject: [PATCH 0309/1017] use mapSymbolAndAttributes on global alias Also rename instantiateLocalAlias to instantiateAlias and use it in global (the global code was also wrong not to use mapSymbolAndAttributes). --- flang/lib/Lower/Bridge.cpp | 21 ++++----------------- 1 file changed, 4 insertions(+), 17 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index ce9a38cd29d1a..5920bfda3975b 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1739,24 +1739,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Reference from an alternate entry point - use primary entry name. auto addrOf = builder->create(loc, global.resultType(), global.getSymbol()); - addSymbol(sym, addrOf); + mapSymbolAttributes(var, storeMap, addrOf); } return; } if (var.isAlias()) { - auto aliasOffset = var.getAlias(); - assert(storeMap.count(aliasOffset)); - auto store = storeMap.find(aliasOffset)->second; - auto i8Ty = builder->getIntegerType(8); - auto i8Ptr = builder->getRefType(i8Ty); - auto seqTy = builder->getRefType(builder->getVarLenSeqTy(i8Ty)); - auto base = builder->createConvert(loc, seqTy, store); - llvm::SmallVector offs{ - builder->createIntegerConstant(loc, idxTy, aliasOffset)}; - auto ptr = builder->create(loc, i8Ptr, base, offs); - auto addrOf = - builder->createConvert(loc, builder->getRefType(genType(sym)), ptr); - addSymbol(sym, addrOf); + instantiateAlias(var, storeMap); return; } if (const auto *details = @@ -1945,8 +1933,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { mapSymbolAttributes(var, storeMap); } - void - instantiateLocalAlias(const Fortran::lower::pft::Variable &var, + void instantiateAlias(const Fortran::lower::pft::Variable &var, llvm::DenseMap &storeMap) { assert(var.isAlias()); const auto &sym = var.getSymbol(); @@ -2628,7 +2615,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { } else if (var.isGlobal()) { instantiateGlobal(var, storeMap); } else if (var.isAlias()) { - instantiateLocalAlias(var, storeMap); + instantiateAlias(var, storeMap); } else { instantiateLocal(var, storeMap); } From f4ab0b3a95039936a18ffd30d23ce63c05c442f9 Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 14 Oct 2020 16:07:12 -0700 Subject: [PATCH 0310/1017] extend syntax on fir.do_loop to pass back the final value. extend syntax for fir.iterate_while as well. extend builder methods. --- flang/lib/Lower/Bridge.cpp | 1 + .../lib/Optimizer/Transforms/RewriteLoop.cpp | 19 ++- flang/test/Fir/loop01.fir | 159 ++++++++++++++++++ flang/test/Lower/intrinsics.f90 | 10 +- 4 files changed, 179 insertions(+), 10 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 5920bfda3975b..ceaeb8e75c07c 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -867,6 +867,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (info.isStructured()) { info.doLoop = builder->create( loc, lowerValue, upperValue, info.stepValue, info.isUnordered, + /*returnFinalCount=*/false, ArrayRef{lowerValue}); // initial doLoop result value builder->setInsertionPointToStart(info.doLoop.getBody()); // Update the loop variable value, as it may have non-index references. diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index a0fcd98d4b6ab..90f08e80e4fdf 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -108,7 +108,9 @@ class CfgLoopConv : public mlir::OpRewritePattern { llvm::SmallVector loopCarried; loopCarried.push_back(steppedIndex); - loopCarried.append(terminator->operand_begin(), terminator->operand_end()); + auto begin = loop.finalValue() ? std::next(terminator->operand_begin()) + : terminator->operand_begin(); + loopCarried.append(begin, terminator->operand_end()); loopCarried.push_back(itersMinusOne); rewriter.create(loc, conditionalBlock, loopCarried); rewriter.eraseOp(terminator); @@ -125,8 +127,10 @@ class CfgLoopConv : public mlir::OpRewritePattern { // The result of the loop operation is the values of the condition block // arguments except the induction variable on the last iteration. - rewriter.replaceOp( - loop, conditionalBlock->getArguments().drop_front().drop_back()); + auto args = loop.finalValue() + ? conditionalBlock->getArguments() + : conditionalBlock->getArguments().drop_front(); + rewriter.replaceOp(loop, args.drop_back()); return success(); } }; @@ -232,7 +236,9 @@ class CfgIterWhileConv : public mlir::OpRewritePattern { llvm::SmallVector loopCarried; loopCarried.push_back(stepped); - loopCarried.append(terminator->operand_begin(), terminator->operand_end()); + auto begin = whileOp.finalValue() ? std::next(terminator->operand_begin()) + : terminator->operand_begin(); + loopCarried.append(begin, terminator->operand_end()); rewriter.create(loc, conditionBlock, loopCarried); rewriter.eraseOp(terminator); @@ -261,7 +267,10 @@ class CfgIterWhileConv : public mlir::OpRewritePattern { llvm::ArrayRef()); // The result of the loop operation is the values of the condition block // arguments except the induction variable on the last iteration. - rewriter.replaceOp(whileOp, conditionBlock->getArguments().drop_front()); + auto args = whileOp.finalValue() + ? conditionBlock->getArguments() + : conditionBlock->getArguments().drop_front(); + rewriter.replaceOp(whileOp, args); return success(); } }; diff --git a/flang/test/Fir/loop01.fir b/flang/test/Fir/loop01.fir index 27c2fd7e713b5..40f0afa527ea6 100644 --- a/flang/test/Fir/loop01.fir +++ b/flang/test/Fir/loop01.fir @@ -20,3 +20,162 @@ func @x(%lb : index, %ub : index, %step : index, %b : i1, %addr : !fir.ref i1 + +// CHECK-LABEL: @x2 +func @x2(%lo : index, %up : index, %ok : i1) { + %c1 = constant 1 : index + // CHECK-DAG: %[[count:.*]] = phi i64 + // CHECK-DAG: %[[exit:.*]] = phi i1 + // CHECK: %[[cond:.*]] = icmp slt i64 %[[count]], % + // CHECK: %[[and:.*]] = and i1 %[[cond]], %[[exit]] + // CHECK: br i1 %[[and]] + %unused = fir.iterate_while (%i = %lo to %up step %c1) and (%ok1 = %ok) { + %ok2 = fir.call @f2() : () -> i1 + fir.result %ok2 : i1 + } + // CHECK: ret + return +} + +func @f3(i16) + +// do_loop with an extra loop-carried value +// CHECK-LABEL: @x3 +func @x3(%lo : index, %up : index) -> i1 { + %c1 = constant 1 : index + %ok1 = constant true + // CHECK-DAG: %[[ok:.*]] = phi i1 + // CHECK-DAG: %[[count:.*]] = phi i64 + // CHECK: = icmp sgt i64 %[[count]], 0 + %ok2 = fir.do_loop %i = %lo to %up step %c1 iter_args(%j = %ok1) -> i1 { + %ok = fir.call @f2() : () -> i1 + fir.result %ok : i1 + // CHECK: = sub i64 %[[count]], 1 + } + // CHECK: ret i1 %[[ok]] + return %ok2 : i1 +} + +// iterate_while with an extra loop-carried value +// CHECK-LABEL: @y3 +func @y3(%lo : index, %up : index) -> i1 { + %c1 = constant 1 : index + %ok1 = constant true + // CHECK: %[[ok4:.*]] = call i1 @f2() + %ok4 = fir.call @f2() : () -> i1 + // CHECK-DAG: %[[count:.*]] = phi i64 + // CHECK-DAG: %[[ok3:.*]] = phi i1 {{.*}}[ true + // CHECK-DAG: %[[j:.*]] = phi i1 {{.*}}[ %[[ok4]] + // CHECK: %[[prev:.*]] = icmp slt i64 %[[count]], + // CHECK: = and i1 %[[prev]], %[[ok3]] + %ok2:2 = fir.iterate_while (%i = %lo to %up step %c1) and (%ok3 = %ok1) iter_args(%j = %ok4) -> i1 { + %ok = fir.call @f2() : () -> i1 + fir.result %ok3, %ok : i1, i1 + // CHECK: = add i64 %[[count]], 1 + } + // CHECK: %[[result:.*]] = and i1 %[[ok3]], %[[j]] + %andok = and %ok2#0, %ok2#1 : i1 + // CHECK: ret i1 %[[result]] + return %andok : i1 +} + +func @f4(i32) -> i1 + +// do_loop that returns the final value of the induction +// CHECK-LABEL: @x4 +// CHECK-SAME: (i64 %[[lo:.*]], +func @x4(%lo : index, %up : index) -> index { + %c1 = constant 1 : index + // CHECK: %[[top:.*]] = add i64 + // CHECK-DAG: %[[i:.*]] = phi i64 {{.*}}[ %[[lo]], + // CHECK-DAG: %[[count:.*]] = phi i64 {{.*}}[ %[[top]], + // CHECK: icmp sgt i64 %[[count]], + %v = fir.do_loop %i = %lo to %up step %c1 -> index { + // CHECK: trunc i64 %[[i]] to i32 + %i1 = fir.convert %i : (index) -> i32 + // CHECK: call i1 @f4 + %ok = fir.call @f4(%i1) : (i32) -> i1 + fir.result %i : index + } + // CHECK: ret i64 %[[i]] + return %v : index +} + +// iterate_while that returns the final value of both inductions +// CHECK-LABEL: @y4 +func @y4(%lo : index, %up : index) -> index { + %c1 = constant 1 : index + %ok1 = constant true + // CHECK-DAG: %[[i:.*]] = phi i64 [ + // CHECK-DAG: %[[ok2:.*]] = phi i1 [ + // CHECK: icmp slt i64 %[[i]] + // CHECK: and i1 + %v:2 = fir.iterate_while (%i = %lo to %up step %c1) and (%ok2 = %ok1) -> (index, i1) { + %i1 = fir.convert %i : (index) -> i32 + // CHECK: call i1 @f4 + %ok = fir.call @f4(%i1) : (i32) -> i1 + fir.result %i, %ok : index, i1 + } + // CHECK: ret i64 %[[i]] + return %v#0 : index +} + +// do_loop that returns the final induction value +// and an extra loop-carried value +// CHECK-LABEL: @x5 +// CHECK-SAME: (i64 %[[lo:.*]], +func @x5(%lo : index, %up : index) -> index { + %c1 = constant 1 : index + // CHECK: %[[top:.*]] = add i64 + %s1 = constant 42 : i16 + // CHECK-DAG: %[[i:.*]] = phi i64 {{.*}}[ %[[lo]], + // CHECK-DAG: %[[count:.*]] = phi i64 {{.*}}[ %[[top]], + // CHECK-DAG: %[[s:.*]] = phi i16 + // CHECK: icmp sgt i64 %[[count]] + %v:2 = fir.do_loop %i = %lo to %up step %c1 iter_args(%s = %s1) -> (index, i16) { + // CHECK: call i1 @f2 + %ok = fir.call @f2() : () -> i1 + %s2 = fir.convert %ok : (i1) -> i16 + fir.result %i, %s2 : index, i16 + // CHECK: add i64 %[[i]], 1 + // CHECK: sub i64 %[[count]], 1 + } + // CHECK: call void @f3 + fir.call @f3(%v#1) : (i16) -> () + // CHECK: ret i64 %[[i]] + return %v#0 : index +} + +// iterate_while that returns the both induction values +// and an extra loop-carried value +// CHECK-LABEL: @y5 +// CHECK-SAME: (i64 %[[lo:.*]], +func @y5(%lo : index, %up : index) -> index { + %c1 = constant 1 : index + %s1 = constant 42 : i16 + %ok1 = constant true + // CHECK-DAG: %[[i:.*]] = phi i64 {{.*}}[ %[[lo]], + // CHECK-DAG: %[[ok2:.*]] = phi i1 {{.*}}[ true, + // CHECK-DAG: %[[s:.*]] = phi i16 {{.*}}[ 42, + // CHECK: icmp slt i64 %[[i]] + // CHECK: and i1 {{.*}}%[[ok2]] + %v:3 = fir.iterate_while (%i = %lo to %up step %c1) and (%ok2 = %ok1) iter_args(%s = %s1) -> (index, i1, i16) { + // CHECK: call i1 @f2 + %ok = fir.call @f2() : () -> i1 + %s2 = fir.convert %ok : (i1) -> i16 + fir.result %i, %ok, %s2 : index, i1, i16 + // CHECK: add i64 %[[i]], 1 + } + // CHECK: br i1 %[[ok2]], + fir.if %v#1 { + %arg = constant 0 : i32 + // CHECK: call i1 @f4 + %ok4 = fir.call @f4(%arg) : (i32) -> i1 + } + // CHECK: call void @f3(i16 %[[s]]) + fir.call @f3(%v#2) : (i16) -> () + // CHECK: ret i64 %[[i]] + return %v#0 : index +} diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index 54923c460a5cd..a18f03d8e5793 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -227,15 +227,15 @@ integer function len_trim_test(c) ! CHECK-DAG: %[[c1:.*]] = constant 1 : index ! CHECK-DAG: %[[cm1:.*]] = constant -1 : index ! CHECK-DAG: %[[lastChar:.*]] = subi {{.*}}, %[[c1]] - ! CHECK: %[[iterateResult:.*]], %[[lastIndex:.*]] = fir.iterate_while (%[[index:.*]] = %[[lastChar]] to %[[c0]] step %[[cm1]]) and ({{.*}}) iter_args({{.*}}) { + ! CHECK: %[[iterateResult:.*]]:2 = fir.iterate_while (%[[index:.*]] = %[[lastChar]] to %[[c0]] step %[[cm1]]) and ({{.*}}) iter_args({{.*}}) { ! CHECK: %[[addr:.*]] = fir.coordinate_of {{.*}}, %[[index]] ! CHECK: %[[char:.*]] = fir.load %[[addr]] ! CHECK: %[[code:.*]] = fir.convert %[[char]] ! CHECK: %[[bool:.*]] = cmpi "eq" - !CHECK fir.result %[[bool]], %[[index]] - ! CHECK } - ! CHECK-DAG: %[[len:.*]] = addi %[[lastIndex]], %[[c1]] - ! CHECK: select %[[iterateResult]], %[[c0]], %[[len]] + ! CHECK: fir.result %[[bool]], %[[index]] + ! CHECK: } + ! CHECK: %[[len:.*]] = addi %[[iterateResult]]#1, %[[c1]] + ! CHECK: select %[[iterateResult]]#0, %[[c0]], %[[len]] end function ! NINT From e29260d61e9f90c7d9072b1eb4d8072caff6eabe Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Mon, 19 Oct 2020 05:37:27 -0700 Subject: [PATCH 0311/1017] Support callee/caller result type mismatch in lowering --- flang/lib/Lower/ConvertExpr.cpp | 22 +++++++++++++++++++--- flang/test/Lower/non-standard.f90 | 16 ++++++++++++++++ 2 files changed, 35 insertions(+), 3 deletions(-) create mode 100644 flang/test/Lower/non-standard.f90 diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 3397e9d7a89fc..31adc651933ba 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1561,11 +1561,27 @@ class ExprLowering { // function type cast can be inserted. auto symbolAttr = builder.getSymbolRefAttr(caller.getMangledName()); if (callSiteType.getNumResults() != funcOpType.getNumResults() || - callSiteType.getNumInputs() != funcOpType.getNumInputs()) + callSiteType.getNumInputs() != funcOpType.getNumInputs()) { + // Do not emit a warning here because this can happen in legal program + // if the function is not defined here and it was first passed as an + // argument without any more information. funcPointer = builder.create(getLoc(), funcOpType, symbolAttr); - else + } else if (callSiteType.getResults() != funcOpType.getResults()) { + // Implicit interface result type mismatch are not standard Fortran, + // but some compilers are not complaining about it. + // The front-end is not protecting lowering from this currently. Support + // this with a discouraging warning. + mlir::emitWarning(getLoc(), + "return type mismatches were never standard" + " compliant and may lead to undefined behavior."); + // Cast the actual function to the current caller implicit type because + // that is the behavior we would get if we could not see the definition. + funcPointer = + builder.create(getLoc(), funcOpType, symbolAttr); + } else { funcSymbolAttr = symbolAttr; + } } auto funcType = funcPointer ? caller.genFunctionType() : caller.getFuncOp().getType(); @@ -1586,7 +1602,7 @@ class ExprLowering { operands.push_back(cast); } - auto call = builder.create(getLoc(), caller.getResultType(), + auto call = builder.create(getLoc(), funcType.getResults(), funcSymbolAttr, operands); // Handle case where result was passed as argument if (caller.getPassedResult()) { diff --git a/flang/test/Lower/non-standard.f90 b/flang/test/Lower/non-standard.f90 new file mode 100644 index 0000000000000..dc96b4d2ea5e2 --- /dev/null +++ b/flang/test/Lower/non-standard.f90 @@ -0,0 +1,16 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test lowering of non standard features. + +! Test mismatch on result type between callee/caller +! CHECK-LABEL: func @_QPexpect_i32 +subroutine expect_i32() + external :: returns_i32 + real(4) :: returns_i32 + ! CHECK: %[[funcAddr:.*]] = fir.address_of(@_QPreturns_i32) : () -> i32 + ! CHECK: %[[funcCast:.*]] = fir.convert %[[funcAddr]] : (() -> i32) -> (() -> f32) + ! CHECK: fir.call %[[funcCast]]() : () -> f32 + print *, returns_i32() +end subroutine +integer(4) function returns_i32() +end function From 2c92e2843c35b851b8c1320b62b663900433a36d Mon Sep 17 00:00:00 2001 From: Kiran Chandramohan Date: Wed, 21 Oct 2020 18:07:44 +0100 Subject: [PATCH 0312/1017] Add AArch64 target Addition of the AArch64 target will enable lowering on this platform. All tests can also be run with this change. --- flang/lib/Optimizer/CodeGen/Target.cpp | 56 ++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/flang/lib/Optimizer/CodeGen/Target.cpp b/flang/lib/Optimizer/CodeGen/Target.cpp index dfda81ac9924d..50e5c74770bcf 100644 --- a/flang/lib/Optimizer/CodeGen/Target.cpp +++ b/flang/lib/Optimizer/CodeGen/Target.cpp @@ -158,6 +158,53 @@ struct TargetX86_64 : public GenericTarget { }; } // namespace +//===----------------------------------------------------------------------===// +// AArch64 (AArch64 bit) linux target specifics. +//===----------------------------------------------------------------------===// + +namespace { +struct TargetAArch64 : public GenericTarget { + using GenericTarget::GenericTarget; + + static constexpr int defaultWidth = 64; + + CodeGenSpecifics::Marshalling + complexArgumentType(mlir::Type eleTy) const override { + CodeGenSpecifics::Marshalling marshal; + const auto *sem = &floatToSemantics(kindMap, eleTy); + if (sem == &llvm::APFloat::IEEEsingle()) { + // <2 x t> vector of 2 eleTy + marshal.emplace_back(fir::VectorType::get(2, eleTy), AT{}); + } else if (sem == &llvm::APFloat::IEEEdouble()) { + // two distinct double arguments + marshal.emplace_back(eleTy, AT{}); + marshal.emplace_back(eleTy, AT{}); + } else { + llvm_unreachable("not implemented"); + } + return marshal; + } + + CodeGenSpecifics::Marshalling + complexReturnType(mlir::Type eleTy) const override { + CodeGenSpecifics::Marshalling marshal; + const auto *sem = &floatToSemantics(kindMap, eleTy); + if (sem == &llvm::APFloat::IEEEsingle()) { + // <2 x t> vector of 2 eleTy + marshal.emplace_back(fir::VectorType::get(2, eleTy), AT{}); + } else if (sem == &llvm::APFloat::IEEEdouble()) { + // { double, double } struct of 2 double + mlir::TypeRange range = {eleTy, eleTy}; + marshal.emplace_back(mlir::TupleType::get(range, eleTy.getContext()), + AT{}); + } else { + llvm_unreachable("not implemented"); + } + return marshal; + } +}; +} // namespace + // Instantiate the overloaded target instance based on the triple value. // Currently, the implementation only instantiates `i386-unknown-linux-gnu` and // `x86_64-unknown-linux-gnu` like triples. Other targets should be added to @@ -186,6 +233,15 @@ fir::CodeGenSpecifics::get(mlir::MLIRContext *ctx, llvm::Triple &trp, return std::make_unique(ctx, trp, kindMap); } break; + case llvm::Triple::ArchType::aarch64: + switch (trp.getOS()) { + default: + break; + case llvm::Triple::OSType::Linux: + case llvm::Triple::OSType::Darwin: + return std::make_unique(ctx, trp, kindMap); + } + break; } llvm::report_fatal_error("target not implemented"); } From 546ecfe4bfa5478d206a95ce31579513be67ec94 Mon Sep 17 00:00:00 2001 From: zacharyselk Date: Thu, 22 Oct 2020 08:55:39 -0600 Subject: [PATCH 0313/1017] Move alloca to begining of function --- flang/lib/Lower/ConvertExpr.cpp | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 31adc651933ba..07c473b7397b9 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1682,8 +1682,13 @@ class ExprLowering { return exv; // Since `a` is not itself a valid referent, determine its value and - // create a temporary location for referencing. + // create a temporary location at the begining of the function for + // referencing. + auto func = builder.getFunction(); + auto initPos = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(&func.front()); auto mem = builder.create(getLoc(), valBase.getType()); + builder.restoreInsertionPoint(initPos); builder.create(getLoc(), valBase, mem); return fir::substBase(exv, mem.getResult()); } From fbba95c491c95ab644d3da5d09509f4a890c5717 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 22 Oct 2020 11:17:21 -0700 Subject: [PATCH 0314/1017] [NFC] run clang-format --- flang/lib/Lower/ConvertExpr.cpp | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 07c473b7397b9..7068e8a099d9f 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1682,13 +1682,13 @@ class ExprLowering { return exv; // Since `a` is not itself a valid referent, determine its value and - // create a temporary location at the begining of the function for - // referencing. - auto func = builder.getFunction(); - auto initPos = builder.saveInsertionPoint(); - builder.setInsertionPointToStart(&func.front()); + // create a temporary location at the begining of the function for + // referencing. + auto func = builder.getFunction(); + auto initPos = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(&func.front()); auto mem = builder.create(getLoc(), valBase.getType()); - builder.restoreInsertionPoint(initPos); + builder.restoreInsertionPoint(initPos); builder.create(getLoc(), valBase, mem); return fir::substBase(exv, mem.getResult()); } From e9c6c03d76f0ffc0ab4f33e00c473b34b34405a7 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Mon, 19 Oct 2020 02:27:13 -0700 Subject: [PATCH 0315/1017] Regroup all emboxing boilerplate in FirOpBuilder::createBox --- flang/include/flang/Lower/CharacterExpr.h | 4 +++ flang/include/flang/Lower/FIRBuilder.h | 7 ++++ flang/lib/Lower/CharacterExpr.cpp | 17 +++++++++ flang/lib/Lower/FIRBuilder.cpp | 44 ++++++++++++++++++++++- flang/test/Lower/io-item-list.f90 | 27 ++++++++++++++ 5 files changed, 98 insertions(+), 1 deletion(-) create mode 100644 flang/test/Lower/io-item-list.f90 diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index 2c9d16cb4c080..e11f9a3540b15 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -104,6 +104,10 @@ class CharacterExprHelper { /// - fir.array> static bool isCharacterScalar(mlir::Type type); + /// Does this extended value holds a !fir.array> + /// where len is not the unknown extent ? + static bool hasConstantLengthInType(const fir::ExtendedValue &); + /// Extract the kind of a character type static fir::KindTy getCharacterKind(mlir::Type type); diff --git a/flang/include/flang/Lower/FIRBuilder.h b/flang/include/flang/Lower/FIRBuilder.h index f09365aaf825d..78c935476b4ce 100644 --- a/flang/include/flang/Lower/FIRBuilder.h +++ b/flang/include/flang/Lower/FIRBuilder.h @@ -210,6 +210,13 @@ class FirOpBuilder : public mlir::OpBuilder { /// Create one of the shape ops given an extended value. mlir::Value createShape(mlir::Location loc, const fir::ExtendedValue &exv); + /// Create a boxed value (Fortran descriptor) to be passed to the runtime. + /// \p exv is an extended value holding a memory reference to the object that + /// must be boxed. This function will crash if provided something that is not + /// a memory reference type. + /// Array entities are boxed with a shape and character with their length. + mlir::Value createBox(mlir::Location loc, const fir::ExtendedValue &exv); + private: const fir::KindMapping &kindMap; }; diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index cc139f8f6b873..6f125abac0f42 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -632,3 +632,20 @@ Fortran::lower::CharacterExprHelper::readLengthFromBox(mlir::Value box) { } return size; } + +bool Fortran::lower::CharacterExprHelper::hasConstantLengthInType( + const fir::ExtendedValue &exv) { + auto type = fir::getBase(exv).getType(); + if (auto boxTy = type.dyn_cast()) + type = boxTy.getEleTy(); + if (auto eleTy = fir::dyn_cast_ptrEleTy(type)) + type = eleTy; + if (auto seqTy = type.dyn_cast()) { + assert(seqTy.getEleTy().isa() && + "entity is not a character"); + assert(seqTy.getShape().size() > 0 && "character has empty shape"); + auto lenVal = seqTy.getShape()[0]; + return lenVal != fir::SequenceType::getUnknownExtent(); + } + return false; +} diff --git a/flang/lib/Lower/FIRBuilder.cpp b/flang/lib/Lower/FIRBuilder.cpp index 89577eac82df9..128137775937f 100644 --- a/flang/lib/Lower/FIRBuilder.cpp +++ b/flang/lib/Lower/FIRBuilder.cpp @@ -9,6 +9,7 @@ #include "flang/Lower/FIRBuilder.h" #include "SymbolMap.h" #include "flang/Lower/Bridge.h" +#include "flang/Lower/CharacterExpr.h" #include "flang/Lower/ComplexExpr.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/Support/BoxValue.h" @@ -203,7 +204,7 @@ Fortran::lower::FirOpBuilder::createShape(mlir::Location loc, auto shapeTy = fir::ShapeShiftType::get(getContext(), box.getExtents().size()); llvm::SmallVector pairs; - for (auto [fst,snd] : llvm::zip(box.getLBounds(), box.getExtents())) { + for (auto [fst, snd] : llvm::zip(box.getLBounds(), box.getExtents())) { pairs.push_back(createConvert(loc, idxTy, fst)); pairs.push_back(createConvert(loc, idxTy, snd)); } @@ -218,3 +219,44 @@ Fortran::lower::FirOpBuilder::createShape(mlir::Location loc, return mlir::Value{}; }); } + +mlir::Value +Fortran::lower::FirOpBuilder::createBox(mlir::Location loc, + const fir::ExtendedValue &exv) { + auto itemAddr = fir::getBase(exv); + auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType()); + if (!elementType) + mlir::emitError(loc, "internal: expected a memory reference type ") + << itemAddr.getType(); + auto boxTy = fir::BoxType::get(elementType); + return exv.match( + [&](const fir::ArrayBoxValue &box) -> mlir::Value { + auto s = createShape(loc, exv); + return create(loc, boxTy, itemAddr, s); + }, + [&](const fir::CharArrayBoxValue &box) -> mlir::Value { + auto s = createShape(loc, exv); + if (Fortran::lower::CharacterExprHelper::hasConstantLengthInType(exv)) + return create(loc, boxTy, itemAddr, s); + + mlir::Value emptySlice; + llvm::SmallVector lenParams{box.getLen()}; + return create(loc, boxTy, itemAddr, s, emptySlice, + lenParams); + }, + [&](const fir::BoxValue &box) -> mlir::Value { + auto s = createShape(loc, exv); + return create(loc, boxTy, itemAddr, s); + }, + [&](const fir::CharBoxValue &box) -> mlir::Value { + if (Fortran::lower::CharacterExprHelper::hasConstantLengthInType(exv)) + return create(loc, boxTy, itemAddr); + mlir::Value emptyShape, emptySlice; + llvm::SmallVector lenParams{box.getLen()}; + return create(loc, boxTy, itemAddr, emptyShape, + emptySlice, lenParams); + }, + [&](const auto &) -> mlir::Value { + return create(loc, boxTy, itemAddr); + }); +} diff --git a/flang/test/Lower/io-item-list.f90 b/flang/test/Lower/io-item-list.f90 new file mode 100644 index 0000000000000..bd1b3aa8dac30 --- /dev/null +++ b/flang/test/Lower/io-item-list.f90 @@ -0,0 +1,27 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test that IO item list + +! FIXME: embox does not like getting a length when it gets +! a !fir.ref> buffer. Either the verifier +! should be relaxed, or we should finish up ensuring character +! type for such buffer are !fir.ref>> +! +!subroutine pass_assumed_len_char(c) +! character(*) :: c +! write(1, rec=1) c +!end + +! CHECK-LABEL: func @_QPpass_assumed_len_char_array +subroutine pass_assumed_len_char_array(carray) + character(*) :: carray(2, 3) + ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK-DAG: %[[buffer:.*]] = fir.convert %[[unboxed]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK-DAG: %[[c2:.*]] = constant 2 : index + ! CHECK-DAG: %[[c3:.*]] = constant 3 : index + ! CHECK-DAG: %[[shape:.*]] = fir.shape %[[c2]], %[[c3]] : (index, index) -> !fir.shape<2> + ! CHECK: %[[box:.*]] = fir.embox %[[buffer]](%[[shape]]) typeparams %[[unboxed]]#1 : (!fir.ref>>, !fir.shape<2>, index) -> !fir.box>> + ! CHECK: %[[descriptor:.*]] = fir.convert %[[box]] : (!fir.box>>) -> !fir.box + ! CHECK: fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[descriptor]]) : (!fir.ref, !fir.box) -> i1 + print *, carray +end From a321cda0181731f29110ef1220351fe8a279ffc1 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 22 Oct 2020 09:24:15 -0700 Subject: [PATCH 0316/1017] Remove toDataLengthPair from character helper This is a legacy function, it was kept to protect from array character in context that are not array ready. It fired in createUnboxChar where it is OK to get arrays. Remove it and enforce the arrays bans on caller sides where it make sens. --- flang/include/flang/Lower/CharacterExpr.h | 4 +--- flang/lib/Lower/CharacterExpr.cpp | 17 ----------------- 2 files changed, 1 insertion(+), 20 deletions(-) diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h index e11f9a3540b15..4dae4a87804c9 100644 --- a/flang/include/flang/Lower/CharacterExpr.h +++ b/flang/include/flang/Lower/CharacterExpr.h @@ -68,7 +68,7 @@ class CharacterExprHelper { const fir::CharBoxValue &rhs); /// LEN_TRIM intrinsic. - mlir::Value createLenTrim(mlir::Value str); + mlir::Value createLenTrim(const fir::CharBoxValue &str); /// Embox \p addr and \p len and return fir.boxchar. /// Take care of type conversions before emboxing. @@ -163,7 +163,6 @@ class CharacterExprHelper { /// FIXME: the implementation also needs a clean-up now that /// CharBoxValue are better propagated. fir::CharBoxValue materializeValue(mlir::Value str); - fir::CharBoxValue toDataLengthPair(mlir::Value character); mlir::Type getReferenceType(const fir::CharBoxValue &c) const; mlir::Type getReferenceType(mlir::Value str) const; mlir::Type getSeqTy(const fir::CharBoxValue &c) const; @@ -174,7 +173,6 @@ class CharacterExprHelper { void createLengthOneAssign(const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs); void createAssign(const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs); - mlir::Value createLenTrim(const fir::CharBoxValue &str); mlir::Value createBlankConstantCode(fir::CharacterType type); private: diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp index 6f125abac0f42..cc139f8f6b873 100644 --- a/flang/lib/Lower/CharacterExpr.cpp +++ b/flang/lib/Lower/CharacterExpr.cpp @@ -632,20 +632,3 @@ Fortran::lower::CharacterExprHelper::readLengthFromBox(mlir::Value box) { } return size; } - -bool Fortran::lower::CharacterExprHelper::hasConstantLengthInType( - const fir::ExtendedValue &exv) { - auto type = fir::getBase(exv).getType(); - if (auto boxTy = type.dyn_cast()) - type = boxTy.getEleTy(); - if (auto eleTy = fir::dyn_cast_ptrEleTy(type)) - type = eleTy; - if (auto seqTy = type.dyn_cast()) { - assert(seqTy.getEleTy().isa() && - "entity is not a character"); - assert(seqTy.getShape().size() > 0 && "character has empty shape"); - auto lenVal = seqTy.getShape()[0]; - return lenVal != fir::SequenceType::getUnknownExtent(); - } - return false; -} From 02adafb17a442444100260674bebb5223f42c951 Mon Sep 17 00:00:00 2001 From: Eric Date: Wed, 21 Oct 2020 15:57:39 -0700 Subject: [PATCH 0317/1017] Split out the target rewrite pass into its own source file. Add the ability to test if a subprogram is recursive or not. --- flang/include/flang/Lower/PFTBuilder.h | 8 + flang/lib/Lower/PFTBuilder.cpp | 29 +- flang/lib/Optimizer/CMakeLists.txt | 1 + flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 684 ----------------- flang/lib/Optimizer/CodeGen/TargetRewrite.cpp | 703 ++++++++++++++++++ 5 files changed, 740 insertions(+), 685 deletions(-) create mode 100644 flang/lib/Optimizer/CodeGen/TargetRewrite.cpp diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 0ea0ea49cb88f..288deaed85bcf 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -70,6 +70,10 @@ class ReferenceVariantBase { return std::get>(u).get(); } template + constexpr BaseType &getStatement() const { + return std::get>>(u).get().statement; + } + template constexpr BaseType *getIf() const { auto *ptr = std::get_if>(&u); return ptr ? &ptr->get() : nullptr; @@ -547,6 +551,8 @@ struct FunctionLikeUnit : public ProgramUnit { FunctionLikeUnit(FunctionLikeUnit &&) = default; FunctionLikeUnit(const FunctionLikeUnit &) = delete; + bool isRecursive() { return isMainProgram() ? false : recursiveFunction; } + std::vector getOrderedSymbolTable() { return varList[0]; } bool isMainProgram() const { @@ -574,6 +580,7 @@ struct FunctionLikeUnit : public ProgramUnit { assert(symbol && "not inside a procedure"); return *symbol; } + /// Return a pointer to the current entry point Evaluation. /// This is null for a primary entry point. Evaluation *getEntryEval() const { @@ -611,6 +618,7 @@ struct FunctionLikeUnit : public ProgramUnit { /// Terminal basic block (if any) mlir::Block *finalBlock{}; std::vector> varList; + bool recursiveFunction{}; }; /// Module-like units contain a list of function-like units. diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 856ba342dc2bf..f003b26e09b6d 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -23,6 +23,17 @@ static llvm::cl::opt clDisableStructuredFir( "no-structured-fir", llvm::cl::desc("disable generation of structured FIR"), llvm::cl::init(false), llvm::cl::Hidden); +// FIXME: should be set with switch such as `--std=2018`. +static llvm::cl::opt nonRecursiveProcedures( + "non-recursive-procedures", + llvm::cl::desc("Make procedures non-recursive by default. This was the " + "default for all Fortran standards prior to 2018."), + llvm::cl::init(/*2018 standard=*/false)); + +static bool defaultRecursiveFunctionSetting() { + return !nonRecursiveProcedures; +} + using namespace Fortran; namespace { @@ -1275,6 +1286,17 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( } } +template +static bool procedureIsRecursive(const A &stmt) { + for (const auto &p : std::get>(stmt.t)) { + if (std::holds_alternative(p.u)) + return true; + if (std::holds_alternative(p.u)) + return false; + } + return defaultRecursiveFunctionSetting(); +} + Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( const parser::FunctionSubprogram &func, const lower::pft::ParentVariant &parent, @@ -1283,6 +1305,8 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( beginStmt{getFunctionStmt(func)}, endStmt{getFunctionStmt(func)} { auto symbol = getSymbol(*beginStmt); + recursiveFunction = + procedureIsRecursive(beginStmt->getStatement()); entryPointList[0].first = symbol; processSymbolTable(*symbol->scope(), varList); } @@ -1295,6 +1319,8 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( beginStmt{getFunctionStmt(func)}, endStmt{getFunctionStmt(func)} { auto symbol = getSymbol(*beginStmt); + recursiveFunction = + procedureIsRecursive(beginStmt->getStatement()); entryPointList[0].first = symbol; processSymbolTable(*symbol->scope(), varList); } @@ -1305,7 +1331,8 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( const semantics::SemanticsContext &) : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, - endStmt{getFunctionStmt(func)} { + endStmt{getFunctionStmt(func)}, + recursiveFunction{defaultRecursiveFunctionSetting()} { auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; processSymbolTable(*symbol->scope(), varList); diff --git a/flang/lib/Optimizer/CMakeLists.txt b/flang/lib/Optimizer/CMakeLists.txt index e71a177c76abf..29f0300327636 100644 --- a/flang/lib/Optimizer/CMakeLists.txt +++ b/flang/lib/Optimizer/CMakeLists.txt @@ -16,6 +16,7 @@ add_flang_library(FIROptimizer CodeGen/CodeGen.cpp CodeGen/PreCGRewrite.cpp CodeGen/Target.cpp + CodeGen/TargetRewrite.cpp Transforms/ControlFlowConverter.cpp Transforms/CSE.cpp diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index 7b63d1b582286..d247937183240 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -11,20 +11,14 @@ //===----------------------------------------------------------------------===// #include "PassDetail.h" -#include "Target.h" #include "flang/Optimizer/CodeGen/CodeGen.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Dialect/FIRType.h" #include "flang/Optimizer/Support/FIRContext.h" -#include "flang/Optimizer/Transforms/Passes.h" -#include "mlir/Pass/Pass.h" #include "mlir/Transforms/DialectConversion.h" #include "llvm/ADT/STLExtras.h" -#include "llvm/ADT/TypeSwitch.h" -#include "llvm/Support/CommandLine.h" #include "llvm/Support/Debug.h" -#include //===----------------------------------------------------------------------===// // Codegen rewrite: rewriting of subgraphs of ops @@ -303,681 +297,3 @@ class CodeGenRewrite : public CodeGenRewriteBase { std::unique_ptr fir::createFirCodeGenRewritePass() { return std::make_unique(); } - -//===----------------------------------------------------------------------===// -// Target rewrite: reriting of ops to make target-specific lowerings manifest. -//===----------------------------------------------------------------------===// - -#undef DEBUG_TYPE -#define DEBUG_TYPE "flang-target-rewrite" - -namespace { - -/// Fixups for updating a FuncOp's arguments and return values. -struct FixupTy { - // clang-format off - enum class Codes { - ArgumentAsLoad, ArgumentType, CharPair, ReturnAsStore, ReturnType, - Split, Trailing - }; - // clang-format on - - FixupTy(Codes code, std::size_t index, std::size_t second = 0) - : code{code}, index{index}, second{second} {} - FixupTy(Codes code, std::size_t index, - std::function &&finalizer) - : code{code}, index{index}, finalizer{finalizer} {} - FixupTy(Codes code, std::size_t index, std::size_t second, - std::function &&finalizer) - : code{code}, index{index}, second{second}, finalizer{finalizer} {} - - Codes code; - std::size_t index; - std::size_t second{}; - llvm::Optional> finalizer{}; -}; // namespace - -/// Target-specific rewriting of the IR. This is a prerequisite pass to code -/// generation that traverses the IR and modifies types and operations to a -/// form that appropriate for the specific target. LLVM IR has specific idioms -/// that are used for distinct target processor and ABI combinations. -class TargetRewrite : public TargetRewriteBase { -public: - TargetRewrite(const TargetRewriteOptions &options) { - noCharacterConversion = options.noCharacterConversion; - noComplexConversion = options.noComplexConversion; - } - - void runOnOperation() override final { - auto &context = getContext(); - mlir::OpBuilder rewriter(&context); - auto mod = getModule(); - auto specifics = CodeGenSpecifics::get(getOperation().getContext(), - *getTargetTriple(getOperation()), - *getKindMapping(getOperation())); - setMembers(specifics.get(), &rewriter); - - // Perform type conversion on signatures and call sites. - if (mlir::failed(convertTypes(mod))) { - mlir::emitError(mlir::UnknownLoc::get(&context), - "error in converting types to target abi"); - signalPassFailure(); - } - - // Convert ops in target-specific patterns. - mod.walk([&](mlir::Operation *op) { - if (auto call = dyn_cast(op)) { - if (!hasPortableSignature(call.getFunctionType())) - convertCallOp(call); - } else if (auto dispatch = dyn_cast(op)) { - if (!hasPortableSignature(dispatch.getFunctionType())) - convertCallOp(dispatch); - } else if (auto addr = dyn_cast(op)) { - if (addr.getType().isa() && - !hasPortableSignature(addr.getType())) - convertAddrOp(addr); - } - }); - - clearMembers(); - } - - mlir::ModuleOp getModule() { return getOperation(); } - - template - std::function - rewriteCallComplexResultType(A ty, B &newResTys, B &newInTys, C &newOpers) { - auto m = specifics->complexReturnType(ty.getElementType()); - // Currently targets mandate COMPLEX is a single aggregate or packed - // scalar, included the sret case. - assert(m.size() == 1 && "target lowering of complex return not supported"); - auto resTy = std::get(m[0]); - auto attr = std::get(m[0]); - auto loc = mlir::UnknownLoc::get(resTy.getContext()); - if (attr.isSRet()) { - assert(isa_ref_type(resTy)); - mlir::Value stack = - rewriter->create(loc, dyn_cast_ptrEleTy(resTy)); - newInTys.push_back(resTy); - newOpers.push_back(stack); - return [=](mlir::Operation *) -> mlir::Value { - auto memTy = ReferenceType::get(ty); - auto cast = rewriter->create(loc, memTy, stack); - return rewriter->create(loc, cast); - }; - } - newResTys.push_back(resTy); - return [=](mlir::Operation *call) -> mlir::Value { - auto mem = rewriter->create(loc, resTy); - rewriter->create(loc, call->getResult(0), mem); - auto memTy = ReferenceType::get(ty); - auto cast = rewriter->create(loc, memTy, mem); - return rewriter->create(loc, cast); - }; - } - - template - void rewriteCallComplexInputType(A ty, mlir::Value oper, B &newInTys, - C &newOpers) { - auto m = specifics->complexArgumentType(ty.getElementType()); - auto *ctx = ty.getContext(); - auto loc = mlir::UnknownLoc::get(ctx); - if (m.size() == 1) { - // COMPLEX is a single aggregate - auto resTy = std::get(m[0]); - auto attr = std::get(m[0]); - auto oldRefTy = ReferenceType::get(ty); - if (attr.isByVal()) { - auto mem = rewriter->create(loc, ty); - rewriter->create(loc, oper, mem); - newOpers.push_back(rewriter->create(loc, resTy, mem)); - } else { - auto mem = rewriter->create(loc, resTy); - auto cast = rewriter->create(loc, oldRefTy, mem); - rewriter->create(loc, oper, cast); - newOpers.push_back(rewriter->create(loc, mem)); - } - newInTys.push_back(resTy); - } else { - assert(m.size() == 2); - // COMPLEX is split into 2 separate arguments - auto iTy = rewriter->getIntegerType(32); - for (auto e : llvm::enumerate(m)) { - auto &tup = e.value(); - auto ty = std::get(tup); - auto index = e.index(); - mlir::Value idx = rewriter->create( - loc, iTy, mlir::IntegerAttr::get(iTy, index)); - auto val = rewriter->create(loc, ty, oper, idx); - newInTys.push_back(ty); - newOpers.push_back(val); - } - } - } - - // Convert fir.call and fir.dispatch Ops. - template - void convertCallOp(A callOp) { - auto fnTy = callOp.getFunctionType(); - auto loc = callOp.getLoc(); - rewriter->setInsertionPoint(callOp); - llvm::SmallVector newResTys; - llvm::SmallVector newInTys; - llvm::SmallVector newOpers; - // FIXME: if the call is indirect, the first argument must still be the - // function to call. - llvm::Optional> wrap; - if (fnTy.getResults().size() == 1) { - mlir::Type ty = fnTy.getResult(0); - llvm::TypeSwitch(ty) - .template Case([&](fir::ComplexType cmplx) { - wrap = rewriteCallComplexResultType(cmplx, newResTys, newInTys, - newOpers); - }) - .template Case([&](mlir::ComplexType cmplx) { - wrap = rewriteCallComplexResultType(cmplx, newResTys, newInTys, - newOpers); - }) - .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); - } else if (fnTy.getResults().size() > 1) { - // If the function is returning more than 1 result, do not perform any - // target-specific lowering. (FIXME?) This may need to be revisited. - newResTys.insert(newResTys.end(), fnTy.getResults().begin(), - fnTy.getResults().end()); - } - llvm::SmallVector trailingInTys; - llvm::SmallVector trailingOpers; - for (auto e : - llvm::enumerate(llvm::zip(fnTy.getInputs(), callOp.getOperands()))) { - mlir::Type ty = std::get<0>(e.value()); - mlir::Value oper = std::get<1>(e.value()); - unsigned index = e.index(); - llvm::TypeSwitch(ty) - .template Case([&](BoxCharType boxTy) { - bool sret; - if constexpr (std::is_same_v, fir::CallOp>) { - sret = callOp.callee() && - functionArgIsSRet(index, - getModule().lookupSymbol( - *callOp.callee())); - } else { - // TODO: dispatch case; how do we put arguments on a call? - sret = false; - llvm_unreachable("not implemented"); - } - auto m = specifics->boxcharArgumentType(boxTy.getEleTy(), sret); - auto unbox = - rewriter->create(loc, std::get(m[0]), - std::get(m[1]), oper); - // unboxed CHARACTER arguments - for (auto e : llvm::enumerate(m)) { - unsigned idx = e.index(); - auto attr = std::get(e.value()); - auto argTy = std::get(e.value()); - if (attr.isAppend()) { - trailingInTys.push_back(argTy); - trailingOpers.push_back(unbox.getResult(idx)); - } else { - newInTys.push_back(argTy); - newOpers.push_back(unbox.getResult(idx)); - } - } - }) - .template Case([&](fir::ComplexType cmplx) { - rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); - }) - .template Case([&](mlir::ComplexType cmplx) { - rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); - }) - .Default([&](mlir::Type ty) { - newInTys.push_back(ty); - newOpers.push_back(oper); - }); - } - newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); - newOpers.insert(newOpers.end(), trailingOpers.begin(), trailingOpers.end()); - if constexpr (std::is_same_v, fir::CallOp>) { - assert(callOp.callee().hasValue() && "indirect call not implemented"); - auto newCall = rewriter->create(loc, callOp.callee().getValue(), - newResTys, newOpers); - LLVM_DEBUG(llvm::dbgs() << "replacing call with " << newCall << '\n'); - if (wrap.hasValue()) - replaceOp(callOp, (*wrap)(newCall.getOperation())); - else - replaceOp(callOp, newCall.getResults()); - } else { - // A is fir::DispatchOp - llvm_unreachable("not implemented"); // TODO - } - } - - // Result type fixup for fir::ComplexType and mlir::ComplexType - template - void lowerComplexSignatureRes(A cmplx, B &newResTys, B &newInTys) { - if (noComplexConversion) { - newResTys.push_back(cmplx); - } else { - for (auto &tup : specifics->complexReturnType(cmplx.getElementType())) { - auto argTy = std::get(tup); - if (std::get(tup).isSRet()) - newInTys.push_back(argTy); - else - newResTys.push_back(argTy); - } - } - } - - // Argument type fixup for fir::ComplexType and mlir::ComplexType - template - void lowerComplexSignatureArg(A cmplx, B &newInTys) { - if (noComplexConversion) - newInTys.push_back(cmplx); - else - for (auto &tup : specifics->complexArgumentType(cmplx.getElementType())) - newInTys.push_back(std::get(tup)); - } - - /// Taking the address of a function. Modify the signature as needed. - void convertAddrOp(AddrOfOp addrOp) { - auto addrTy = addrOp.getType().cast(); - llvm::SmallVector newResTys; - llvm::SmallVector newInTys; - for (mlir::Type ty : addrTy.getResults()) { - llvm::TypeSwitch(ty) - .Case([&](fir::ComplexType ty) { - lowerComplexSignatureRes(ty, newResTys, newInTys); - }) - .Case([&](mlir::ComplexType ty) { - lowerComplexSignatureRes(ty, newResTys, newInTys); - }) - .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); - } - llvm::SmallVector trailingInTys; - for (mlir::Type ty : addrTy.getInputs()) { - llvm::TypeSwitch(ty) - .Case([&](BoxCharType box) { - if (noCharacterConversion) { - newInTys.push_back(box); - } else { - for (auto &tup : specifics->boxcharArgumentType(box.getEleTy())) { - auto attr = std::get(tup); - auto argTy = std::get(tup); - auto &vec = attr.isAppend() ? trailingInTys : newInTys; - vec.push_back(argTy); - } - } - }) - .Case([&](fir::ComplexType ty) { - lowerComplexSignatureArg(ty, newInTys); - }) - .Case([&](mlir::ComplexType ty) { - lowerComplexSignatureArg(ty, newInTys); - }) - .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); - } - // append trailing input types - newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); - // replace this op with a new one with the updated signature - auto newTy = rewriter->getFunctionType(newInTys, newResTys); - auto newOp = - rewriter->create(addrOp.getLoc(), newTy, addrOp.symbol()); - replaceOp(addrOp, newOp.getOperation()->getResults()); - } - - /// Convert the type signatures on all the functions present in the module. - /// As the type signature is being changed, this must also update the - /// function itself to use any new arguments, etc. - mlir::LogicalResult convertTypes(mlir::ModuleOp mod) { - for (auto fn : mod.getOps()) - convertSignature(fn); - return mlir::success(); - } - - /// If the signature does not need any special target-specific converions, - /// then it is considered portable for any target, and this function will - /// return `true`. Otherwise, the signature is not portable and `false` is - /// returned. - bool hasPortableSignature(mlir::Type signature) { - assert(signature.isa()); - auto func = signature.dyn_cast(); - for (auto ty : func.getResults()) - if ((ty.isa() && !noCharacterConversion) || - (isa_complex(ty) && !noComplexConversion)) { - LLVM_DEBUG(llvm::dbgs() << "rewrite " << signature << " for target\n"); - return false; - } - for (auto ty : func.getInputs()) - if ((ty.isa() && !noCharacterConversion) || - (isa_complex(ty) && !noComplexConversion)) { - LLVM_DEBUG(llvm::dbgs() << "rewrite " << signature << " for target\n"); - return false; - } - return true; - } - - /// Rewrite the signatures and body of the `FuncOp`s in the module for - /// the immediately subsequent target code gen. - void convertSignature(mlir::FuncOp func) { - auto funcTy = func.getType().cast(); - if (hasPortableSignature(funcTy)) - return; - llvm::SmallVector newResTys; - llvm::SmallVector newInTys; - llvm::SmallVector fixups; - - // Convert return value(s) - for (auto ty : funcTy.getResults()) - llvm::TypeSwitch(ty) - .Case([&](fir::ComplexType cmplx) { - if (noComplexConversion) - newResTys.push_back(cmplx); - else - doComplexReturn(func, cmplx, newResTys, newInTys, fixups); - }) - .Case([&](mlir::ComplexType cmplx) { - if (noComplexConversion) - newResTys.push_back(cmplx); - else - doComplexReturn(func, cmplx, newResTys, newInTys, fixups); - }) - .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); - - // Convert arguments - llvm::SmallVector trailingTys; - for (auto e : llvm::enumerate(funcTy.getInputs())) { - auto ty = e.value(); - unsigned index = e.index(); - llvm::TypeSwitch(ty) - .Case([&](BoxCharType boxTy) { - if (noCharacterConversion) { - newInTys.push_back(boxTy); - } else { - // Convert a CHARACTER argument type. This can involve separating - // the pointer and the LEN into two arguments and moving the LEN - // argument to the end of the arg list. - bool sret = functionArgIsSRet(index, func); - for (auto e : llvm::enumerate(specifics->boxcharArgumentType( - boxTy.getEleTy(), sret))) { - auto &tup = e.value(); - auto index = e.index(); - auto attr = std::get(tup); - auto argTy = std::get(tup); - if (attr.isAppend()) { - trailingTys.push_back(argTy); - } else { - if (sret) { - fixups.emplace_back(FixupTy::Codes::CharPair, - newInTys.size(), index); - } else { - fixups.emplace_back(FixupTy::Codes::Trailing, - newInTys.size(), trailingTys.size()); - } - newInTys.push_back(argTy); - } - } - } - }) - .Case([&](fir::ComplexType cmplx) { - if (noComplexConversion) - newInTys.push_back(cmplx); - else - doComplexArg(func, cmplx, newInTys, fixups); - }) - .Case([&](mlir::ComplexType cmplx) { - if (noComplexConversion) - newInTys.push_back(cmplx); - else - doComplexArg(func, cmplx, newInTys, fixups); - }) - .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); - } - - if (!func.empty()) { - // If the function has a body, then apply the fixups to the arguments and - // return ops as required. These fixups are done in place. - auto loc = func.getLoc(); - const auto fixupSize = fixups.size(); - const auto oldArgTys = func.getType().getInputs(); - int offset = 0; - for (std::remove_const_t i = 0; i < fixupSize; ++i) { - const auto &fixup = fixups[i]; - switch (fixup.code) { - case FixupTy::Codes::ArgumentAsLoad: { - // Argument was pass-by-value, but is now pass-by-reference and - // possibly with a different element type. - auto newArg = - func.front().insertArgument(fixup.index, newInTys[fixup.index]); - rewriter->setInsertionPointToStart(&func.front()); - auto oldArgTy = ReferenceType::get(oldArgTys[fixup.index - offset]); - auto cast = rewriter->create(loc, oldArgTy, newArg); - auto load = rewriter->create(loc, cast); - func.getArgument(fixup.index + 1).replaceAllUsesWith(load); - func.front().eraseArgument(fixup.index + 1); - } break; - case FixupTy::Codes::ArgumentType: { - // Argument is pass-by-value, but its type is likely been modified to - // suit the target ABI convention. - auto newArg = - func.front().insertArgument(fixup.index, newInTys[fixup.index]); - rewriter->setInsertionPointToStart(&func.front()); - auto mem = - rewriter->create(loc, newInTys[fixup.index]); - rewriter->create(loc, newArg, mem); - auto oldArgTy = ReferenceType::get(oldArgTys[fixup.index - offset]); - auto cast = rewriter->create(loc, oldArgTy, mem); - mlir::Value load = rewriter->create(loc, cast); - func.getArgument(fixup.index + 1).replaceAllUsesWith(load); - func.front().eraseArgument(fixup.index + 1); - LLVM_DEBUG(llvm::dbgs() - << "old argument: " << oldArgTy.getEleTy() - << ", repl: " << load << ", new argument: " - << func.getArgument(fixup.index).getType() << '\n'); - } break; - case FixupTy::Codes::CharPair: { - // The FIR boxchar argument has been split into a pair of distinct - // arguments that are in juxtaposition to each other. - auto newArg = - func.front().insertArgument(fixup.index, newInTys[fixup.index]); - if (fixup.second == 1) { - rewriter->setInsertionPointToStart(&func.front()); - auto boxTy = oldArgTys[fixup.index - offset - fixup.second]; - auto box = rewriter->create( - loc, boxTy, func.front().getArgument(fixup.index - 1), newArg); - func.getArgument(fixup.index + 1).replaceAllUsesWith(box); - func.front().eraseArgument(fixup.index + 1); - offset++; - } - } break; - case FixupTy::Codes::ReturnAsStore: { - // The value being returned is now being returned in memory (callee - // stack space) through a hidden reference argument. - auto newArg = - func.front().insertArgument(fixup.index, newInTys[fixup.index]); - offset++; - func.walk([&](mlir::ReturnOp ret) { - rewriter->setInsertionPoint(ret); - auto oldOper = ret.getOperand(0); - auto oldOperTy = ReferenceType::get(oldOper.getType()); - auto cast = rewriter->create(loc, oldOperTy, newArg); - rewriter->create(loc, oldOper, cast); - rewriter->create(loc); - ret.erase(); - }); - } break; - case FixupTy::Codes::ReturnType: { - // The function is still returning a value, but its type has likely - // changed to suit the target ABI convention. - func.walk([&](mlir::ReturnOp ret) { - rewriter->setInsertionPoint(ret); - auto oldOper = ret.getOperand(0); - auto oldOperTy = ReferenceType::get(oldOper.getType()); - auto mem = - rewriter->create(loc, newResTys[fixup.index]); - auto cast = rewriter->create(loc, oldOperTy, mem); - rewriter->create(loc, oldOper, cast); - mlir::Value load = rewriter->create(loc, mem); - rewriter->create(loc, load); - ret.erase(); - }); - } break; - case FixupTy::Codes::Split: { - // The FIR argument has been split into a pair of distinct arguments - // that are in juxtaposition to each other. (For COMPLEX value.) - auto newArg = - func.front().insertArgument(fixup.index, newInTys[fixup.index]); - if (fixup.second == 1) { - rewriter->setInsertionPointToStart(&func.front()); - auto cplxTy = oldArgTys[fixup.index - offset - fixup.second]; - auto undef = rewriter->create(loc, cplxTy); - auto iTy = rewriter->getIntegerType(32); - mlir::Value zero = rewriter->create( - loc, iTy, mlir::IntegerAttr::get(iTy, 0)); - mlir::Value one = rewriter->create( - loc, iTy, mlir::IntegerAttr::get(iTy, 1)); - auto cplx1 = rewriter->create( - loc, cplxTy, undef, func.front().getArgument(fixup.index - 1), - zero); - auto cplx = rewriter->create(loc, cplxTy, cplx1, - newArg, one); - func.getArgument(fixup.index + 1).replaceAllUsesWith(cplx); - func.front().eraseArgument(fixup.index + 1); - offset++; - } - } break; - case FixupTy::Codes::Trailing: { - // The FIR argument has been split into a pair of distinct arguments. - // The first part of the pair appears in the original argument - // position. The second part of the pair is appended after all the - // original arguments. (Boxchar arguments.) - auto newBufArg = - func.front().insertArgument(fixup.index, newInTys[fixup.index]); - auto newLenArg = func.front().addArgument(trailingTys[fixup.second]); - auto boxTy = oldArgTys[fixup.index - offset]; - rewriter->setInsertionPointToStart(&func.front()); - auto box = - rewriter->create(loc, boxTy, newBufArg, newLenArg); - func.getArgument(fixup.index + 1).replaceAllUsesWith(box); - func.front().eraseArgument(fixup.index + 1); - } break; - } - } - } - - // Set the new type and finalize the arguments, etc. - newInTys.insert(newInTys.end(), trailingTys.begin(), trailingTys.end()); - auto newFuncTy = - mlir::FunctionType::get(newInTys, newResTys, func.getContext()); - LLVM_DEBUG(llvm::dbgs() << "new func: " << newFuncTy << '\n'); - func.setType(newFuncTy); - - for (auto &fixup : fixups) - if (fixup.finalizer) - (*fixup.finalizer)(func); - } - - inline bool functionArgIsSRet(unsigned index, mlir::FuncOp func) { - if (auto attr = func.getArgAttrOfType(index, "llvm.sret")) - return attr.getValue(); - return false; - } - - /// Convert a complex return value. This can involve converting the return - /// value to a "hidden" first argument or packing the complex into a wide - /// GPR. - template - void doComplexReturn(mlir::FuncOp func, A cmplx, B &newResTys, B &newInTys, - C &fixups) { - if (noComplexConversion) { - newResTys.push_back(cmplx); - return; - } - auto m = specifics->complexReturnType(cmplx.getElementType()); - assert(m.size() == 1); - auto &tup = m[0]; - auto attr = std::get(tup); - auto argTy = std::get(tup); - if (attr.isSRet()) { - bool argNo = newInTys.size(); - fixups.emplace_back( - FixupTy::Codes::ReturnAsStore, argNo, [=](mlir::FuncOp func) { - func.setArgAttr(argNo, "llvm.sret", rewriter->getBoolAttr(true)); - }); - newInTys.push_back(argTy); - return; - } - fixups.emplace_back(FixupTy::Codes::ReturnType, newResTys.size()); - newResTys.push_back(argTy); - } - - /// Convert a complex argument value. This can involve storing the value to - /// a temporary memory location or factoring the value into two distinct - /// arguments. - template - void doComplexArg(mlir::FuncOp func, A cmplx, B &newInTys, C &fixups) { - if (noComplexConversion) { - newInTys.push_back(cmplx); - return; - } - auto m = specifics->complexArgumentType(cmplx.getElementType()); - const auto fixupCode = - m.size() > 1 ? FixupTy::Codes::Split : FixupTy::Codes::ArgumentType; - for (auto e : llvm::enumerate(m)) { - auto &tup = e.value(); - auto index = e.index(); - auto attr = std::get(tup); - auto argTy = std::get(tup); - auto argNo = newInTys.size(); - if (attr.isByVal()) { - if (auto align = attr.getAlignment()) - fixups.emplace_back( - FixupTy::Codes::ArgumentAsLoad, argNo, [=](mlir::FuncOp func) { - func.setArgAttr(argNo, "llvm.byval", - rewriter->getBoolAttr(true)); - func.setArgAttr(argNo, "llvm.align", - rewriter->getIntegerAttr( - rewriter->getIntegerType(32), align)); - }); - else - fixups.emplace_back(FixupTy::Codes::ArgumentAsLoad, newInTys.size(), - [=](mlir::FuncOp func) { - func.setArgAttr(argNo, "llvm.byval", - rewriter->getBoolAttr(true)); - }); - } else { - if (auto align = attr.getAlignment()) - fixups.emplace_back(fixupCode, argNo, index, [=](mlir::FuncOp func) { - func.setArgAttr( - argNo, "llvm.align", - rewriter->getIntegerAttr(rewriter->getIntegerType(32), align)); - }); - else - fixups.emplace_back(fixupCode, argNo, index); - } - newInTys.push_back(argTy); - } - } - -private: - // Replace `op` and remove it. - void replaceOp(mlir::Operation *op, mlir::ValueRange newValues) { - op->replaceAllUsesWith(newValues); - op->dropAllReferences(); - op->erase(); - } - - inline void setMembers(CodeGenSpecifics *s, mlir::OpBuilder *r) { - specifics = s; - rewriter = r; - } - - inline void clearMembers() { setMembers(nullptr, nullptr); } - - CodeGenSpecifics *specifics{}; - mlir::OpBuilder *rewriter; -}; // namespace -} // namespace - -std::unique_ptr> -fir::createFirTargetRewritePass(const TargetRewriteOptions &options) { - return std::make_unique(options); -} diff --git a/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp b/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp new file mode 100644 index 0000000000000..682384804b352 --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp @@ -0,0 +1,703 @@ +//===-- TargetRewrite.cpp -------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "PassDetail.h" +#include "Target.h" +#include "flang/Optimizer/CodeGen/CodeGen.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/FIRContext.h" +#include "mlir/Transforms/DialectConversion.h" +#include "llvm/ADT/STLExtras.h" +#include "llvm/ADT/TypeSwitch.h" + +//===----------------------------------------------------------------------===// +// Target rewrite: rewriting of ops to make target-specific lowerings manifest. +// LLVM expects different lowering idioms to be used for distinct target +// triples. These distinctions are handled by this pass. +//===----------------------------------------------------------------------===// + +using namespace fir; + +#define DEBUG_TYPE "flang-target-rewrite" + +namespace { + +/// Fixups for updating a FuncOp's arguments and return values. +struct FixupTy { + // clang-format off + enum class Codes { + ArgumentAsLoad, ArgumentType, CharPair, ReturnAsStore, ReturnType, + Split, Trailing + }; + // clang-format on + + FixupTy(Codes code, std::size_t index, std::size_t second = 0) + : code{code}, index{index}, second{second} {} + FixupTy(Codes code, std::size_t index, + std::function &&finalizer) + : code{code}, index{index}, finalizer{finalizer} {} + FixupTy(Codes code, std::size_t index, std::size_t second, + std::function &&finalizer) + : code{code}, index{index}, second{second}, finalizer{finalizer} {} + + Codes code; + std::size_t index; + std::size_t second{}; + llvm::Optional> finalizer{}; +}; // namespace + +/// Target-specific rewriting of the IR. This is a prerequisite pass to code +/// generation that traverses the IR and modifies types and operations to a +/// form that appropriate for the specific target. LLVM IR has specific idioms +/// that are used for distinct target processor and ABI combinations. +class TargetRewrite : public TargetRewriteBase { +public: + TargetRewrite(const TargetRewriteOptions &options) { + noCharacterConversion = options.noCharacterConversion; + noComplexConversion = options.noComplexConversion; + } + + void runOnOperation() override final { + auto &context = getContext(); + mlir::OpBuilder rewriter(&context); + auto mod = getModule(); + auto specifics = CodeGenSpecifics::get(getOperation().getContext(), + *getTargetTriple(getOperation()), + *getKindMapping(getOperation())); + setMembers(specifics.get(), &rewriter); + + // Perform type conversion on signatures and call sites. + if (mlir::failed(convertTypes(mod))) { + mlir::emitError(mlir::UnknownLoc::get(&context), + "error in converting types to target abi"); + signalPassFailure(); + } + + // Convert ops in target-specific patterns. + mod.walk([&](mlir::Operation *op) { + if (auto call = dyn_cast(op)) { + if (!hasPortableSignature(call.getFunctionType())) + convertCallOp(call); + } else if (auto dispatch = dyn_cast(op)) { + if (!hasPortableSignature(dispatch.getFunctionType())) + convertCallOp(dispatch); + } else if (auto addr = dyn_cast(op)) { + if (addr.getType().isa() && + !hasPortableSignature(addr.getType())) + convertAddrOp(addr); + } + }); + + clearMembers(); + } + + mlir::ModuleOp getModule() { return getOperation(); } + + template + std::function + rewriteCallComplexResultType(A ty, B &newResTys, B &newInTys, C &newOpers) { + auto m = specifics->complexReturnType(ty.getElementType()); + // Currently targets mandate COMPLEX is a single aggregate or packed + // scalar, included the sret case. + assert(m.size() == 1 && "target lowering of complex return not supported"); + auto resTy = std::get(m[0]); + auto attr = std::get(m[0]); + auto loc = mlir::UnknownLoc::get(resTy.getContext()); + if (attr.isSRet()) { + assert(isa_ref_type(resTy)); + mlir::Value stack = + rewriter->create(loc, dyn_cast_ptrEleTy(resTy)); + newInTys.push_back(resTy); + newOpers.push_back(stack); + return [=](mlir::Operation *) -> mlir::Value { + auto memTy = ReferenceType::get(ty); + auto cast = rewriter->create(loc, memTy, stack); + return rewriter->create(loc, cast); + }; + } + newResTys.push_back(resTy); + return [=](mlir::Operation *call) -> mlir::Value { + auto mem = rewriter->create(loc, resTy); + rewriter->create(loc, call->getResult(0), mem); + auto memTy = ReferenceType::get(ty); + auto cast = rewriter->create(loc, memTy, mem); + return rewriter->create(loc, cast); + }; + } + + template + void rewriteCallComplexInputType(A ty, mlir::Value oper, B &newInTys, + C &newOpers) { + auto m = specifics->complexArgumentType(ty.getElementType()); + auto *ctx = ty.getContext(); + auto loc = mlir::UnknownLoc::get(ctx); + if (m.size() == 1) { + // COMPLEX is a single aggregate + auto resTy = std::get(m[0]); + auto attr = std::get(m[0]); + auto oldRefTy = ReferenceType::get(ty); + if (attr.isByVal()) { + auto mem = rewriter->create(loc, ty); + rewriter->create(loc, oper, mem); + newOpers.push_back(rewriter->create(loc, resTy, mem)); + } else { + auto mem = rewriter->create(loc, resTy); + auto cast = rewriter->create(loc, oldRefTy, mem); + rewriter->create(loc, oper, cast); + newOpers.push_back(rewriter->create(loc, mem)); + } + newInTys.push_back(resTy); + } else { + assert(m.size() == 2); + // COMPLEX is split into 2 separate arguments + auto iTy = rewriter->getIntegerType(32); + for (auto e : llvm::enumerate(m)) { + auto &tup = e.value(); + auto ty = std::get(tup); + auto index = e.index(); + mlir::Value idx = rewriter->create( + loc, iTy, mlir::IntegerAttr::get(iTy, index)); + auto val = rewriter->create(loc, ty, oper, idx); + newInTys.push_back(ty); + newOpers.push_back(val); + } + } + } + + // Convert fir.call and fir.dispatch Ops. + template + void convertCallOp(A callOp) { + auto fnTy = callOp.getFunctionType(); + auto loc = callOp.getLoc(); + rewriter->setInsertionPoint(callOp); + llvm::SmallVector newResTys; + llvm::SmallVector newInTys; + llvm::SmallVector newOpers; + // FIXME: if the call is indirect, the first argument must still be the + // function to call. + llvm::Optional> wrap; + if (fnTy.getResults().size() == 1) { + mlir::Type ty = fnTy.getResult(0); + llvm::TypeSwitch(ty) + .template Case([&](fir::ComplexType cmplx) { + wrap = rewriteCallComplexResultType(cmplx, newResTys, newInTys, + newOpers); + }) + .template Case([&](mlir::ComplexType cmplx) { + wrap = rewriteCallComplexResultType(cmplx, newResTys, newInTys, + newOpers); + }) + .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); + } else if (fnTy.getResults().size() > 1) { + // If the function is returning more than 1 result, do not perform any + // target-specific lowering. (FIXME?) This may need to be revisited. + newResTys.insert(newResTys.end(), fnTy.getResults().begin(), + fnTy.getResults().end()); + } + llvm::SmallVector trailingInTys; + llvm::SmallVector trailingOpers; + for (auto e : + llvm::enumerate(llvm::zip(fnTy.getInputs(), callOp.getOperands()))) { + mlir::Type ty = std::get<0>(e.value()); + mlir::Value oper = std::get<1>(e.value()); + unsigned index = e.index(); + llvm::TypeSwitch(ty) + .template Case([&](BoxCharType boxTy) { + bool sret; + if constexpr (std::is_same_v, fir::CallOp>) { + sret = callOp.callee() && + functionArgIsSRet(index, + getModule().lookupSymbol( + *callOp.callee())); + } else { + // TODO: dispatch case; how do we put arguments on a call? + sret = false; + llvm_unreachable("not implemented"); + } + auto m = specifics->boxcharArgumentType(boxTy.getEleTy(), sret); + auto unbox = + rewriter->create(loc, std::get(m[0]), + std::get(m[1]), oper); + // unboxed CHARACTER arguments + for (auto e : llvm::enumerate(m)) { + unsigned idx = e.index(); + auto attr = std::get(e.value()); + auto argTy = std::get(e.value()); + if (attr.isAppend()) { + trailingInTys.push_back(argTy); + trailingOpers.push_back(unbox.getResult(idx)); + } else { + newInTys.push_back(argTy); + newOpers.push_back(unbox.getResult(idx)); + } + } + }) + .template Case([&](fir::ComplexType cmplx) { + rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); + }) + .template Case([&](mlir::ComplexType cmplx) { + rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); + }) + .Default([&](mlir::Type ty) { + newInTys.push_back(ty); + newOpers.push_back(oper); + }); + } + newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); + newOpers.insert(newOpers.end(), trailingOpers.begin(), trailingOpers.end()); + if constexpr (std::is_same_v, fir::CallOp>) { + assert(callOp.callee().hasValue() && "indirect call not implemented"); + auto newCall = rewriter->create(loc, callOp.callee().getValue(), + newResTys, newOpers); + LLVM_DEBUG(llvm::dbgs() << "replacing call with " << newCall << '\n'); + if (wrap.hasValue()) + replaceOp(callOp, (*wrap)(newCall.getOperation())); + else + replaceOp(callOp, newCall.getResults()); + } else { + // A is fir::DispatchOp + llvm_unreachable("not implemented"); // TODO + } + } + + // Result type fixup for fir::ComplexType and mlir::ComplexType + template + void lowerComplexSignatureRes(A cmplx, B &newResTys, B &newInTys) { + if (noComplexConversion) { + newResTys.push_back(cmplx); + } else { + for (auto &tup : specifics->complexReturnType(cmplx.getElementType())) { + auto argTy = std::get(tup); + if (std::get(tup).isSRet()) + newInTys.push_back(argTy); + else + newResTys.push_back(argTy); + } + } + } + + // Argument type fixup for fir::ComplexType and mlir::ComplexType + template + void lowerComplexSignatureArg(A cmplx, B &newInTys) { + if (noComplexConversion) + newInTys.push_back(cmplx); + else + for (auto &tup : specifics->complexArgumentType(cmplx.getElementType())) + newInTys.push_back(std::get(tup)); + } + + /// Taking the address of a function. Modify the signature as needed. + void convertAddrOp(AddrOfOp addrOp) { + auto addrTy = addrOp.getType().cast(); + llvm::SmallVector newResTys; + llvm::SmallVector newInTys; + for (mlir::Type ty : addrTy.getResults()) { + llvm::TypeSwitch(ty) + .Case([&](fir::ComplexType ty) { + lowerComplexSignatureRes(ty, newResTys, newInTys); + }) + .Case([&](mlir::ComplexType ty) { + lowerComplexSignatureRes(ty, newResTys, newInTys); + }) + .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); + } + llvm::SmallVector trailingInTys; + for (mlir::Type ty : addrTy.getInputs()) { + llvm::TypeSwitch(ty) + .Case([&](BoxCharType box) { + if (noCharacterConversion) { + newInTys.push_back(box); + } else { + for (auto &tup : specifics->boxcharArgumentType(box.getEleTy())) { + auto attr = std::get(tup); + auto argTy = std::get(tup); + auto &vec = attr.isAppend() ? trailingInTys : newInTys; + vec.push_back(argTy); + } + } + }) + .Case([&](fir::ComplexType ty) { + lowerComplexSignatureArg(ty, newInTys); + }) + .Case([&](mlir::ComplexType ty) { + lowerComplexSignatureArg(ty, newInTys); + }) + .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); + } + // append trailing input types + newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); + // replace this op with a new one with the updated signature + auto newTy = rewriter->getFunctionType(newInTys, newResTys); + auto newOp = + rewriter->create(addrOp.getLoc(), newTy, addrOp.symbol()); + replaceOp(addrOp, newOp.getOperation()->getResults()); + } + + /// Convert the type signatures on all the functions present in the module. + /// As the type signature is being changed, this must also update the + /// function itself to use any new arguments, etc. + mlir::LogicalResult convertTypes(mlir::ModuleOp mod) { + for (auto fn : mod.getOps()) + convertSignature(fn); + return mlir::success(); + } + + /// If the signature does not need any special target-specific converions, + /// then it is considered portable for any target, and this function will + /// return `true`. Otherwise, the signature is not portable and `false` is + /// returned. + bool hasPortableSignature(mlir::Type signature) { + assert(signature.isa()); + auto func = signature.dyn_cast(); + for (auto ty : func.getResults()) + if ((ty.isa() && !noCharacterConversion) || + (isa_complex(ty) && !noComplexConversion)) { + LLVM_DEBUG(llvm::dbgs() << "rewrite " << signature << " for target\n"); + return false; + } + for (auto ty : func.getInputs()) + if ((ty.isa() && !noCharacterConversion) || + (isa_complex(ty) && !noComplexConversion)) { + LLVM_DEBUG(llvm::dbgs() << "rewrite " << signature << " for target\n"); + return false; + } + return true; + } + + /// Rewrite the signatures and body of the `FuncOp`s in the module for + /// the immediately subsequent target code gen. + void convertSignature(mlir::FuncOp func) { + auto funcTy = func.getType().cast(); + if (hasPortableSignature(funcTy)) + return; + llvm::SmallVector newResTys; + llvm::SmallVector newInTys; + llvm::SmallVector fixups; + + // Convert return value(s) + for (auto ty : funcTy.getResults()) + llvm::TypeSwitch(ty) + .Case([&](fir::ComplexType cmplx) { + if (noComplexConversion) + newResTys.push_back(cmplx); + else + doComplexReturn(func, cmplx, newResTys, newInTys, fixups); + }) + .Case([&](mlir::ComplexType cmplx) { + if (noComplexConversion) + newResTys.push_back(cmplx); + else + doComplexReturn(func, cmplx, newResTys, newInTys, fixups); + }) + .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); + + // Convert arguments + llvm::SmallVector trailingTys; + for (auto e : llvm::enumerate(funcTy.getInputs())) { + auto ty = e.value(); + unsigned index = e.index(); + llvm::TypeSwitch(ty) + .Case([&](BoxCharType boxTy) { + if (noCharacterConversion) { + newInTys.push_back(boxTy); + } else { + // Convert a CHARACTER argument type. This can involve separating + // the pointer and the LEN into two arguments and moving the LEN + // argument to the end of the arg list. + bool sret = functionArgIsSRet(index, func); + for (auto e : llvm::enumerate(specifics->boxcharArgumentType( + boxTy.getEleTy(), sret))) { + auto &tup = e.value(); + auto index = e.index(); + auto attr = std::get(tup); + auto argTy = std::get(tup); + if (attr.isAppend()) { + trailingTys.push_back(argTy); + } else { + if (sret) { + fixups.emplace_back(FixupTy::Codes::CharPair, + newInTys.size(), index); + } else { + fixups.emplace_back(FixupTy::Codes::Trailing, + newInTys.size(), trailingTys.size()); + } + newInTys.push_back(argTy); + } + } + } + }) + .Case([&](fir::ComplexType cmplx) { + if (noComplexConversion) + newInTys.push_back(cmplx); + else + doComplexArg(func, cmplx, newInTys, fixups); + }) + .Case([&](mlir::ComplexType cmplx) { + if (noComplexConversion) + newInTys.push_back(cmplx); + else + doComplexArg(func, cmplx, newInTys, fixups); + }) + .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); + } + + if (!func.empty()) { + // If the function has a body, then apply the fixups to the arguments and + // return ops as required. These fixups are done in place. + auto loc = func.getLoc(); + const auto fixupSize = fixups.size(); + const auto oldArgTys = func.getType().getInputs(); + int offset = 0; + for (std::remove_const_t i = 0; i < fixupSize; ++i) { + const auto &fixup = fixups[i]; + switch (fixup.code) { + case FixupTy::Codes::ArgumentAsLoad: { + // Argument was pass-by-value, but is now pass-by-reference and + // possibly with a different element type. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + rewriter->setInsertionPointToStart(&func.front()); + auto oldArgTy = ReferenceType::get(oldArgTys[fixup.index - offset]); + auto cast = rewriter->create(loc, oldArgTy, newArg); + auto load = rewriter->create(loc, cast); + func.getArgument(fixup.index + 1).replaceAllUsesWith(load); + func.front().eraseArgument(fixup.index + 1); + } break; + case FixupTy::Codes::ArgumentType: { + // Argument is pass-by-value, but its type is likely been modified to + // suit the target ABI convention. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + rewriter->setInsertionPointToStart(&func.front()); + auto mem = + rewriter->create(loc, newInTys[fixup.index]); + rewriter->create(loc, newArg, mem); + auto oldArgTy = ReferenceType::get(oldArgTys[fixup.index - offset]); + auto cast = rewriter->create(loc, oldArgTy, mem); + mlir::Value load = rewriter->create(loc, cast); + func.getArgument(fixup.index + 1).replaceAllUsesWith(load); + func.front().eraseArgument(fixup.index + 1); + LLVM_DEBUG(llvm::dbgs() + << "old argument: " << oldArgTy.getEleTy() + << ", repl: " << load << ", new argument: " + << func.getArgument(fixup.index).getType() << '\n'); + } break; + case FixupTy::Codes::CharPair: { + // The FIR boxchar argument has been split into a pair of distinct + // arguments that are in juxtaposition to each other. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + if (fixup.second == 1) { + rewriter->setInsertionPointToStart(&func.front()); + auto boxTy = oldArgTys[fixup.index - offset - fixup.second]; + auto box = rewriter->create( + loc, boxTy, func.front().getArgument(fixup.index - 1), newArg); + func.getArgument(fixup.index + 1).replaceAllUsesWith(box); + func.front().eraseArgument(fixup.index + 1); + offset++; + } + } break; + case FixupTy::Codes::ReturnAsStore: { + // The value being returned is now being returned in memory (callee + // stack space) through a hidden reference argument. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + offset++; + func.walk([&](mlir::ReturnOp ret) { + rewriter->setInsertionPoint(ret); + auto oldOper = ret.getOperand(0); + auto oldOperTy = ReferenceType::get(oldOper.getType()); + auto cast = rewriter->create(loc, oldOperTy, newArg); + rewriter->create(loc, oldOper, cast); + rewriter->create(loc); + ret.erase(); + }); + } break; + case FixupTy::Codes::ReturnType: { + // The function is still returning a value, but its type has likely + // changed to suit the target ABI convention. + func.walk([&](mlir::ReturnOp ret) { + rewriter->setInsertionPoint(ret); + auto oldOper = ret.getOperand(0); + auto oldOperTy = ReferenceType::get(oldOper.getType()); + auto mem = + rewriter->create(loc, newResTys[fixup.index]); + auto cast = rewriter->create(loc, oldOperTy, mem); + rewriter->create(loc, oldOper, cast); + mlir::Value load = rewriter->create(loc, mem); + rewriter->create(loc, load); + ret.erase(); + }); + } break; + case FixupTy::Codes::Split: { + // The FIR argument has been split into a pair of distinct arguments + // that are in juxtaposition to each other. (For COMPLEX value.) + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + if (fixup.second == 1) { + rewriter->setInsertionPointToStart(&func.front()); + auto cplxTy = oldArgTys[fixup.index - offset - fixup.second]; + auto undef = rewriter->create(loc, cplxTy); + auto iTy = rewriter->getIntegerType(32); + mlir::Value zero = rewriter->create( + loc, iTy, mlir::IntegerAttr::get(iTy, 0)); + mlir::Value one = rewriter->create( + loc, iTy, mlir::IntegerAttr::get(iTy, 1)); + auto cplx1 = rewriter->create( + loc, cplxTy, undef, func.front().getArgument(fixup.index - 1), + zero); + auto cplx = rewriter->create(loc, cplxTy, cplx1, + newArg, one); + func.getArgument(fixup.index + 1).replaceAllUsesWith(cplx); + func.front().eraseArgument(fixup.index + 1); + offset++; + } + } break; + case FixupTy::Codes::Trailing: { + // The FIR argument has been split into a pair of distinct arguments. + // The first part of the pair appears in the original argument + // position. The second part of the pair is appended after all the + // original arguments. (Boxchar arguments.) + auto newBufArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + auto newLenArg = func.front().addArgument(trailingTys[fixup.second]); + auto boxTy = oldArgTys[fixup.index - offset]; + rewriter->setInsertionPointToStart(&func.front()); + auto box = + rewriter->create(loc, boxTy, newBufArg, newLenArg); + func.getArgument(fixup.index + 1).replaceAllUsesWith(box); + func.front().eraseArgument(fixup.index + 1); + } break; + } + } + } + + // Set the new type and finalize the arguments, etc. + newInTys.insert(newInTys.end(), trailingTys.begin(), trailingTys.end()); + auto newFuncTy = + mlir::FunctionType::get(newInTys, newResTys, func.getContext()); + LLVM_DEBUG(llvm::dbgs() << "new func: " << newFuncTy << '\n'); + func.setType(newFuncTy); + + for (auto &fixup : fixups) + if (fixup.finalizer) + (*fixup.finalizer)(func); + } + + inline bool functionArgIsSRet(unsigned index, mlir::FuncOp func) { + if (auto attr = func.getArgAttrOfType(index, "llvm.sret")) + return attr.getValue(); + return false; + } + + /// Convert a complex return value. This can involve converting the return + /// value to a "hidden" first argument or packing the complex into a wide + /// GPR. + template + void doComplexReturn(mlir::FuncOp func, A cmplx, B &newResTys, B &newInTys, + C &fixups) { + if (noComplexConversion) { + newResTys.push_back(cmplx); + return; + } + auto m = specifics->complexReturnType(cmplx.getElementType()); + assert(m.size() == 1); + auto &tup = m[0]; + auto attr = std::get(tup); + auto argTy = std::get(tup); + if (attr.isSRet()) { + bool argNo = newInTys.size(); + fixups.emplace_back( + FixupTy::Codes::ReturnAsStore, argNo, [=](mlir::FuncOp func) { + func.setArgAttr(argNo, "llvm.sret", rewriter->getBoolAttr(true)); + }); + newInTys.push_back(argTy); + return; + } + fixups.emplace_back(FixupTy::Codes::ReturnType, newResTys.size()); + newResTys.push_back(argTy); + } + + /// Convert a complex argument value. This can involve storing the value to + /// a temporary memory location or factoring the value into two distinct + /// arguments. + template + void doComplexArg(mlir::FuncOp func, A cmplx, B &newInTys, C &fixups) { + if (noComplexConversion) { + newInTys.push_back(cmplx); + return; + } + auto m = specifics->complexArgumentType(cmplx.getElementType()); + const auto fixupCode = + m.size() > 1 ? FixupTy::Codes::Split : FixupTy::Codes::ArgumentType; + for (auto e : llvm::enumerate(m)) { + auto &tup = e.value(); + auto index = e.index(); + auto attr = std::get(tup); + auto argTy = std::get(tup); + auto argNo = newInTys.size(); + if (attr.isByVal()) { + if (auto align = attr.getAlignment()) + fixups.emplace_back( + FixupTy::Codes::ArgumentAsLoad, argNo, [=](mlir::FuncOp func) { + func.setArgAttr(argNo, "llvm.byval", + rewriter->getBoolAttr(true)); + func.setArgAttr(argNo, "llvm.align", + rewriter->getIntegerAttr( + rewriter->getIntegerType(32), align)); + }); + else + fixups.emplace_back(FixupTy::Codes::ArgumentAsLoad, newInTys.size(), + [=](mlir::FuncOp func) { + func.setArgAttr(argNo, "llvm.byval", + rewriter->getBoolAttr(true)); + }); + } else { + if (auto align = attr.getAlignment()) + fixups.emplace_back(fixupCode, argNo, index, [=](mlir::FuncOp func) { + func.setArgAttr( + argNo, "llvm.align", + rewriter->getIntegerAttr(rewriter->getIntegerType(32), align)); + }); + else + fixups.emplace_back(fixupCode, argNo, index); + } + newInTys.push_back(argTy); + } + } + +private: + // Replace `op` and remove it. + void replaceOp(mlir::Operation *op, mlir::ValueRange newValues) { + op->replaceAllUsesWith(newValues); + op->dropAllReferences(); + op->erase(); + } + + inline void setMembers(CodeGenSpecifics *s, mlir::OpBuilder *r) { + specifics = s; + rewriter = r; + } + + inline void clearMembers() { setMembers(nullptr, nullptr); } + + CodeGenSpecifics *specifics{}; + mlir::OpBuilder *rewriter; +}; // namespace +} // namespace + +std::unique_ptr> +fir::createFirTargetRewritePass(const TargetRewriteOptions &options) { + return std::make_unique(options); +} From 7aed5a85121c906f212cde2c962b3060d0dfd734 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 22 Oct 2020 10:47:44 -0700 Subject: [PATCH 0318/1017] review comments --- flang/include/flang/Lower/PFTBuilder.h | 13 +++++++++-- flang/lib/Lower/Bridge.cpp | 1 - flang/lib/Lower/PFTBuilder.cpp | 31 ++++++++------------------ 3 files changed, 20 insertions(+), 25 deletions(-) diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 288deaed85bcf..618e2d755481f 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -21,6 +21,8 @@ #include "flang/Common/template.h" #include "flang/Lower/Utils.h" #include "flang/Parser/parse-tree.h" +#include "flang/Semantics/attr.h" +#include "flang/Semantics/symbol.h" #include "llvm/Support/raw_ostream.h" namespace mlir { @@ -32,9 +34,11 @@ namespace semantics { class SemanticsContext; class Scope; } // namespace semantics + namespace lower { bool definedInCommonBlock(const semantics::Symbol &sym); +bool defaultRecursiveFunctionSetting(); namespace pft { @@ -551,7 +555,13 @@ struct FunctionLikeUnit : public ProgramUnit { FunctionLikeUnit(FunctionLikeUnit &&) = default; FunctionLikeUnit(const FunctionLikeUnit &) = delete; - bool isRecursive() { return isMainProgram() ? false : recursiveFunction; } + bool isRecursive() const { + auto sym = getSubprogramSymbol(); + return !isMainProgram() && + (sym.attrs().test(semantics::Attr::RECURSIVE) || + (!sym.attrs().test(semantics::Attr::NON_RECURSIVE) && + defaultRecursiveFunctionSetting())); + } std::vector getOrderedSymbolTable() { return varList[0]; } @@ -618,7 +628,6 @@ struct FunctionLikeUnit : public ProgramUnit { /// Terminal basic block (if any) mlir::Block *finalBlock{}; std::vector> varList; - bool recursiveFunction{}; }; /// Module-like units contain a list of function-like units. diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index ceaeb8e75c07c..fdbf32f3776f8 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1732,7 +1732,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto globalName = mangleName(sym); bool isConst = sym.attrs().test(Fortran::semantics::Attr::PARAMETER); auto loc = genLocation(sym.name()); - auto idxTy = builder->getIndexType(); // FIXME: name returned does not consider subprogram's scope, is not unique fir::GlobalOp global = builder->getNamedGlobal(globalName); if (global) { diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index f003b26e09b6d..efc0f11591508 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -23,17 +23,12 @@ static llvm::cl::opt clDisableStructuredFir( "no-structured-fir", llvm::cl::desc("disable generation of structured FIR"), llvm::cl::init(false), llvm::cl::Hidden); -// FIXME: should be set with switch such as `--std=2018`. static llvm::cl::opt nonRecursiveProcedures( "non-recursive-procedures", llvm::cl::desc("Make procedures non-recursive by default. This was the " "default for all Fortran standards prior to 2018."), llvm::cl::init(/*2018 standard=*/false)); -static bool defaultRecursiveFunctionSetting() { - return !nonRecursiveProcedures; -} - using namespace Fortran; namespace { @@ -1286,17 +1281,6 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( } } -template -static bool procedureIsRecursive(const A &stmt) { - for (const auto &p : std::get>(stmt.t)) { - if (std::holds_alternative(p.u)) - return true; - if (std::holds_alternative(p.u)) - return false; - } - return defaultRecursiveFunctionSetting(); -} - Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( const parser::FunctionSubprogram &func, const lower::pft::ParentVariant &parent, @@ -1305,8 +1289,6 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( beginStmt{getFunctionStmt(func)}, endStmt{getFunctionStmt(func)} { auto symbol = getSymbol(*beginStmt); - recursiveFunction = - procedureIsRecursive(beginStmt->getStatement()); entryPointList[0].first = symbol; processSymbolTable(*symbol->scope(), varList); } @@ -1319,8 +1301,6 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( beginStmt{getFunctionStmt(func)}, endStmt{getFunctionStmt(func)} { auto symbol = getSymbol(*beginStmt); - recursiveFunction = - procedureIsRecursive(beginStmt->getStatement()); entryPointList[0].first = symbol; processSymbolTable(*symbol->scope(), varList); } @@ -1331,8 +1311,7 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( const semantics::SemanticsContext &) : ProgramUnit{func, parent}, beginStmt{getFunctionStmt(func)}, - endStmt{getFunctionStmt(func)}, - recursiveFunction{defaultRecursiveFunctionSetting()} { + endStmt{getFunctionStmt(func)} { auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; processSymbolTable(*symbol->scope(), varList); @@ -1371,6 +1350,14 @@ Fortran::lower::createPFT(const parser::Program &root, return walker.result(); } +// FIXME: FlangDriver +// This option should be integrated with the real driver as the default of +// RECURSIVE vs. NON_RECURSIVE may be changed by other command line options, +// etc., etc. +bool Fortran::lower::defaultRecursiveFunctionSetting() { + return !nonRecursiveProcedures; +} + void Fortran::lower::dumpPFT(llvm::raw_ostream &outputStream, const lower::pft::Program &pft) { PFTDumper{}.dumpPFT(outputStream, pft); From bd6492e9615d7650b9b731bd8a698b06d341edb4 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 22 Oct 2020 13:26:47 -0700 Subject: [PATCH 0319/1017] Fix issue #510 --- flang/lib/Optimizer/CodeGen/TargetRewrite.cpp | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp b/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp index 682384804b352..e322383e88560 100644 --- a/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp @@ -109,7 +109,7 @@ class TargetRewrite : public TargetRewriteBase { rewriteCallComplexResultType(A ty, B &newResTys, B &newInTys, C &newOpers) { auto m = specifics->complexReturnType(ty.getElementType()); // Currently targets mandate COMPLEX is a single aggregate or packed - // scalar, included the sret case. + // scalar, including the sret case. assert(m.size() == 1 && "target lowering of complex return not supported"); auto resTy = std::get(m[0]); auto attr = std::get(m[0]); @@ -299,6 +299,7 @@ class TargetRewrite : public TargetRewriteBase { /// Taking the address of a function. Modify the signature as needed. void convertAddrOp(AddrOfOp addrOp) { + rewriter->setInsertionPoint(addrOp); auto addrTy = addrOp.getType().cast(); llvm::SmallVector newResTys; llvm::SmallVector newInTys; @@ -341,7 +342,9 @@ class TargetRewrite : public TargetRewriteBase { auto newTy = rewriter->getFunctionType(newInTys, newResTys); auto newOp = rewriter->create(addrOp.getLoc(), newTy, addrOp.symbol()); - replaceOp(addrOp, newOp.getOperation()->getResults()); + LLVM_DEBUG(llvm::dbgs() + << "replacing " << addrOp << " with " << newOp << '\n'); + replaceOp(addrOp, newOp.getResult()); } /// Convert the type signatures on all the functions present in the module. From a01774fb09bf95f8625efa43042aa4c462fbde06 Mon Sep 17 00:00:00 2001 From: Eric Date: Thu, 22 Oct 2020 15:31:11 -0700 Subject: [PATCH 0320/1017] Fix issue #504. Throw away some of the old work around code that's no longer needed. Update test to reflect the simpler fir that is now generated. --- flang/lib/Lower/ConvertExpr.cpp | 33 +-------------------------------- flang/test/Lower/intrinsics.f90 | 15 +++++++++++---- 2 files changed, 12 insertions(+), 36 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 7068e8a099d9f..dac91b2f759f1 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -276,38 +276,7 @@ class ExprLowering { fir::ExtendedValue genLoad(const fir::ExtendedValue &addr) { auto loc = getLoc(); return addr.match( - [&](const fir::CharBoxValue &box) -> fir::ExtendedValue { - auto buffer = box.getBuffer(); - auto len = dyn_cast(box.getLen().getDefiningOp()); - if (!len) { - // TODO: return an emboxchar? - // Not sure an emboxchar would help, it would simply - // indirects the memory reference, so it fakes the load and then - // makes it harder to work with the character due to the - // indirection. Solutions I see are: - // 1. create a temp and returns a CharBoxValue pointing to it. - // 2. create a dynamic vector fir type that can abstract 1. - mlir::emitError(loc, "cannot load a variable length char"); - return {}; - } - auto lenAttr = len.value().dyn_cast(); - if (!lenAttr) { - mlir::emitError(loc, "length must be integer"); - return {}; - } - auto lenConst = lenAttr.getValue().getSExtValue(); - fir::SequenceType::Shape shape = {lenConst}; - auto baseTy = - Fortran::lower::CharacterExprHelper::getCharacterType(box); - auto charTy = - builder.getRefType(fir::SequenceType::get(shape, baseTy)); - auto casted = builder.createConvert(loc, charTy, buffer); - auto val = builder.create(loc, casted); - return fir::CharBoxValue{val, box.getLen()}; - }, - [&](const fir::CharArrayBoxValue &v) -> fir::ExtendedValue { - TODO("loading character array"); - }, + [](const fir::CharBoxValue &box) -> fir::ExtendedValue { return box; }, [&](const fir::UnboxedValue &v) -> fir::ExtendedValue { return builder.create(loc, fir::getBase(v)); }, diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index a18f03d8e5793..df244f621aeef 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -182,13 +182,20 @@ end subroutine iand_test subroutine ichar_test(c) character(1) :: c character :: str(10) - ! CHECK: %[[BOX:.*]] = fir.load %{{.*}} : !fir.ref> - ! CHECK: %{{.*}} = fir.convert %[[BOX]] : (!fir.char<1>) -> i32 + ! CHECK-DAG: %[[unbox:.*]]:2 = fir.unboxchar + ! CHECK-DAG: %[[J:.*]] = fir.alloca i32 {name = "{{.*}}Ej"} + ! CHECK-DAG: %[[STR:.*]] = fir.alloca !fir.array{{.*}} {name = "{{.*}}Estr"} + ! CHECK: %[[BOX:.*]] = fir.load %[[unbox]]#0 : !fir.ref> + ! CHECK: = fir.convert %[[BOX]] : (!fir.char<1>) -> i32 print *, ichar(c) + ! CHECK: fir.call @{{.*}}EndIoStatement - ! CHECK: %[[ARRV:.*]] = fir.extract_value %{{.*}}, %{{.*}} : (!fir.array<1x!fir.char<1>>, i32) -> !fir.char<1> - ! CHECK: %{{.*}} = fir.convert %[[ARRV]] : (!fir.char<1>) -> i32 + ! CHECK: %{{.*}} = fir.load %[[J]] : !fir.ref + ! CHECK: %[[ptr:.*]] = fir.coordinate_of %[[STR]], % + ! CHECK: %[[cast:.*]] = fir.convert %[[ptr]] + ! CHECK: fir.load %[[cast]] : !fir.ref> print *, ichar(str(J)) + ! CHECK: fir.call @{{.*}}EndIoStatement end subroutine ! IEOR From 96407a884a7688e90d1e3e7c62bc72a88aec3337 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 23 Oct 2020 10:14:32 -0700 Subject: [PATCH 0321/1017] Part 1: use the correct floating point op for unsupported floating point kinds. --- flang/lib/Lower/ConvertExpr.cpp | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index dac91b2f759f1..30200e8f8a53e 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -22,6 +22,7 @@ #include "flang/Lower/IntrinsicCall.h" #include "flang/Lower/Runtime.h" #include "flang/Lower/Todo.h" +#include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Semantics/expression.h" #include "flang/Semantics/symbol.h" @@ -152,16 +153,21 @@ class ExprLowering { mlir::Value genBoolConstant(mlir::MLIRContext *context, bool value) { auto i1Type = builder.getI1Type(); auto attr = builder.getIntegerAttr(i1Type, value ? 1 : 0); - return builder.create(getLoc(), i1Type, attr).getResult(); + return builder.create(getLoc(), i1Type, attr); } + /// Generate a real constant with of `value`. template mlir::Value genRealConstant(mlir::MLIRContext *context, const llvm::APFloat &value) { auto fltTy = Fortran::lower::convertReal(context, KIND); - auto attr = builder.getFloatAttr(fltTy, value); - auto res = builder.create(getLoc(), fltTy, attr); - return res.getResult(); + if (fltTy.isa()) { + auto attr = builder.getFloatAttr(fltTy, value); + return builder.create(getLoc(), fltTy, attr); + } + // MLIR standard dialect doesn't support floating point larger than double. + auto attr = fir::RealAttr::get(context, {KIND, value}); + return builder.create(getLoc(), fltTy, attr); } mlir::Type getSomeKindInteger() { return builder.getIndexType(); } From a04846bc523460c046d0764d98f30f5bdc4c1f48 Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Fri, 23 Oct 2020 19:30:01 -0700 Subject: [PATCH 0322/1017] Fix #493 - reading from a default unit (#521) --- flang/test/Lower/io-stmt02.f90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/flang/test/Lower/io-stmt02.f90 b/flang/test/Lower/io-stmt02.f90 index fbe2457c894bb..674161fdfd847 100644 --- a/flang/test/Lower/io-stmt02.f90 +++ b/flang/test/Lower/io-stmt02.f90 @@ -80,3 +80,15 @@ subroutine control1(n) ! I/O condition specifier control flow dimension c(n), d(n,n), e(n,n), f(n) read(*,'(F7.2)', iostat=mm, advance='no') a, b, (c(j), (d(k,j), e(k,j), k=1,n), f(j), j=1,n), g end + +! CHECK-LABEL: func @_QPimpliedformat +subroutine impliedformat + ! CHECK: BeginExternalListInput(%c-1 + ! CHECK: InputReal32 + ! CHECK: EndIoStatement(%3) : (!fir.ref) -> i32 + read*, x + ! CHECK: BeginExternalListOutput(%c-1 + ! CHECK: OutputReal32 + ! CHECK: EndIoStatement + print*, x +end From 2633a71718620c146a84740bf2db7eaf3baed9d3 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 23 Oct 2020 15:40:04 -0700 Subject: [PATCH 0323/1017] Fix issue #502: indirect call target conversion. --- flang/lib/Optimizer/CodeGen/TargetRewrite.cpp | 36 +++++++++++++++---- 1 file changed, 29 insertions(+), 7 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp b/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp index e322383e88560..d66d39ed90ca2 100644 --- a/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp @@ -184,8 +184,19 @@ class TargetRewrite : public TargetRewriteBase { llvm::SmallVector newResTys; llvm::SmallVector newInTys; llvm::SmallVector newOpers; - // FIXME: if the call is indirect, the first argument must still be the - // function to call. + + // If the call is indirect, the first argument must still be the function + // to call. + int dropFront = 0; + if constexpr (std::is_same_v, fir::CallOp>) { + if (!callOp.callee().hasValue()) { + newInTys.push_back(fnTy.getInput(0)); + newOpers.push_back(callOp.getOperand(0)); + dropFront = 1; + } + } + + // Determine the rewrite function, `wrap`, for the result value. llvm::Optional> wrap; if (fnTy.getResults().size() == 1) { mlir::Type ty = fnTy.getResult(0); @@ -205,10 +216,12 @@ class TargetRewrite : public TargetRewriteBase { newResTys.insert(newResTys.end(), fnTy.getResults().begin(), fnTy.getResults().end()); } + llvm::SmallVector trailingInTys; llvm::SmallVector trailingOpers; - for (auto e : - llvm::enumerate(llvm::zip(fnTy.getInputs(), callOp.getOperands()))) { + for (auto e : llvm::enumerate( + llvm::zip(fnTy.getInputs().drop_front(dropFront), + callOp.getOperands().drop_front(dropFront)))) { mlir::Type ty = std::get<0>(e.value()); mlir::Value oper = std::get<1>(e.value()); unsigned index = e.index(); @@ -222,6 +235,7 @@ class TargetRewrite : public TargetRewriteBase { *callOp.callee())); } else { // TODO: dispatch case; how do we put arguments on a call? + // We cannot put both an sret and the dispatch object first. sret = false; llvm_unreachable("not implemented"); } @@ -257,9 +271,17 @@ class TargetRewrite : public TargetRewriteBase { newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); newOpers.insert(newOpers.end(), trailingOpers.begin(), trailingOpers.end()); if constexpr (std::is_same_v, fir::CallOp>) { - assert(callOp.callee().hasValue() && "indirect call not implemented"); - auto newCall = rewriter->create(loc, callOp.callee().getValue(), - newResTys, newOpers); + fir::CallOp newCall; + if (callOp.callee().hasValue()) { + newCall = rewriter->create(loc, callOp.callee().getValue(), + newResTys, newOpers); + } else { + // Force new type on the input operand. + newOpers[0].setType(mlir::FunctionType::get( + mlir::TypeRange{newInTys}.drop_front(dropFront), newResTys, + callOp.getContext())); + newCall = rewriter->create(loc, newResTys, newOpers); + } LLVM_DEBUG(llvm::dbgs() << "replacing call with " << newCall << '\n'); if (wrap.hasValue()) replaceOp(callOp, (*wrap)(newCall.getOperation())); From d145376048e60a3b4aa33893f623d14352488980 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 23 Oct 2020 17:50:49 -0700 Subject: [PATCH 0324/1017] [NFC] Code cleanup to bring it more inline with MLIR coding conventions. --- .../Optimizer/Transforms/AffinePromotion.cpp | 344 +++++++++--------- 1 file changed, 182 insertions(+), 162 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp index 0985a366b4043..e72b8185a5319 100644 --- a/flang/lib/Optimizer/Transforms/AffinePromotion.cpp +++ b/flang/lib/Optimizer/Transforms/AffinePromotion.cpp @@ -27,31 +27,95 @@ using namespace fir; namespace { -class AffineFunctionAnalysis; -class AffineLoopAnalysis; -class AffineIfAnalysis; -class AffineIfConversion; +struct AffineLoopAnalysis; +struct AffineIfAnalysis; -class AffineLoopAnalysis { -public: - AffineLoopAnalysis(fir::DoLoopOp op, AffineFunctionAnalysis &afa) +/// Stores analysis objects for all loops and if operations inside a function +/// these analysis are used twice, first for marking operations for rewrite and +/// second when doing rewrite. +struct AffineFunctionAnalysis { + explicit AffineFunctionAnalysis(mlir::FuncOp funcOp) { + for (fir::DoLoopOp op : funcOp.getOps()) + loopAnalysisMap.try_emplace(op, op, *this); + } + + AffineLoopAnalysis getChildLoopAnalysis(fir::DoLoopOp op) const; + + AffineIfAnalysis getChildIfAnalysis(fir::IfOp op) const; + + llvm::DenseMap loopAnalysisMap; + llvm::DenseMap ifAnalysisMap; +}; +} // namespace + +static bool analyzeCoordinate(mlir::Value coordinate, mlir::Operation *op) { + if (auto blockArg = coordinate.dyn_cast()) { + if (isa(blockArg.getOwner()->getParentOp())) + return true; + LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: array coordinate is not a " + "loop induction variable (owner not loopOp)\n"; + op->dump()); + return false; + } + LLVM_DEBUG( + llvm::dbgs() << "AffineLoopAnalysis: array coordinate is not a loop " + "induction variable (not a block argument)\n"; + op->dump(); coordinate.getDefiningOp()->dump()); + return false; +} + +namespace { +struct AffineLoopAnalysis { + AffineLoopAnalysis() = default; + + explicit AffineLoopAnalysis(fir::DoLoopOp op, AffineFunctionAnalysis &afa) : legality(analyzeLoop(op, afa)) {} + bool canPromoteToAffine() { return legality; } - friend AffineFunctionAnalysis; private: - bool legality; - struct MemoryLoadAnalysis {}; - DenseMap loadAnalysis; - AffineLoopAnalysis(bool forcedLegality) : legality(forcedLegality) {} - bool analyzeBody(fir::DoLoopOp, AffineFunctionAnalysis &); + bool analyzeBody(fir::DoLoopOp loopOperation, + AffineFunctionAnalysis &functionAnalysis) { + for (auto loopOp : loopOperation.getOps()) { + auto analysis = functionAnalysis.loopAnalysisMap + .try_emplace(loopOp, loopOp, functionAnalysis) + .first->getSecond(); + if (!analysis.canPromoteToAffine()) + return false; + } + for (auto ifOp : loopOperation.getOps()) + functionAnalysis.ifAnalysisMap.try_emplace(ifOp, ifOp, functionAnalysis); + return true; + } + bool analyzeLoop(fir::DoLoopOp loopOperation, AffineFunctionAnalysis &functionAnalysis) { LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: \n"; loopOperation.dump();); return analyzeMemoryAccess(loopOperation) && analyzeBody(loopOperation, functionAnalysis); } - bool analyzeReference(mlir::Value, mlir::Operation *); + + bool analyzeReference(mlir::Value memref, mlir::Operation *op) { + if (auto acoOp = memref.getDefiningOp()) { + bool canPromote = true; + for (auto coordinate : acoOp.indices()) + canPromote = canPromote && analyzeCoordinate(coordinate, op); + return canPromote; + } + if (auto coOp = memref.getDefiningOp()) { + LLVM_DEBUG(llvm::dbgs() + << "AffineLoopAnalysis: cannot promote loop, " + "array memory operation uses non ArrayCoorOp\n"; + op->dump(); coOp.dump();); + + return false; + } + LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: unknown type of memory " + "reference for array load\n"; + op->dump();); + return false; + } + bool analyzeMemoryAccess(fir::DoLoopOp loopOperation) { for (auto loadOp : loopOperation.getOps()) if (!analyzeReference(loadOp.memref(), loadOp)) @@ -61,29 +125,45 @@ class AffineLoopAnalysis { return false; return true; } + + bool legality{}; }; +} // namespace -/// Calculates arguments for creating an IntegerSet symCount, dimCount are the +AffineLoopAnalysis +AffineFunctionAnalysis::getChildLoopAnalysis(fir::DoLoopOp op) const { + auto it = loopAnalysisMap.find_as(op); + if (it == loopAnalysisMap.end()) { + LLVM_DEBUG(llvm::dbgs() << "AffineFunctionAnalysis: not computed for:\n"; + op.dump();); + op.emitError("error in fetching loop analysis in AffineFunctionAnalysis\n"); + return {}; + } + return it->getSecond(); +} + +namespace { +/// Calculates arguments for creating an IntegerSet. symCount, dimCount are the /// final number of symbols and dimensions of the affine map. Integer set if -/// possible is in Optional IntegerSet -class AffineIfCondition { -public: - typedef Optional MaybeAffineExpr; - AffineIfCondition(mlir::Value fc) - : firCondition(fc), symCount(0), dimCount(0) { +/// possible is in Optional IntegerSet. +struct AffineIfCondition { + using MaybeAffineExpr = llvm::Optional; + + explicit AffineIfCondition(mlir::Value fc) : firCondition(fc) { if (auto condDef = firCondition.getDefiningOp()) fromCmpIOp(condDef); } - AffineIfCondition() {} - llvm::SmallVector affineArgs; - friend AffineIfAnalysis; - friend AffineIfConversion; -private: - mlir::Value firCondition; - Optional integerSet; - unsigned symCount, dimCount; + bool hasIntegerSet() const { return integerSet.hasValue(); } + mlir::IntegerSet getIntegerSet() const { + assert(hasIntegerSet() && "integer set is missing"); + return integerSet.getValue(); + } + + mlir::ValueRange getAffineArgs() const { return affineArgs; } + +private: MaybeAffineExpr affineBinaryOp(mlir::AffineExprKind kind, mlir::Value lhs, mlir::Value rhs) { return affineBinaryOp(kind, toAffineExpr(lhs), toAffineExpr(rhs)); @@ -93,13 +173,15 @@ class AffineIfCondition { MaybeAffineExpr rhs) { if (lhs.hasValue() && rhs.hasValue()) return mlir::getAffineBinaryOpExpr(kind, lhs.getValue(), rhs.getValue()); - else - return {}; + return {}; } + MaybeAffineExpr toAffineExpr(MaybeAffineExpr e) { return e; } + MaybeAffineExpr toAffineExpr(int64_t value) { return {mlir::getAffineConstantExpr(value, firCondition.getContext())}; } + /// Returns an AffineExpr if it is a result of operations that can be done /// in an affine expression, this includes -, +, *, rem, constant. /// block arguments of a loopOp or forOp are used as dimensions @@ -127,6 +209,7 @@ class AffineIfCondition { } return {}; } + void fromCmpIOp(mlir::CmpIOp cmpOp) { auto lhsAffine = toAffineExpr(cmpOp.lhs()); auto rhsAffine = toAffineExpr(cmpOp.rhs()); @@ -142,7 +225,7 @@ class AffineIfCondition { return; } - Optional> + llvm::Optional> constraint(mlir::CmpIPredicate predicate, mlir::AffineExpr basic) { switch (predicate) { case mlir::CmpIPredicate::slt: @@ -159,128 +242,56 @@ class AffineIfCondition { return {}; } } + + llvm::SmallVector affineArgs; + llvm::Optional integerSet; + mlir::Value firCondition; + unsigned symCount{0u}; + unsigned dimCount{0u}; }; +} // namespace +namespace { /// Analysis for affine promotion of fir.if -class AffineIfAnalysis { -public: - AffineIfAnalysis(fir::IfOp op, AffineFunctionAnalysis &afa) - : legality(analyzeIf(op, afa)) {} - bool canPromoteToAffine() { return legality; } - friend AffineFunctionAnalysis; +struct AffineIfAnalysis { + AffineIfAnalysis() = default; -private: - bool legality; - AffineIfAnalysis(bool forcedLegality) : legality(forcedLegality) {} - bool analyzeIf(fir::IfOp, AffineFunctionAnalysis &); -}; + explicit AffineIfAnalysis(fir::IfOp op, AffineFunctionAnalysis &afa) + : legality(analyzeIf(op, afa)) {} -/// Stores analysis objects for all loops and if operations inside a function -/// these analysis are used twice, first for marking operations for rewrite and -/// second when doing rewrite. -class AffineFunctionAnalysis { -public: - AffineFunctionAnalysis(mlir::FuncOp funcOp) { - for (fir::DoLoopOp op : funcOp.getOps()) - loopAnalysisMap.try_emplace(op, op, *this); - } - AffineLoopAnalysis getChildLoopAnalysis(fir::DoLoopOp op) const { - auto it = loopAnalysisMap.find_as(op); - if (it == loopAnalysisMap.end()) { - LLVM_DEBUG(llvm::dbgs() << "AffineFunctionAnalysis: not computed for:\n"; - op.dump();); - op.emitError( - "error in fetching loop analysis in AffineFunctionAnalysis\n"); - return AffineLoopAnalysis(false); - } - return it->getSecond(); - } - AffineIfAnalysis getChildIfAnalysis(fir::IfOp op) const { - auto it = ifAnalysisMap.find_as(op); - if (it == ifAnalysisMap.end()) { - LLVM_DEBUG(llvm::dbgs() << "AffineFunctionAnalysis: not computed for:\n"; - op.dump();); - op.emitError("error in fetching if analysis in AffineFunctionAnalysis\n"); - return AffineIfAnalysis(false); - } - return it->getSecond(); - } - friend AffineLoopAnalysis; - friend AffineIfAnalysis; + bool canPromoteToAffine() { return legality; } private: - llvm::DenseMap loopAnalysisMap; - llvm::DenseMap ifAnalysisMap; -}; - -bool analyzeCoordinate(mlir::Value coordinate, mlir::Operation *op) { - if (auto blockArg = coordinate.dyn_cast()) { - if (isa(blockArg.getOwner()->getParentOp())) { + bool analyzeIf(fir::IfOp op, AffineFunctionAnalysis &afa) { + if (op.getNumResults() == 0) return true; - } else { - LLVM_DEBUG(llvm::dbgs() - << "AffineLoopAnalysis: array coordinate is not a " - "loop induction variable (owner not loopOp)\n"; - op->dump();); - return false; - } - } else { LLVM_DEBUG(llvm::dbgs() - << "AffineLoopAnalysis: array coordinate is not a loop " - "induction variable (not a block argument)\n"; - op->dump(); coordinate.getDefiningOp()->dump();); + << "AffineIfAnalysis: not promoting as op has results\n";); return false; } -} -bool AffineLoopAnalysis::analyzeReference(mlir::Value memref, - mlir::Operation *op) { - if (auto acoOp = memref.getDefiningOp()) { - bool canPromote = true; - for (auto coordinate : acoOp.indices()) - canPromote = canPromote && analyzeCoordinate(coordinate, op); - return canPromote; - } - if (auto coOp = memref.getDefiningOp()) { - LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: cannot promote loop, " - "array memory operation uses non ArrayCoorOp\n"; - op->dump(); coOp.dump();); - return false; - } - LLVM_DEBUG(llvm::dbgs() << "AffineLoopAnalysis: unknown type of memory " - "reference for array load\n"; - op->dump();); - return false; -} + bool legality{}; +}; +} // namespace -bool AffineLoopAnalysis::analyzeBody(fir::DoLoopOp loopOperation, - AffineFunctionAnalysis &functionAnalysis) { - for (auto loopOp : loopOperation.getOps()) { - auto analysis = functionAnalysis.loopAnalysisMap - .try_emplace(loopOp, loopOp, functionAnalysis) - .first->getSecond(); - if (!analysis.canPromoteToAffine()) - return false; +AffineIfAnalysis +AffineFunctionAnalysis::getChildIfAnalysis(fir::IfOp op) const { + auto it = ifAnalysisMap.find_as(op); + if (it == ifAnalysisMap.end()) { + LLVM_DEBUG(llvm::dbgs() << "AffineFunctionAnalysis: not computed for:\n"; + op.dump();); + op.emitError("error in fetching if analysis in AffineFunctionAnalysis\n"); + return {}; } - for (auto ifOp : loopOperation.getOps()) - functionAnalysis.ifAnalysisMap.try_emplace(ifOp, ifOp, functionAnalysis); - return true; -} - -bool AffineIfAnalysis::analyzeIf(fir::IfOp op, AffineFunctionAnalysis &afa) { - if (op.getNumResults() == 0) - return true; - LLVM_DEBUG( - llvm::dbgs() << "AffineIfAnalysis: not promoting as op has results\n";); - return false; + return it->getSecond(); } /// AffineMap rewriting fir.array_coor operation to affine apply, /// %dim = fir.gendim %lowerBound, %upperBound, %stride /// %a = fir.array_coor %arr(%dim) %i /// returning affineMap = affine_map<(i)[lb, ub, st] -> (i*st - lb)> -mlir::AffineMap createArrayIndexAffineMap(unsigned dimensions, - MLIRContext *context) { +static mlir::AffineMap createArrayIndexAffineMap(unsigned dimensions, + MLIRContext *context) { auto index = mlir::getAffineConstantExpr(0, context); auto accuExtent = mlir::getAffineConstantExpr(1, context); for (unsigned i = 0; i < dimensions; ++i) { @@ -296,14 +307,14 @@ mlir::AffineMap createArrayIndexAffineMap(unsigned dimensions, return mlir::AffineMap::get(dimensions, dimensions * 3, index); } -Optional constantIntegerLike(const mlir::Value value) { +static Optional constantIntegerLike(const mlir::Value value) { if (auto definition = value.getDefiningOp()) if (auto stepAttr = definition.getValue().dyn_cast()) return stepAttr.getInt(); return {}; } -mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) { +static mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) { if (auto refType = op.memref().getType().dyn_cast_or_null()) { if (auto seqType = refType.getEleTy().dyn_cast_or_null()) { return seqType.getEleTy(); @@ -314,9 +325,9 @@ mlir::Type coordinateArrayElement(fir::ArrayCoorOp op) { return mlir::Type(); } -void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeOp shape, - SmallVectorImpl &indexArgs, - mlir::PatternRewriter &rewriter) { +static void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeOp shape, + SmallVectorImpl &indexArgs, + mlir::PatternRewriter &rewriter) { auto one = rewriter.create( acoOp.getLoc(), rewriter.getIndexType(), rewriter.getIndexAttr(1)); auto extents = shape.extents(); @@ -327,9 +338,9 @@ void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeOp shape, } } -void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeShiftOp shape, - SmallVectorImpl &indexArgs, - mlir::PatternRewriter &rewriter) { +static void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeShiftOp shape, + SmallVectorImpl &indexArgs, + mlir::PatternRewriter &rewriter) { auto one = rewriter.create( acoOp.getLoc(), rewriter.getIndexType(), rewriter.getIndexAttr(1)); auto extents = shape.pairs(); @@ -339,9 +350,10 @@ void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::ShapeShiftOp shape, indexArgs.push_back(one); } } -void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::SliceOp slice, - SmallVectorImpl &indexArgs, - mlir::PatternRewriter &rewriter) { + +static void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::SliceOp slice, + SmallVectorImpl &indexArgs, + mlir::PatternRewriter &rewriter) { auto extents = slice.triples(); for (auto i = extents.begin(); i < extents.end();) { indexArgs.push_back(*i++); @@ -350,9 +362,9 @@ void populateIndexArgs(fir::ArrayCoorOp acoOp, fir::SliceOp slice, } } -void populateIndexArgs(fir::ArrayCoorOp acoOp, - SmallVectorImpl &indexArgs, - mlir::PatternRewriter &rewriter) { +static void populateIndexArgs(fir::ArrayCoorOp acoOp, + SmallVectorImpl &indexArgs, + mlir::PatternRewriter &rewriter) { if (auto shape = acoOp.shape().getDefiningOp()) return populateIndexArgs(acoOp, shape, indexArgs, rewriter); if (auto shapeShift = acoOp.shape().getDefiningOp()) @@ -363,7 +375,7 @@ void populateIndexArgs(fir::ArrayCoorOp acoOp, } /// Returns affine.apply and fir.convert from array_coor and gendims -std::pair +static std::pair createAffineOps(mlir::Value arrayRef, mlir::PatternRewriter &rewriter) { auto acoOp = arrayRef.getDefiningOp(); auto affineMap = @@ -382,14 +394,15 @@ createAffineOps(mlir::Value arrayRef, mlir::PatternRewriter &rewriter) { return std::make_pair(affineApply, arrayConvert); } -void rewriteLoad(fir::LoadOp loadOp, mlir::PatternRewriter &rewriter) { +static void rewriteLoad(fir::LoadOp loadOp, mlir::PatternRewriter &rewriter) { rewriter.setInsertionPoint(loadOp); auto affineOps = createAffineOps(loadOp.memref(), rewriter); rewriter.replaceOpWithNewOp( loadOp, affineOps.second.getResult(), affineOps.first.getResult()); } -void rewriteStore(fir::StoreOp storeOp, mlir::PatternRewriter &rewriter) { +static void rewriteStore(fir::StoreOp storeOp, + mlir::PatternRewriter &rewriter) { rewriter.setInsertionPoint(storeOp); auto affineOps = createAffineOps(storeOp.memref(), rewriter); rewriter.replaceOpWithNewOp(storeOp, storeOp.value(), @@ -397,7 +410,7 @@ void rewriteStore(fir::StoreOp storeOp, mlir::PatternRewriter &rewriter) { affineOps.first.getResult()); } -void rewriteMemoryOps(Block *block, mlir::PatternRewriter &rewriter) { +static void rewriteMemoryOps(Block *block, mlir::PatternRewriter &rewriter) { for (auto &bodyOp : block->getOperations()) { if (isa(bodyOp)) rewriteLoad(cast(bodyOp), rewriter); @@ -406,6 +419,7 @@ void rewriteMemoryOps(Block *block, mlir::PatternRewriter &rewriter) { } } +namespace { /// Convert `fir.do_loop` to `affine.for`, creates fir.convert for arrays to /// memref, rewrites array_coor to affine.apply with affine_map. Rewrites fir /// loads and stores to affine. @@ -420,16 +434,17 @@ class AffineLoopConversion : public mlir::OpRewritePattern { mlir::PatternRewriter &rewriter) const override { LLVM_DEBUG(llvm::dbgs() << "AffineLoopConversion: rewriting loop:\n"; loop.dump();); - auto loopAnalysis = functionAnalysis.getChildLoopAnalysis(loop); + [[maybe_unused]] auto loopAnalysis = + functionAnalysis.getChildLoopAnalysis(loop); auto &loopOps = loop.getBody()->getOperations(); auto loopAndIndex = createAffineFor(loop, rewriter); auto affineFor = loopAndIndex.first; auto inductionVar = loopAndIndex.second; rewriter.startRootUpdate(affineFor.getOperation()); - affineFor.getBody()->getOperations().splice(--affineFor.getBody()->end(), - loopOps, loopOps.begin(), - --loopOps.end()); + affineFor.getBody()->getOperations().splice( + std::prev(affineFor.getBody()->end()), loopOps, loopOps.begin(), + std::prev(loopOps.end())); rewriter.finalizeRootUpdate(affineFor.getOperation()); rewriter.startRootUpdate(loop.getOperation()); @@ -452,6 +467,7 @@ class AffineLoopConversion : public mlir::OpRewritePattern { return positiveConstantStep(op, constantStep.getValue(), rewriter); return genericBounds(op, rewriter); } + // when step for the loop is positive compile time constant std::pair positiveConstantStep(fir::DoLoopOp op, int64_t step, @@ -466,6 +482,7 @@ class AffineLoopConversion : public mlir::OpRewritePattern { step); return std::make_pair(affineFor, affineFor.getInductionVar()); } + std::pair genericBounds(fir::DoLoopOp op, mlir::PatternRewriter &rewriter) const { auto lowerBound = mlir::getAffineSymbolExpr(0, op.getContext()); @@ -494,9 +511,11 @@ class AffineLoopConversion : public mlir::OpRewritePattern { ValueRange({affineFor.getInductionVar(), op.lowerBound(), op.step()})); return std::make_pair(affineFor, actualIndex.getResult()); } + AffineFunctionAnalysis &functionAnalysis; }; +/// Convert `fir.if` to `affine.if`. class AffineIfConversion : public mlir::OpRewritePattern { public: using OpRewritePattern::OpRewritePattern; @@ -509,23 +528,24 @@ class AffineIfConversion : public mlir::OpRewritePattern { op.dump();); auto &ifOps = op.thenRegion().front().getOperations(); auto affineCondition = AffineIfCondition(op.condition()); - if (!affineCondition.integerSet) { + if (!affineCondition.hasIntegerSet()) { LLVM_DEBUG( llvm::dbgs() << "AffineIfConversion: couldn't calculate affine condition\n";); return failure(); } auto affineIf = rewriter.create( - op.getLoc(), affineCondition.integerSet.getValue(), - affineCondition.affineArgs, !op.elseRegion().empty()); + op.getLoc(), affineCondition.getIntegerSet(), + affineCondition.getAffineArgs(), !op.elseRegion().empty()); rewriter.startRootUpdate(affineIf); affineIf.getThenBlock()->getOperations().splice( - --affineIf.getThenBlock()->end(), ifOps, ifOps.begin(), --ifOps.end()); + std::prev(affineIf.getThenBlock()->end()), ifOps, ifOps.begin(), + std::prev(ifOps.end())); if (!op.elseRegion().empty()) { auto &otherOps = op.elseRegion().front().getOperations(); affineIf.getElseBlock()->getOperations().splice( - --affineIf.getElseBlock()->end(), otherOps, otherOps.begin(), - --otherOps.end()); + std::prev(affineIf.getElseBlock()->end()), otherOps, otherOps.begin(), + std::prev(otherOps.end())); } rewriter.finalizeRootUpdate(affineIf); rewriteMemoryOps(affineIf.getBody(), rewriter); From ddeb82e9396cb6303c3616c91278cda8f89508fa Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 22 Oct 2020 06:27:47 -0700 Subject: [PATCH 0325/1017] Fix offset of first global variable in EQUIVALENCE --- flang/lib/Lower/Bridge.cpp | 31 +++++------ flang/test/Lower/equivalence-2.f90 | 88 ++++++++++++++++++++++++++++++ flang/test/Lower/equivalence.f90 | 10 ++-- 3 files changed, 106 insertions(+), 23 deletions(-) create mode 100644 flang/test/Lower/equivalence-2.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index fdbf32f3776f8..c287ee58a6be4 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1732,6 +1732,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto globalName = mangleName(sym); bool isConst = sym.attrs().test(Fortran::semantics::Attr::PARAMETER); auto loc = genLocation(sym.name()); + assert(!var.isAlias() && "must be handled in instantiateAlias"); // FIXME: name returned does not consider subprogram's scope, is not unique fir::GlobalOp global = builder->getNamedGlobal(globalName); if (global) { @@ -1743,10 +1744,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { } return; } - if (var.isAlias()) { - instantiateAlias(var, storeMap); - return; - } if (const auto *details = sym.detailsIf()) { // FIXME: an exported module variable will have external linkage. @@ -1908,19 +1905,19 @@ class FirConverter : public Fortran::lower::AbstractConverter { /*isConstant=*/false, initFunc, linkage); auto addr = builder->create(loc, agg.resultType(), agg.getSymbol()); - auto varTy = builder->getRefType(genType(*st.vars[0])); - auto result = builder->createConvert(loc, varTy, addr); - storeMap[off] = result; - mapSymbolAttributes(Fortran::lower::pft::Variable{*st.vars[0]}, storeMap, - result); + auto size = std::get<1>(var.getInterval()); + fir::SequenceType::Shape shape(1, size); + auto seqTy = fir::SequenceType::get(shape, i8Ty); + auto refTy = builder->getRefType(seqTy); + storeMap[off] = builder->createConvert(loc, refTy, addr); return; } // Allocate an anonymous block of memory. auto size = std::get<1>(var.getInterval()); - llvm::SmallVector shape = { - builder->createIntegerConstant(loc, idxTy, size)}; - auto local = - builder->allocateLocal(toLocation(), i8Ty, "", shape, /*target=*/false); + fir::SequenceType::Shape shape(1, size); + auto seqTy = fir::SequenceType::get(shape, i8Ty); + auto local = builder->allocateLocal(toLocation(), seqTy, "", llvm::None, + /*target=*/false); storeMap[off] = local; } @@ -1944,11 +1941,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto store = storeMap.find(aliasOffset)->second; auto i8Ty = builder->getIntegerType(8); auto i8Ptr = builder->getRefType(i8Ty); - auto seqTy = builder->getRefType(builder->getVarLenSeqTy(i8Ty)); - auto base = builder->createConvert(loc, seqTy, store); llvm::SmallVector offs{ builder->createIntegerConstant(loc, idxTy, sym.offset() - aliasOffset)}; - auto ptr = builder->create(loc, i8Ptr, base, offs); + auto ptr = builder->create(loc, i8Ptr, store, offs); auto preAlloc = builder->createConvert( loc, builder->getRefType(genTypeWithCharFixup(sym)), ptr); @@ -2612,10 +2607,10 @@ class FirConverter : public Fortran::lower::AbstractConverter { instantiateCommon( *Fortran::semantics::FindCommonBlockContaining(var.getSymbol()), var, storeMap, *cmnBlkMap); - } else if (var.isGlobal()) { - instantiateGlobal(var, storeMap); } else if (var.isAlias()) { instantiateAlias(var, storeMap); + } else if (var.isGlobal()) { + instantiateGlobal(var, storeMap); } else { instantiateLocal(var, storeMap); } diff --git a/flang/test/Lower/equivalence-2.f90 b/flang/test/Lower/equivalence-2.f90 new file mode 100644 index 0000000000000..f8bbc955a37d9 --- /dev/null +++ b/flang/test/Lower/equivalence-2.f90 @@ -0,0 +1,88 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +! Check more advanced equivalence cases + +! Several set of local and global equivalences in the same scope +! CHECK-LABEL: @_QPtest_eq_sets +subroutine test_eq_sets + DIMENSION Al(4), Bl(4) + EQUIVALENCE (Al(1), Bl(2)) + ! CHECK-DAG: %[[albl:.*]] = fir.alloca !fir.array<20xi8> + ! CHECK-DAG: %[[alAddr:.*]] = fir.coordinate_of %[[albl]], %c4{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[al:.*]] = fir.convert %[[alAddr]] : (!fir.ref) -> !fir.ref> + ! CHECK-DAG: %[[blAddr:.*]] = fir.coordinate_of %[[albl]], %c0{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[bl:.*]] = fir.convert %[[blAddr]] : (!fir.ref) -> !fir.ref> + + DIMENSION Il(2), Xl(2) + EQUIVALENCE (Il(2), Xl(1)) + ! CHECK-DAG: %[[ilxl:.*]] = fir.alloca !fir.array<12xi8> + ! CHECK-DAG: %[[ilAddr:.*]] = fir.coordinate_of %[[ilxl]], %c0{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[il:.*]] = fir.convert %[[ilAddr]] : (!fir.ref) -> !fir.ref> + ! CHECK-DAG: %[[xlAddr:.*]] = fir.coordinate_of %[[ilxl]], %c4{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[xl:.*]] = fir.convert %[[xlAddr]] : (!fir.ref) -> !fir.ref> + + DIMENSION Ag(2), Bg(2) + SAVE Ag, Bg + EQUIVALENCE (Ag(1), Bg(2)) + ! CHECK-DAG: %[[agbgStore:.*]] = fir.address_of(@_QFtest_eq_setsEag) : !fir.ref, !fir.array<8xi8>>> + ! CHECK-DAG: %[[agbg:.*]] = fir.convert %[[agbgStore]] : (!fir.ref, !fir.array<8xi8>>>) -> !fir.ref> + ! CHECK-DAG: %[[agAddr:.*]] = fir.coordinate_of %[[agbg]], %c4{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[ag:.*]] = fir.convert %[[agAddr]] : (!fir.ref) -> !fir.ref> + ! CHECK-DAG: %[[bgAddr:.*]] = fir.coordinate_of %[[agbg]], %c0{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[bg:.*]] = fir.convert %[[bgAddr]] : (!fir.ref) -> !fir.ref> + + DIMENSION Ig(2), Xg(2) + SAVE Ig, Xg + EQUIVALENCE (Ig(1), Xg(1)) + ! CHECK-DAG: %[[igxgStore:.*]] = fir.address_of(@_QFtest_eq_setsEig) : !fir.ref>> + ! CHECK-DAG: %[[igxg:.*]] = fir.convert %[[igxgStore]] : (!fir.ref>>) -> !fir.ref> + ! CHECK-DAG: %[[igOffset:.*]] = constant 0 : index + ! CHECK-DAG: %[[igAddr:.*]] = fir.coordinate_of %[[igxg]], %c0{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[ig:.*]] = fir.convert %[[igAddr]] : (!fir.ref) -> !fir.ref> + ! CHECK-DAG: %[[xgAddr:.*]] = fir.coordinate_of %[[igxg]], %c0{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[xg:.*]] = fir.convert %[[xgAddr]] : (!fir.ref) -> !fir.ref> + + call fooc(Al, Bl, Il, Xl, Ag, Bg, Xg, Ig) + ! CHECK: fir.call @_QPfooc(%[[al]], %[[bl]], %[[il]], %[[xl]], %[[ag]], %[[bg]], %[[xg]], %[[ig]]) + +end subroutine + + +! Mixing global equivalence and entry +! CHECK-LABEL: @_QPeq_and_entry_foo() +subroutine eq_and_entry_foo + SAVE x, i + DIMENSION :: x(2) + EQUIVALENCE (x(2), i) + call foo1(x, i) + ! CHECK: %[[xiStore:.*]] = fir.address_of(@_QFeq_and_entry_fooEi) : !fir.ref, !fir.array<4xi8>>> + ! CHECK-DAG: %[[xi:.*]] = fir.convert %[[xiStore]] : (!fir.ref, !fir.array<4xi8>>>) -> !fir.ref> + + ! CHECK-DAG: %[[iOffset:.*]] = constant 4 : index + ! CHECK-DAG: %[[iAddr:.*]] = fir.coordinate_of %[[xi]], %[[iOffset]] : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[i:.*]] = fir.convert %[[iAddr]] : (!fir.ref) -> !fir.ref + + ! CHECK-DAG: %[[xOffset:.*]] = constant 0 : index + ! CHECK-DAG: %[[xAddr:.*]] = fir.coordinate_of %[[xi]], %[[xOffset]] : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[x:.*]] = fir.convert %[[xAddr]] : (!fir.ref) -> !fir.ref> + call foo2(x, i) + ! CHECK: fir.call @_QPfoo1(%[[x]], %[[i]]) : (!fir.ref>, !fir.ref) -> () + entry eq_and_entry_bar + call foo2(x, i) + ! CHECK: fir.call @_QPfoo2(%[[x]], %[[i]]) : (!fir.ref>, !fir.ref) -> () +end + +! CHECK-LABEL: @_QPeq_and_entry_bar() + ! CHECK: %[[xiStore:.*]] = fir.address_of(@_QFeq_and_entry_fooEi) : !fir.ref, !fir.array<4xi8>>> + ! CHECK-DAG: %[[xi:.*]] = fir.convert %[[xiStore]] : (!fir.ref, !fir.array<4xi8>>>) -> !fir.ref> + + ! CHECK-DAG: %[[iOffset:.*]] = constant 4 : index + ! CHECK-DAG: %[[iAddr:.*]] = fir.coordinate_of %[[xi]], %[[iOffset]] : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[i:.*]] = fir.convert %[[iAddr]] : (!fir.ref) -> !fir.ref + + ! CHECK-DAG: %[[xOffset:.*]] = constant 0 : index + ! CHECK-DAG: %[[xAddr:.*]] = fir.coordinate_of %[[xi]], %[[xOffset]] : (!fir.ref>, index) -> !fir.ref + ! CHECK-DAG: %[[x:.*]] = fir.convert %[[xAddr]] : (!fir.ref) -> !fir.ref> + ! CHECK-NOT: fir.call @_QPfoo1 + ! CHECK: fir.call @_QPfoo2(%[[x]], %[[i]]) : (!fir.ref>, !fir.ref) -> () + diff --git a/flang/test/Lower/equivalence.f90 b/flang/test/Lower/equivalence.f90 index ccfe0bc2319a7..199d31153e76b 100644 --- a/flang/test/Lower/equivalence.f90 +++ b/flang/test/Lower/equivalence.f90 @@ -4,9 +4,9 @@ SUBROUTINE s1 INTEGER i REAL r - ! CHECK: = fir.alloca i8, % + ! CHECK: = fir.alloca !fir.array<4xi8> EQUIVALENCE (r,i) - ! CHECK: %[[coor:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[coor:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref>, index) -> !fir.ref ! CHECK: %[[iloc:.*]] = fir.convert %[[coor]] : (!fir.ref) -> !fir.ref ! CHECK-DAG: fir.store %{{.*}} to %[[iloc]] : !fir.ref i = 4 @@ -19,11 +19,11 @@ END SUBROUTINE s1 SUBROUTINE s2 INTEGER i(10) REAL r(10) - ! CHECK: = fir.alloca i8, % + ! CHECK: %[[arr:.*]] = fir.alloca !fir.array<48xi8> EQUIVALENCE (r(3),i(5)) ! CHECK: %[[iarr:.*]] = fir.convert %{{.*}} : (!fir.ref) -> !fir.ref> - ! CHECK: %[[ioff:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref>, index) -> !fir.ref - ! CHECK: %[[farr:.*]] = fir.convert %[[ioff]] : (!fir.ref) -> !fir.ref> + ! CHECK: %[[foff:.*]] = fir.coordinate_of %[[arr]], %{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[farr:.*]] = fir.convert %[[foff]] : (!fir.ref) -> !fir.ref> ! CHECK: %[[ia:.*]] = fir.coordinate_of %[[iarr]], %{{.*}} : (!fir.ref>, i64) -> !fir.ref ! CHECK: fir.store %{{.*}} to %[[ia]] : !fir.ref i(5) = 18 From ff36d240404be5b5c9533ea82ed0454e28e8bfe3 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 23 Oct 2020 13:07:34 -0700 Subject: [PATCH 0326/1017] Finish threading the reentrancy through the variable handling. Fix #489. fix bug with mpsubprogram fix tests --- flang/include/flang/Lower/PFTBuilder.h | 13 +++++---- flang/lib/Lower/PFTBuilder.cpp | 33 ++++++++++++++--------- flang/test/Lower/OpenACC/acc-data.f90 | 4 +-- flang/test/Lower/OpenACC/acc-parallel.f90 | 4 +-- flang/test/Lower/loops.f90 | 3 ++- 5 files changed, 35 insertions(+), 22 deletions(-) diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 618e2d755481f..ca5370ecd744e 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -555,12 +555,15 @@ struct FunctionLikeUnit : public ProgramUnit { FunctionLikeUnit(FunctionLikeUnit &&) = default; FunctionLikeUnit(const FunctionLikeUnit &) = delete; + /// Return true iff this function like unit is Fortran recursive (actually + /// meaning it's reentrant). bool isRecursive() const { - auto sym = getSubprogramSymbol(); - return !isMainProgram() && - (sym.attrs().test(semantics::Attr::RECURSIVE) || - (!sym.attrs().test(semantics::Attr::NON_RECURSIVE) && - defaultRecursiveFunctionSetting())); + if (isMainProgram()) + return false; + const auto &sym = getSubprogramSymbol(); + return sym.attrs().test(semantics::Attr::RECURSIVE) || + (!sym.attrs().test(semantics::Attr::NON_RECURSIVE) && + defaultRecursiveFunctionSetting()); } std::vector getOrderedSymbolTable() { return varList[0]; } diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index efc0f11591508..7f553c0883d9b 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -1041,8 +1041,8 @@ namespace { /// symbol table, which is sorted by name. struct SymbolDependenceDepth { explicit SymbolDependenceDepth( - std::vector> &vars) - : vars{vars} {} + std::vector> &vars, bool reentrant) + : vars{vars}, reentrant{reentrant} {} // Analyze the equivalence sets. This analysis need not be performed when the // scope has no equivalence sets. @@ -1144,9 +1144,12 @@ struct SymbolDependenceDepth { // check CHARACTER's length if (symTy->category() == semantics::DeclTypeSpec::Character) - if (auto e = symTy->characterTypeSpec().length().GetExplicit()) + if (auto e = symTy->characterTypeSpec().length().GetExplicit()) { + // turn variable into a global if this unit is not reentrant + global = global || !reentrant; for (const auto &s : evaluate::CollectSymbols(*e)) depth = std::max(analyze(s) + 1, depth); + } if (const auto *details = sym.detailsIf()) { auto doExplicit = [&](const auto &bound) { @@ -1157,11 +1160,15 @@ struct SymbolDependenceDepth { } }; // handle any symbols in array bound declarations + if (!details->shape().empty()) + global = global || !reentrant; for (const auto &subs : details->shape()) { doExplicit(subs.lbound()); doExplicit(subs.ubound()); } // handle any symbols in coarray bound declarations + if (!details->coshape().empty()) + global = global || !reentrant; for (const auto &subs : details->coshape()) { doExplicit(subs.lbound()); doExplicit(subs.ubound()); @@ -1245,13 +1252,15 @@ struct SymbolDependenceDepth { std::vector> &vars; llvm::SmallSet aliasSyms; std::vector stores; + bool reentrant; }; } // namespace static void processSymbolTable( const semantics::Scope &scope, - std::vector> &varList) { - SymbolDependenceDepth sdd{varList}; + std::vector> &varList, + bool reentrant) { + SymbolDependenceDepth sdd{varList, reentrant}; if (!scope.equivalenceSets().empty()) sdd.analyzeAliases(scope); sdd.prepareStores(); @@ -1272,12 +1281,12 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( beginStmt = FunctionStatement(programStmt.value()); auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope(), varList); + processSymbolTable(*symbol->scope(), varList, isRecursive()); } else { processSymbolTable( semanticsContext.FindScope( std::get>(func.t).source), - varList); + varList, isRecursive()); } } @@ -1290,7 +1299,7 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( endStmt{getFunctionStmt(func)} { auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope(), varList); + processSymbolTable(*symbol->scope(), varList, isRecursive()); } Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( @@ -1302,7 +1311,7 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( endStmt{getFunctionStmt(func)} { auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope(), varList); + processSymbolTable(*symbol->scope(), varList, isRecursive()); } Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( @@ -1314,7 +1323,7 @@ Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit( endStmt{getFunctionStmt(func)} { auto symbol = getSymbol(*beginStmt); entryPointList[0].first = symbol; - processSymbolTable(*symbol->scope(), varList); + processSymbolTable(*symbol->scope(), varList, isRecursive()); } Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit( @@ -1322,7 +1331,7 @@ Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit( : ProgramUnit{m, parent}, beginStmt{getModuleStmt(m)}, endStmt{getModuleStmt(m)} { auto symbol = getSymbol(beginStmt); - processSymbolTable(*symbol->scope(), varList); + processSymbolTable(*symbol->scope(), varList, /*reentrant=*/false); } Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit( @@ -1331,7 +1340,7 @@ Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit( m)}, endStmt{getModuleStmt(m)} { auto symbol = getSymbol(beginStmt); - processSymbolTable(*symbol->scope(), varList); + processSymbolTable(*symbol->scope(), varList, /*reentrant=*/false); } Fortran::lower::pft::BlockDataUnit::BlockDataUnit( diff --git a/flang/test/Lower/OpenACC/acc-data.f90 b/flang/test/Lower/OpenACC/acc-data.f90 index 58b8552fa3cc1..959233578f083 100644 --- a/flang/test/Lower/OpenACC/acc-data.f90 +++ b/flang/test/Lower/OpenACC/acc-data.f90 @@ -2,7 +2,7 @@ ! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s -program acc_data +subroutine acc_data real, dimension(10, 10) :: a, b, c logical :: ifCondition = .TRUE. @@ -90,5 +90,5 @@ program acc_data !CHECK: acc.terminator !CHECK-NEXT: }{{$}} -end program +end subroutine acc_data diff --git a/flang/test/Lower/OpenACC/acc-parallel.f90 b/flang/test/Lower/OpenACC/acc-parallel.f90 index 2e42ff162d13f..167526f6feff0 100644 --- a/flang/test/Lower/OpenACC/acc-parallel.f90 +++ b/flang/test/Lower/OpenACC/acc-parallel.f90 @@ -2,7 +2,7 @@ ! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s -program acc_parallel +subroutine acc_parallel integer :: i, j integer :: async = 1 @@ -240,5 +240,5 @@ program acc_parallel !CHECK: acc.yield !CHECK-NEXT: }{{$}} -end program +end subroutine acc_parallel diff --git a/flang/test/Lower/loops.f90 b/flang/test/Lower/loops.f90 index efe7b30531ce1..c861f314be008 100644 --- a/flang/test/Lower/loops.f90 +++ b/flang/test/Lower/loops.f90 @@ -1,5 +1,6 @@ ! RUN: bbc -emit-fir -o - %s | FileCheck %s +subroutine loop_test ! CHECK-DAG: fir.alloca i16 {name = "i"} ! CHECK-DAG: fir.alloca i8 {name = "k"} ! CHECK-DAG: fir.alloca i8 {name = "j"} @@ -59,4 +60,4 @@ enddo ! CHECK: fir.call @_FortranAioBeginExternalFormattedOutput print '(X,F3.1,A,I2)', x, ' -', xsum -end +end subroutine loop_test From c074c0c996c5575125d93bab89256de2df4eb50d Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 27 Oct 2020 05:50:49 -0700 Subject: [PATCH 0327/1017] Support top level directives in PFT --- flang/include/flang/Lower/PFTBuilder.h | 14 +++++++++++-- flang/lib/Lower/Bridge.cpp | 9 +++++++++ flang/lib/Lower/PFTBuilder.cpp | 27 ++++++++++++++++++++++++++ flang/test/Lower/pre-fir-tree01.f90 | 14 +++++++++++++ 4 files changed, 62 insertions(+), 2 deletions(-) diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index ca5370ecd744e..70e16f7ee0140 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -353,7 +353,7 @@ using ProgramVariant = ReferenceVariant; + parser::BlockData, parser::CompilerDirective>; /// A program is a list of program units. /// These units can be function like, module like, or block data. struct ProgramUnit : ProgramVariant { @@ -672,9 +672,19 @@ struct BlockDataUnit : public ProgramUnit { const Fortran::semantics::Scope &symTab; // symbol table }; +// Top level compiler directives +struct CompilerDirectiveUnit : public ProgramUnit { + CompilerDirectiveUnit(const parser::CompilerDirective &directive, + const ParentVariant &parentVariant) + : ProgramUnit{directive, parentVariant} {}; + CompilerDirectiveUnit(CompilerDirectiveUnit &&) = default; + CompilerDirectiveUnit(const CompilerDirectiveUnit &) = delete; +}; + /// A Program is the top-level root of the PFT. struct Program { - using Units = std::variant; + using Units = std::variant; Program() = default; Program(Program &&) = default; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index c287ee58a6be4..3fd470b0f7b19 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -169,6 +169,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); }, [&](Fortran::lower::pft::ModuleLikeUnit &m) { lowerMod(m); }, [&](Fortran::lower::pft::BlockDataUnit &b) { lowerBlockData(b); }, + [&](Fortran::lower::pft::CompilerDirectiveUnit &d) { + setCurrentPosition( + d.get().source); + mlir::emitWarning(toLocation(), + "ignoring all compiler directives"); + }, }, u); } @@ -189,6 +195,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { [&](Fortran::lower::pft::BlockDataUnit &) { // No functions defined in block data. }, + [&](Fortran::lower::pft::CompilerDirectiveUnit &) { + // No functions defined. + }, }, u); } diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 7f553c0883d9b..c054c7408a661 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -162,6 +162,19 @@ class PFTBuilder { whereBody.u); } + // CompilerDirective have special handling in case they are top level + // directives (i.e. they do not belong to a ProgramUnit). + bool Pre(const parser::CompilerDirective &directive) { + assert(parentVariantStack.size() > 0 && + "At least the Program must be a parent"); + if (parentVariantStack.back().isA()) { + addUnit(lower::pft::CompilerDirectiveUnit(directive, + parentVariantStack.back())); + return false; + } + return enterConstructOrDirective(directive); + } + private: /// Initialize a new module-like unit and make it the builder's focus. template @@ -828,6 +841,9 @@ class PFTDumper { [&](const lower::pft::ModuleLikeUnit &unit) { dumpModuleLikeUnit(outputStream, unit); }, + [&](const lower::pft::CompilerDirectiveUnit &unit) { + dumpCompilerDirectiveUnit(outputStream, unit); + }, }, unit); } @@ -944,6 +960,17 @@ class PFTDumper { outputStream << "EndContains\nEndModuleLike\n\n"; } + // Top level directives + void dumpCompilerDirectiveUnit( + llvm::raw_ostream &outputStream, + const lower::pft::CompilerDirectiveUnit &directive) { + outputStream << getNodeIndex(directive) << " "; + outputStream << "CompilerDirective: !"; + outputStream << directive.get() + .source.ToString(); + outputStream << "\nEndCompilerDirective\n\n"; + } + template std::size_t getNodeIndex(const T &node) { auto addr = static_cast(&node); diff --git a/flang/test/Lower/pre-fir-tree01.f90 b/flang/test/Lower/pre-fir-tree01.f90 index c48611441499f..81e93fdd88a46 100644 --- a/flang/test/Lower/pre-fir-tree01.f90 +++ b/flang/test/Lower/pre-fir-tree01.f90 @@ -143,6 +143,20 @@ subroutine test_directive() end subroutine ! CHECK: EndSubroutine +! Test top level directives +!DIR$ INTEGER=64 +! CHECK: CompilerDirective: +! CHECK: EndCompilerDirective + +! Test nested directive +! CHECK: Subroutine test_directive +subroutine test_directive() + !DIR$ INTEGER=64 + ! CHECK: <> + ! CHECK: <> +end subroutine +! CHECK: EndSubroutine + ! CHECK: Program ! check specification parts are not part of the PFT. ! CHECK-NOT: node From e7f3518d6a3e94c9cda9199c2a798124b6be0a7f Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Wed, 28 Oct 2020 08:32:24 -0700 Subject: [PATCH 0328/1017] Lowering assumed shape arrays Handle assumed shape array both on callee/caller sides: - Modify the call interface lowering utility to handle explicit interface, add TODOs for anything but intrinsic type assumed shape arrays. - On caller side, simply add a call to createBox in case the interface needs a box. - On callee side, the lowering of bounds is done using `fir.box_dims`, the address is obtained with `fir.box_addr` and for character the length is done using `fir.box_elesize`. Note that fir generation works as expected, but lowering to LLVM on the callee side fails due to a bad GEP generated for fir.box_dims. Assumed shape array do not require any change in the symbol map used in lowering because their shape and base address cannot change in the program unit (as opposed to allocatable/pointers that are deferred shape arrays). --- flang/lib/Lower/Bridge.cpp | 164 ++++++++++++------- flang/lib/Lower/CallInterface.cpp | 178 +++++++++++++++++---- flang/lib/Lower/ConvertExpr.cpp | 2 +- flang/test/Lower/assumed-shaped-callee.f90 | 91 +++++++++++ flang/test/Lower/assumed-shaped-caller.f90 | 53 ++++++ 5 files changed, 398 insertions(+), 90 deletions(-) create mode 100644 flang/test/Lower/assumed-shaped-callee.f90 create mode 100644 flang/test/Lower/assumed-shaped-caller.f90 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 3fd470b0f7b19..05a32973b7115 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1974,61 +1974,79 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::lower::BoxAnalyzer sba; sba.analyze(sym); + // compute extent from lower and upper bound. + auto computeExtent = [&](mlir::Value lb, mlir::Value ub) -> mlir::Value { + // let the folder deal with the common `ub - + 1` case + auto diff = builder->create(loc, idxTy, ub, lb); + auto one = builder->createIntegerConstant(loc, idxTy, 1); + return builder->create(loc, idxTy, diff, one); + }; + // The origin must be \vec{1}. - auto populateShape = [&](auto &shapes, const auto &bounds) { - for (auto *spec : bounds) { - if (auto low = spec->lbound().GetExplicit()) { - if (auto high = spec->ubound().GetExplicit()) { - Fortran::semantics::SomeExpr highEx{*high}; - auto ub = createFIRExpr(loc, &highEx); - shapes.emplace_back(builder->createConvert(loc, idxTy, ub)); - } else if (spec->ubound().isAssumed()) { - shapes.emplace_back(mlir::Value{}); - } else { - TODO("upper bound"); - } + auto populateShape = [&](auto &shapes, const auto &bounds, + mlir::Value box) { + for (auto iter : llvm::enumerate(bounds)) { + auto *spec = iter.value(); + assert(spec->lbound().GetExplicit() && + "lbound must be explicit with constant value 1"); + if (auto high = spec->ubound().GetExplicit()) { + Fortran::semantics::SomeExpr highEx{*high}; + auto ub = createFIRExpr(loc, &highEx); + shapes.emplace_back(builder->createConvert(loc, idxTy, ub)); + } else if (spec->ubound().isDeferred()) { + assert(box && "deferred bounds require a descriptor"); + auto dim = builder->createIntegerConstant(loc, idxTy, iter.index()); + auto dimInfo = builder->create(loc, idxTy, idxTy, + idxTy, box, dim); + shapes.emplace_back(dimInfo.getResult(2)); + } else if (spec->ubound().isAssumed()) { + shapes.emplace_back(mlir::Value{}); } else { - TODO("lower bound"); + llvm::report_fatal_error("unknown bound category"); } } }; - auto genLBoundsAndExtents = - [&](const Fortran::semantics::SomeExpr &lowEx, - const Fortran::semantics::SomeExpr &highEx) { - auto lb = createFIRExpr(loc, &lowEx); - auto ub = createFIRExpr(loc, &highEx); - auto ty = ub.getType(); - auto diff = builder->create(loc, ty, ub, lb); - auto one = builder->createIntegerConstant(loc, ty, 1); - auto sz = builder->create(loc, ty, diff, one); - auto idx = builder->createConvert(loc, idxTy, sz); - return std::pair{lb, idx}; - }; - // The origin is not \vec{1}. auto populateLBoundsExtents = [&](auto &lbounds, auto &extents, - const auto &bounds) { - for (auto *spec : bounds) { - if (auto low = spec->lbound().GetExplicit()) { + const auto &bounds, mlir::Value box) { + for (auto iter : llvm::enumerate(bounds)) { + auto *spec = iter.value(); + fir::BoxDimsOp dimInfo; + mlir::Value ub, lb; + if (spec->lbound().isDeferred() || spec->ubound().isDeferred()) { + assert(box && "deferred bounds require a descriptor"); + auto dim = builder->createIntegerConstant(loc, idxTy, iter.index()); + dimInfo = builder->create(loc, idxTy, idxTy, idxTy, + box, dim); + extents.emplace_back(dimInfo.getResult(2)); + if (auto low = spec->lbound().GetExplicit()) { + auto expr = Fortran::semantics::SomeExpr{*low}; + auto lb = + builder->createConvert(loc, idxTy, createFIRExpr(loc, &expr)); + lbounds.emplace_back(lb); + } else { + lbounds.emplace_back(dimInfo.getResult(1)); + } + } else { + if (auto low = spec->lbound().GetExplicit()) { + auto expr = Fortran::semantics::SomeExpr{*low}; + lb = builder->createConvert(loc, idxTy, createFIRExpr(loc, &expr)); + } else { + TODO("assumed rank lowering"); + } + if (auto high = spec->ubound().GetExplicit()) { - // let the folder deal with the common `ub - + 1` case - auto [lb, idx] = - genLBoundsAndExtents(Fortran::semantics::SomeExpr{*low}, - Fortran::semantics::SomeExpr{*high}); + auto expr = Fortran::semantics::SomeExpr{*high}; + ub = builder->createConvert(loc, idxTy, createFIRExpr(loc, &expr)); lbounds.emplace_back(lb); - extents.emplace_back(idx); - continue; - } else if (spec->ubound().isAssumed()) { + extents.emplace_back(computeExtent(lb, ub)); + } else { // An assumed size array. The extent is not computed. - Fortran::semantics::SomeExpr lowEx{*low}; - lbounds.emplace_back(createFIRExpr(loc, &lowEx)); + assert(spec->ubound().isAssumed() && "expected assumed size"); + lbounds.emplace_back(lb); extents.emplace_back(mlir::Value{}); - } else { - TODO("upper bound"); } - } else { - TODO("lower bound"); } } }; @@ -2161,12 +2179,19 @@ class FirConverter : public Fortran::lower::AbstractConverter { // cast to the known constant parts from the declaration auto castTy = builder->getRefType(genType(var)); mlir::Value addr = lookupSymbol(sym).getAddr(); - if (addr) + mlir::Value argBox; + if (addr) { + if (auto boxTy = addr.getType().dyn_cast()) { + argBox = addr; + auto refTy = builder->getRefType(boxTy.getEleTy()); + addr = builder->create(loc, refTy, argBox); + } addr = builder->createConvert(loc, castTy, addr); + } if (x.lboundAllOnes()) { // if lower bounds are all ones, build simple shaped object llvm::SmallVector shapes; - populateShape(shapes, x.bounds); + populateShape(shapes, x.bounds, argBox); if (isDummy || isResult) { localSymbols.addSymbolWithShape(sym, addr, shapes, true); return; @@ -2181,7 +2206,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // if object is an array process the lower bound and extent values llvm::SmallVector extents; llvm::SmallVector lbounds; - populateLBoundsExtents(lbounds, extents, x.bounds); + populateLBoundsExtents(lbounds, extents, x.bounds, argBox); if (isDummy || isResult) { localSymbols.addSymbolWithBounds(sym, addr, extents, lbounds, true); return; @@ -2335,12 +2360,18 @@ class FirConverter : public Fortran::lower::AbstractConverter { [&](const Fortran::lower::details::DynamicArrayStaticChar &x) { mlir::Value addr; mlir::Value len; + mlir::Value argBox; auto charLen = x.charLen(); // if element type is a CHARACTER, determine the LEN value if (isDummy || isResult) { - auto symBox = lookupSymbol(sym); - auto unboxchar = charHelp.createUnboxChar(symBox.getAddr()); - addr = unboxchar.first; + auto actualArg = lookupSymbol(sym).getAddr(); + if (auto boxTy = actualArg.getType().dyn_cast()) { + argBox = actualArg; + auto refTy = builder->getRefType(boxTy.getEleTy()); + addr = builder->create(loc, refTy, argBox); + } else { + addr = charHelp.createUnboxChar(actualArg).first; + } // Set/override LEN with a constant len = builder->createIntegerConstant(loc, idxTy, charLen); } else { @@ -2355,7 +2386,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (x.lboundAllOnes()) { // if lower bounds are all ones, build simple shaped object llvm::SmallVector shape; - populateShape(shape, x.bounds); + populateShape(shape, x.bounds, argBox); if (isDummy || isResult) { localSymbols.addCharSymbolWithShape(sym, addr, len, shape, true); return; @@ -2368,7 +2399,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // if object is an array process the lower bound and extent values llvm::SmallVector extents; llvm::SmallVector lbounds; - populateLBoundsExtents(lbounds, extents, x.bounds); + populateLBoundsExtents(lbounds, extents, x.bounds, argBox); if (isDummy || isResult) { localSymbols.addCharSymbolWithBounds(sym, addr, len, extents, lbounds, true); @@ -2390,17 +2421,32 @@ class FirConverter : public Fortran::lower::AbstractConverter { [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) { mlir::Value addr; mlir::Value len; + mlir::Value argBox; auto charLen = x.charLen(); // if element type is a CHARACTER, determine the LEN value if (isDummy || isResult) { - auto symBox = lookupSymbol(sym); - auto unboxchar = charHelp.createUnboxChar(symBox.getAddr()); - addr = unboxchar.first; - if (charLen) { - // Set/override LEN with an expression - len = createFIRExpr(loc, &*charLen); + auto actualArg = lookupSymbol(sym).getAddr(); + if (auto boxTy = actualArg.getType().dyn_cast()) { + argBox = actualArg; + auto refTy = builder->getRefType(boxTy.getEleTy()); + addr = builder->create(loc, refTy, argBox); + if (charLen) { + // Set/override LEN with an expression + len = createFIRExpr(loc, &*charLen); + } else { + // FIXME: that is not correct with kind > 1 character, we need + // to divide by the character width. + len = builder->create(loc, idxTy, argBox); + } } else { - len = unboxchar.second; + auto unboxchar = charHelp.createUnboxChar(actualArg); + addr = unboxchar.first; + if (charLen) { + // Set/override LEN with an expression + len = createFIRExpr(loc, &*charLen); + } else { + len = unboxchar.second; + } } } else { // local CHARACTER variable @@ -2417,7 +2463,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { if (x.lboundAllOnes()) { // if lower bounds are all ones, build simple shaped object llvm::SmallVector shape; - populateShape(shape, x.bounds); + populateShape(shape, x.bounds, argBox); if (isDummy || isResult) { localSymbols.addCharSymbolWithShape(sym, addr, len, shape, true); return; @@ -2430,7 +2476,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Process the lower bound and extent values. llvm::SmallVector extents; llvm::SmallVector lbounds; - populateLBoundsExtents(lbounds, extents, x.bounds); + populateLBoundsExtents(lbounds, extents, x.bounds, argBox); if (isDummy || isResult) { localSymbols.addCharSymbolWithBounds(sym, addr, len, extents, lbounds, true); diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index 86d8a3d828fb1..31f77037419f7 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -12,6 +12,7 @@ #include "flang/Lower/Bridge.h" #include "flang/Lower/FIRBuilder.h" #include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/Todo.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Semantics/symbol.h" @@ -236,7 +237,7 @@ void Fortran::lower::CallInterface::mapPassedEntities() { if constexpr (std::is_same_v) { assert(inputs.size() == func.front().getArguments().size() && "function previously created with different number of arguments"); - for (auto [fst,snd] : llvm::zip(inputs, func.front().getArguments())) + for (auto [fst, snd] : llvm::zip(inputs, func.front().getArguments())) mapBackInputToPassedEntity(fst, snd); } else { // On the caller side, map the index of the mlir argument position @@ -333,34 +334,18 @@ class Fortran::lower::CallInterfaceImpl { void buildImplicitInterface( const Fortran::evaluate::characteristics::Procedure &procedure) { // Handle result - auto resultPosition = FirPlaceHolder::resultEntityPosition; - if (const auto &result = procedure.functionResult) { - if (result->IsProcedurePointer()) // TODO - llvm_unreachable("procedure pointer result not yet handled"); - const auto *typeAndShape = result->GetTypeAndShape(); - assert(typeAndShape && "expect type for non proc pointer result"); - auto dynamicType = typeAndShape->type(); - // Character result allocated by caller and passed has hidden arguments - if (dynamicType.category() == Fortran::common::TypeCategory::Character) { - handleImplicitCharacterResult(dynamicType); - } else { - // All result other than characters are simply returned by value in - // implicit interfaces - auto mlirType = - getConverter().genType(dynamicType.category(), dynamicType.kind()); - addFirOutput(mlirType, resultPosition, Property::Value); - } - } else if (interface.side().hasAlternateReturns()) { - addFirOutput(mlir::IndexType::get(&mlirContext), resultPosition, - Property::Value); - } + if (const auto &result = procedure.functionResult) + handleImplicitResult(*result); + else if (interface.side().hasAlternateReturns()) + addFirOutput(mlir::IndexType::get(&mlirContext), + FirPlaceHolder::resultEntityPosition, Property::Value); // Handle arguments const auto &argumentEntities = getEntityContainer(interface.side().getCallDescription()); for (auto pair : llvm::zip(procedure.dummyArguments, argumentEntities)) { std::visit( Fortran::common::visitors{ - [&](const auto &dummy) { + [&](const auto &dummy) { const auto &entity = getDataObjectEntity(std::get<1>(pair)); handleImplicitDummy(dummy, entity); }, @@ -371,13 +356,66 @@ class Fortran::lower::CallInterfaceImpl { std::get<0>(pair).u); } } + void buildExplicitInterface( const Fortran::evaluate::characteristics::Procedure &procedure) { - // TODO - llvm_unreachable("Explicit interface lowering TODO"); + // Handle result + if (const auto &result = procedure.functionResult) { + if (result->CanBeReturnedViaImplicitInterface()) + handleImplicitResult(*result); + else + handleExplicitResult(*result); + } else if (interface.side().hasAlternateReturns()) { + addFirOutput(mlir::IndexType::get(&mlirContext), + FirPlaceHolder::resultEntityPosition, Property::Value); + } + // Handle arguments + const auto &argumentEntities = + getEntityContainer(interface.side().getCallDescription()); + for (auto pair : llvm::zip(procedure.dummyArguments, argumentEntities)) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::evaluate::characteristics::DummyDataObject + &dummy) { + const auto &entity = getDataObjectEntity(std::get<1>(pair)); + if (dummy.CanBePassedViaImplicitInterface()) + handleImplicitDummy(dummy, entity); + else + handleExplicitDummy(dummy, entity); + }, + [&](const Fortran::evaluate::characteristics::DummyProcedure + &dummy) { + const auto &entity = getDataObjectEntity(std::get<1>(pair)); + handleImplicitDummy(dummy, entity); + }, + [&](const Fortran::evaluate::characteristics::AlternateReturn &) { + // nothing to do + }, + }, + std::get<0>(pair).u); + } } private: + void handleImplicitResult( + const Fortran::evaluate::characteristics::FunctionResult &result) { + if (result.IsProcedurePointer()) // TODO + llvm_unreachable("procedure pointer result not yet handled"); + const auto *typeAndShape = result.GetTypeAndShape(); + assert(typeAndShape && "expect type for non proc pointer result"); + auto dynamicType = typeAndShape->type(); + // Character result allocated by caller and passed has hidden arguments + if (dynamicType.category() == Fortran::common::TypeCategory::Character) { + handleImplicitCharacterResult(dynamicType); + } else { + // All result other than characters are simply returned by value in + // implicit interfaces + auto mlirType = + getConverter().genType(dynamicType.category(), dynamicType.kind()); + addFirOutput(mlirType, FirPlaceHolder::resultEntityPosition, + Property::Value); + } + } void handleImplicitCharacterResult(const Fortran::evaluate::DynamicType &type) { auto resultPosition = FirPlaceHolder::resultEntityPosition; @@ -401,7 +439,10 @@ class Fortran::lower::CallInterfaceImpl { auto boxCharTy = fir::BoxCharType::get(&mlirContext, dynamicType.kind()); addFirInput(boxCharTy, nextPassedArgPosition(), Property::BoxChar); addPassedArg(PassEntityBy::BoxChar, entity); - // FIXME: non PDT derived type allowed here. + } else if (dynamicType.category() == + Fortran::common::TypeCategory::Derived) { + // non PDT derived type allowed in implicit interface. + TODO("derived type arguments in implicit interface"); } else { mlir::Type type = getConverter().genType(dynamicType.category(), dynamicType.kind()); @@ -415,6 +456,71 @@ class Fortran::lower::CallInterfaceImpl { } } + void handleExplicitDummy( + const Fortran::evaluate::characteristics::DummyDataObject &obj, + const FortranEntity &entity) { + using Attrs = Fortran::evaluate::characteristics::DummyDataObject::Attr; + + if (obj.attrs.test(Attrs::Allocatable)) + TODO("allocatable in procedure interface"); + else if (obj.attrs.test(Attrs::Pointer)) + TODO("pointer in procedure interface"); + + if (obj.attrs.test(Attrs::Optional)) + TODO("Optional in procedure interface"); + if (obj.attrs.test(Attrs::Asynchronous)) + TODO("Asynchronous in procedure interface"); + if (obj.attrs.test(Attrs::Contiguous)) + TODO("Contiguous in procedure interface"); + if (obj.attrs.test(Attrs::Value)) + TODO("Value in procedure interface"); + if (obj.attrs.test(Attrs::Volatile)) + TODO("Volatile in procedure interface"); + if (obj.attrs.test(Attrs::Target)) + TODO("Target in procedure interface"); + + using ShapeAttrs = Fortran::evaluate::characteristics::TypeAndShape::Attr; + const auto &shapeAttrs = obj.type.attrs(); + if (shapeAttrs.test(ShapeAttrs::AssumedRank)) + TODO("Assumed Rank in procedure interface"); + if (shapeAttrs.test(ShapeAttrs::Coarray)) + TODO("Coarray in procedure interface"); + + // So far assume that if the argument cannot be passed by implicit interface + // it must be by box. That may no be always true (e.g for simple optionals) + + auto dynamicType = obj.type.type(); + if (dynamicType.category() == Fortran::common::TypeCategory::Character) { + auto charTy = fir::CharacterType::get(&mlirContext, dynamicType.kind()); + auto len = fir::SequenceType::getUnknownExtent(); + if (auto constantLen = toInt64(dynamicType.GetCharLength())) + len = *constantLen; + fir::SequenceType::Shape shape(1, len); + auto bounds = getBounds(obj.type.shape()); + shape.append(bounds.begin(), bounds.end()); + auto seqType = fir::SequenceType::get(shape, charTy); + auto boxType = fir::BoxType::get(seqType); + addFirInput(boxType, nextPassedArgPosition(), Property::Box); + addPassedArg(PassEntityBy::Box, entity); + } else if (dynamicType.category() == + Fortran::common::TypeCategory::Derived) { + TODO("derived type arguments in procedure interface"); + } else { + mlir::Type type = + getConverter().genType(dynamicType.category(), dynamicType.kind()); + fir::SequenceType::Shape bounds = getBounds(obj.type.shape()); + if (!bounds.empty()) + type = fir::SequenceType::get(bounds, type); + auto boxType = fir::BoxType::get(type); + + // For allocatable and pointer, we will most likely want to pass + // a box reference here, but for the rest, a simple box should enforce + // the fact that the box is not re-used by the caller after the call. + addFirInput(boxType, nextPassedArgPosition(), Property::Box); + addPassedArg(PassEntityBy::Box, entity); + } + } + void handleImplicitDummy( const Fortran::evaluate::characteristics::DummyProcedure &proc, const FortranEntity &entity) { @@ -435,18 +541,30 @@ class Fortran::lower::CallInterfaceImpl { addPassedArg(PassEntityBy::BaseAddress, entity); } + void handleExplicitResult( + const Fortran::evaluate::characteristics::FunctionResult &) { + TODO("lowering interface with result requiring explicit interface"); + } + fir::SequenceType::Shape getBounds(const Fortran::evaluate::Shape &shape) { fir::SequenceType::Shape bounds; for (const auto &extent : shape) { auto bound = fir::SequenceType::getUnknownExtent(); - if (extent) - if (auto i = Fortran::evaluate::ToInt64(Fortran::evaluate::Fold( - getConverter().getFoldingContext(), AsGenericExpr(*extent)))) - bound = *i; + if (auto i = toInt64(extent)) + bound = *i; bounds.emplace_back(bound); } return bounds; } + std::optional + toInt64(std::optional< + Fortran::evaluate::Expr> + expr) { + if (expr) + return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold( + getConverter().getFoldingContext(), AsGenericExpr(*expr))); + return std::nullopt; + } void addFirInput(mlir::Type type, int entityPosition, Property p) { interface.inputs.emplace_back(FirPlaceHolder{type, entityPosition, p}); } diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 30200e8f8a53e..c7b0bc2c1a19b 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -1490,7 +1490,7 @@ class ExprLowering { }); caller.placeInput(arg, boxChar); } else if (arg.passBy == PassBy::Box) { - TODO("passing descriptor in call"); // generate emboxing if need. + caller.placeInput(arg, builder.createBox(getLoc(), argRef)); } else if (arg.passBy == PassBy::AddressAndLength) { caller.placeAddressAndLengthInput(arg, fir::getBase(argRef), fir::getLen(argRef)); diff --git a/flang/test/Lower/assumed-shaped-callee.f90 b/flang/test/Lower/assumed-shaped-callee.f90 new file mode 100644 index 0000000000000..cb24b878ea144 --- /dev/null +++ b/flang/test/Lower/assumed-shaped-callee.f90 @@ -0,0 +1,91 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test assumed shape dummy argument on callee side + +! CHECK-LABEL: func @_QPtest_assumed_shape_1(%arg0: !fir.box>) +subroutine test_assumed_shape_1(x) + integer :: x(:) + ! CHECK: %[[addr:.*]] = fir.box_addr %arg0 : (!fir.box>) -> !fir.ref> + ! CHECK: %[[c0:.*]] = constant 0 : index + ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %[[c0]] : (!fir.box>, index) -> (index, index, index) + + print *, x + ! Test extent/lower bound use in the IO statement + ! CHECK: %[[cookie:.*]] = fir.call @_FortranAioBeginExternalListOutput + ! CHECK: %[[shape:.*]] = fir.shape_shift %[[dims]]#1, %[[dims]]#2 : (index, index) -> !fir.shapeshift<1> + ! CHECK: %[[newbox:.*]] = fir.embox %[[addr]](%[[shape]]) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box> + ! CHECK: %[[castedBox:.*]] = fir.convert %[[newbox]] : (!fir.box>) -> !fir.box + ! CHECK: fir.call @_FortranAioOutputDescriptor(%[[cookie]], %[[castedBox]]) : (!fir.ref, !fir.box) -> i1 +end subroutine + +! lower bounds all ones +! CHECK-LABEL: func @_QPtest_assumed_shape_2(%arg0: !fir.box>) +subroutine test_assumed_shape_2(x) + real :: x(1:, 1:) + ! CHECK: fir.box_addr + ! CHECK: %[[dims1:.*]]:3 = fir.box_dims + ! CHECK: %[[dims2:.*]]:3 = fir.box_dims + print *, x + ! CHECK: fir.call @_FortranAioBeginExternalListOutput + ! CHECK: fir.shape %[[dims1]]#2, %[[dims2]]#2 +end subroutine + +! explicit lower bounds different from 1 +! CHECK-LABEL: func @_QPtest_assumed_shape_3(%arg0: !fir.box>) +subroutine test_assumed_shape_3(x) + integer :: x(2:, 3:, 42:) + ! CHECK: fir.box_addr + ! CHECK: fir.box_dim + ! CHECK: %[[c2_i64:.*]] = constant 2 : i64 + ! CHECK: %[[c2:.*]] = fir.convert %[[c2_i64]] : (i64) -> index + ! CHECK: fir.box_dim + ! CHECK: %[[c3_i64:.*]] = constant 3 : i64 + ! CHECK: %[[c3:.*]] = fir.convert %[[c3_i64]] : (i64) -> index + ! CHECK: fir.box_dim + ! CHECK: %[[c42_i64:.*]] = constant 42 : i64 + ! CHECK: %[[c42:.*]] = fir.convert %[[c42_i64]] : (i64) -> index + + print *, x + ! CHECK: fir.shape_shift %[[c2]], %{{.*}}, %[[c3]], %{{.*}}, %[[c42]], %{{.*}} : +end subroutine + +! Constant length +! func @_QPtest_assumed_shape_char(%arg0: !fir.box>>) +subroutine test_assumed_shape_char(c) + character(10) :: c(:) + ! CHECK: %[[addr:.*]] = fir.box_addr %arg0 : (!fir.box>>) -> !fir.ref>> + + ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %c0 : (!fir.box>>, index) -> (index, index, index) + + print *, c + ! CHECK: %[[shape:.*]] = fir.shape_shift %[[dims]]#1, %[[dims]]#2 : (index, index) -> !fir.shapeshift<1> + ! CHECK: fir.embox %[[addr]](%[[shape]]) : (!fir.ref>>, !fir.shapeshift<1>) -> !fir.box>> +end subroutine + +! Assumed length +! CHECK-LABEL: func @_QPtest_assumed_shape_char_2(%arg0: !fir.box>>) +subroutine test_assumed_shape_char_2(c) + character(*) :: c(:) + ! CHECK: %[[addr:.*]] = fir.box_addr %arg0 : (!fir.box>>) -> !fir.ref>> + ! CHECK: %[[len:.*]] = fir.box_elesize %arg0 : (!fir.box>>) -> index + + ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %c0 : (!fir.box>>, index) -> (index, index, index) + + print *, c + ! CHECK: %[[shape:.*]] = fir.shape_shift %[[dims]]#1, %[[dims]]#2 : (index, index) -> !fir.shapeshift<1> + ! CHECK: fir.embox %[[addr]](%[[shape]]) typeparams %[[len]] : (!fir.ref>>, !fir.shapeshift<1>, index) -> !fir.box>> +end subroutine + + +! lower bounds all 1. +! CHECK: func @_QPtest_assumed_shape_char_3(%arg0: !fir.box>>) +subroutine test_assumed_shape_char_3(c) + character(*) :: c(1:, 1:) + ! CHECK: fir.box_addr + ! CHECK: fir.box_elesize + ! CHECK: %[[dims1:.*]]:3 = fir.box_dims + ! CHECK: %[[dims2:.*]]:3 = fir.box_dims + print *, c + ! CHECK: fir.call @_FortranAioBeginExternalListOutput + ! CHECK: fir.shape %[[dims1]]#2, %[[dims2]]#2 +end subroutine diff --git a/flang/test/Lower/assumed-shaped-caller.f90 b/flang/test/Lower/assumed-shaped-caller.f90 new file mode 100644 index 0000000000000..e2ac5b3896d43 --- /dev/null +++ b/flang/test/Lower/assumed-shaped-caller.f90 @@ -0,0 +1,53 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test passing arrays to assumed shape dummy arguments + +! CHECK-LABEL: func @_QPfoo() +subroutine foo() + interface + subroutine bar(x) + ! lbounds are meaningless on caller side, some are added + ! here to check they are ignored. + real :: x(1:, 10:, :) + end subroutine + end interface + real :: x(42, 55, 12) + ! CHECK-DAG: %[[c42:.*]] = constant 42 : index + ! CHECK-DAG: %[[c55:.*]] = constant 55 : index + ! CHECK-DAG: %[[c12:.*]] = constant 12 : index + ! CHECK-DAG: %[[addr:.*]] = fir.alloca !fir.array<42x55x12xf32> {name = "_QFfooEx"} + + call bar(x) + ! CHECK: %[[shape:.*]] = fir.shape %[[c42]], %[[c55]], %[[c12]] : (index, index, index) -> !fir.shape<3> + ! CHECK: %[[embox:.*]] = fir.embox %[[addr]](%[[shape]]) : (!fir.ref>, !fir.shape<3>) -> !fir.box> + ! CHECK: %[[castedBox:.*]] = fir.convert %[[embox]] : (!fir.box>) -> !fir.box> + ! CHECK: fir.call @_QPbar(%[[castedBox]]) : (!fir.box>) -> () +end subroutine + + +! Test passing character array as assumed shape. +! CHECK-LABEL: func @_QPfoo_char(%arg0: !fir.boxchar<1>) +subroutine foo_char(x) + interface + subroutine bar_char(x) + character(*) :: x(1:, 10:, :) + end subroutine + end interface + character(*) :: x(42, 55, 12) + ! CHECK-DAG: %[[x:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK-DAG: %[[addr:.*]] = fir.convert %[[x]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK-DAG: %[[c42:.*]] = constant 42 : index + ! CHECK-DAG: %[[c55:.*]] = constant 55 : index + ! CHECK-DAG: %[[c12:.*]] = constant 12 : index + + call bar_char(x) + ! CHECK: %[[shape:.*]] = fir.shape %[[c42]], %[[c55]], %[[c12]] : (index, index, index) -> !fir.shape<3> + ! CHECK: %[[embox:.*]] = fir.embox %[[addr]](%[[shape]]) typeparams %[[x]]#1 : (!fir.ref>>, !fir.shape<3>, index) -> !fir.box>> + ! CHECK: %[[castedBox:.*]] = fir.convert %[[embox]] : (!fir.box>>) -> !fir.box>> + ! CHECK: fir.call @_QPbar_char(%[[castedBox]]) : (!fir.box>>) -> () +end subroutine + +! Test external function declarations + +! CHECK: func @_QPbar(!fir.box>) +! CHECK: func @_QPbar_char(!fir.box>>) From d5d38046d4da22df692fa62bd2df5335cf35bdce Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Tue, 27 Oct 2020 15:26:52 -0400 Subject: [PATCH 0329/1017] [flang][openacc] Lower exit data directive --- flang/test/Lower/OpenACC/acc-exit-data.f90 | 64 ++++++++++++++++++++++ 1 file changed, 64 insertions(+) create mode 100644 flang/test/Lower/OpenACC/acc-exit-data.f90 diff --git a/flang/test/Lower/OpenACC/acc-exit-data.f90 b/flang/test/Lower/OpenACC/acc-exit-data.f90 new file mode 100644 index 0000000000000..01bbafb048870 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-exit-data.f90 @@ -0,0 +1,64 @@ +! This test checks lowering of OpenACC exit data directive. + +! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s + +subroutine acc_exit_data + integer :: async = 1 + real, dimension(10, 10) :: a, b, c + logical :: ifCondition = .TRUE. + +!CHECK: [[A:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Ea"} +!CHECK: [[B:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Eb"} +!CHECK: [[C:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Ec"} + + !$acc exit data delete(a) +!CHECK: acc.exit_data delete([[A]] : !fir.ref>){{$}} + + !$acc exit data delete(a) if(.true.) +!CHECK: [[IF1:%.*]] = constant true +!CHECK: acc.exit_data if([[IF1]]) delete([[A]] : !fir.ref>){{$}} + + !$acc exit data delete(a) if(ifCondition) +!CHECK: [[IFCOND:%.*]] = fir.load %{{.*}} : !fir.ref> +!CHECK: [[IF2:%.*]] = fir.convert [[IFCOND]] : (!fir.logical<4>) -> i1 +!CHECK: acc.exit_data if([[IF2]]) delete([[A]] : !fir.ref>){{$}} + + !$acc exit data delete(a) delete(b) delete(c) +!CHECK: acc.exit_data delete([[A]], [[B]], [[C]] : !fir.ref>, !fir.ref>, !fir.ref>){{$}} + + !$acc exit data copyout(a) delete(b) detach(c) +!CHECK: acc.exit_data copyout([[A]] : !fir.ref>) delete([[B]] : !fir.ref>) detach([[C]] : !fir.ref>){{$}} + + !$acc exit data delete(a) async +!CHECK: acc.exit_data delete([[A]] : !fir.ref>) attributes {async} + + !$acc exit data delete(a) wait +!CHECK: acc.exit_data delete([[A]] : !fir.ref>) attributes {wait} + + !$acc exit data delete(a) async wait +!CHECK: acc.exit_data delete([[A]] : !fir.ref>) attributes {async, wait} + + !$acc exit data delete(a) async(1) +!CHECK: [[ASYNC1:%.*]] = constant 1 : i32 +!CHECK: acc.exit_data async([[ASYNC1]] : i32) delete([[A]] : !fir.ref>) + + !$acc exit data delete(a) async(async) +!CHECK: [[ASYNC2:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: acc.exit_data async([[ASYNC2]] : i32) delete([[A]] : !fir.ref>) + + !$acc exit data delete(a) wait(1) +!CHECK: [[WAIT1:%.*]] = constant 1 : i32 +!CHECK: acc.exit_data wait([[WAIT1]] : i32) delete([[A]] : !fir.ref>) + + !$acc exit data delete(a) wait(queues: 1, 2) +!CHECK: [[WAIT2:%.*]] = constant 1 : i32 +!CHECK: [[WAIT3:%.*]] = constant 2 : i32 +!CHECK: acc.exit_data wait([[WAIT2]], [[WAIT3]] : i32, i32) delete([[A]] : !fir.ref>) + + !$acc exit data delete(a) wait(devnum: 1: queues: 1, 2) +!CHECK: [[WAIT4:%.*]] = constant 1 : i32 +!CHECK: [[WAIT5:%.*]] = constant 2 : i32 +!CHECK: [[WAIT6:%.*]] = constant 1 : i32 +!CHECK: acc.exit_data wait_devnum([[WAIT6]] : i32) wait([[WAIT4]], [[WAIT5]] : i32, i32) delete([[A]] : !fir.ref>) + +end subroutine acc_exit_data \ No newline at end of file From f9158db50c017e310071c3ebcd1ba19c15f30d30 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Tue, 27 Oct 2020 15:05:29 -0400 Subject: [PATCH 0330/1017] [flang][openacc] Lower enter data directive --- flang/test/Lower/OpenACC/acc-enter-data.f90 | 67 +++++++++++++++++++++ 1 file changed, 67 insertions(+) create mode 100644 flang/test/Lower/OpenACC/acc-enter-data.f90 diff --git a/flang/test/Lower/OpenACC/acc-enter-data.f90 b/flang/test/Lower/OpenACC/acc-enter-data.f90 new file mode 100644 index 0000000000000..f8e9a62d84a8e --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-enter-data.f90 @@ -0,0 +1,67 @@ +! This test checks lowering of OpenACC enter data directive. + +! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s + +subroutine acc_enter_data + integer :: async = 1 + real, dimension(10, 10) :: a, b, c + logical :: ifCondition = .TRUE. + +!CHECK: [[A:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Ea"} +!CHECK: [[B:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Eb"} +!CHECK: [[C:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Ec"} + + !$acc enter data create(a) +!CHECK: acc.enter_data create([[A]] : !fir.ref>){{$}} + + !$acc enter data create(a) if(.true.) +!CHECK: [[IF1:%.*]] = constant true +!CHECK: acc.enter_data if([[IF1]]) create([[A]] : !fir.ref>){{$}} + + !$acc enter data create(a) if(ifCondition) +!CHECK: [[IFCOND:%.*]] = fir.load %{{.*}} : !fir.ref> +!CHECK: [[IF2:%.*]] = fir.convert [[IFCOND]] : (!fir.logical<4>) -> i1 +!CHECK: acc.enter_data if([[IF2]]) create([[A]] : !fir.ref>){{$}} + + !$acc enter data create(a) create(b) create(c) +!CHECK: acc.enter_data create([[A]], [[B]], [[C]] : !fir.ref>, !fir.ref>, !fir.ref>){{$}} + + !$acc enter data create(a) create(b) create(zero: c) +!CHECK: acc.enter_data create([[A]], [[B]] : !fir.ref>, !fir.ref>) create_zero([[C]] : !fir.ref>){{$}} + + !$acc enter data copyin(a) create(b) attach(c) +!CHECK: acc.enter_data copyin([[A]] : !fir.ref>) create([[B]] : !fir.ref>) attach([[C]] : !fir.ref>){{$}} + + !$acc enter data create(a) async +!CHECK: acc.enter_data create([[A]] : !fir.ref>) attributes {async} + + !$acc enter data create(a) wait +!CHECK: acc.enter_data create([[A]] : !fir.ref>) attributes {wait} + + !$acc enter data create(a) async wait +!CHECK: acc.enter_data create([[A]] : !fir.ref>) attributes {async, wait} + + !$acc enter data create(a) async(1) +!CHECK: [[ASYNC1:%.*]] = constant 1 : i32 +!CHECK: acc.enter_data async([[ASYNC1]] : i32) create([[A]] : !fir.ref>) + + !$acc enter data create(a) async(async) +!CHECK: [[ASYNC2:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: acc.enter_data async([[ASYNC2]] : i32) create([[A]] : !fir.ref>) + + !$acc enter data create(a) wait(1) +!CHECK: [[WAIT1:%.*]] = constant 1 : i32 +!CHECK: acc.enter_data wait([[WAIT1]] : i32) create([[A]] : !fir.ref>) + + !$acc enter data create(a) wait(queues: 1, 2) +!CHECK: [[WAIT2:%.*]] = constant 1 : i32 +!CHECK: [[WAIT3:%.*]] = constant 2 : i32 +!CHECK: acc.enter_data wait([[WAIT2]], [[WAIT3]] : i32, i32) create([[A]] : !fir.ref>) + + !$acc enter data create(a) wait(devnum: 1: queues: 1, 2) +!CHECK: [[WAIT4:%.*]] = constant 1 : i32 +!CHECK: [[WAIT5:%.*]] = constant 2 : i32 +!CHECK: [[WAIT6:%.*]] = constant 1 : i32 +!CHECK: acc.enter_data wait_devnum([[WAIT6]] : i32) wait([[WAIT4]], [[WAIT5]] : i32, i32) create([[A]] : !fir.ref>) + +end subroutine acc_enter_data From f41660e5a951319b1bd00c51e40f50354533f75a Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Tue, 27 Oct 2020 20:43:12 -0400 Subject: [PATCH 0331/1017] [flang][openacc] Lower update directive --- flang/lib/Lower/OpenACC.cpp | 79 +++++++++++++++++++++++++ flang/test/Lower/OpenACC/acc-update.f90 | 55 +++++++++++++++++ 2 files changed, 134 insertions(+) create mode 100644 flang/test/Lower/OpenACC/acc-update.f90 diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp index 49bccc1d46c6e..bdefc3200527e 100644 --- a/flang/lib/Lower/OpenACC.cpp +++ b/flang/lib/Lower/OpenACC.cpp @@ -892,6 +892,85 @@ genACCUpdateOp(Fortran::lower::AbstractConverter &converter, updateOp.ifPresentAttr(firOpBuilder.getUnitAttr()); } +static void +genACCUpdateOp(Fortran::lower::AbstractConverter &converter, + const Fortran::parser::AccClauseList &accClauseList) { + mlir::Value ifCond, async, waitDevnum; + SmallVector hostOperands, deviceOperands, waitOperands; + + // Async and wait clause have optional values but can be present with + // no value as well. When there is no value, the op has an attribute to + // represent the clause. + bool addAsyncAttr = false; + bool addWaitAttr = false; + bool addIfPresentAttr = false; + + auto &firOpBuilder = converter.getFirOpBuilder(); + auto currentLocation = converter.getCurrentLocation(); + + // Lower clauses values mapped to operands. + // Keep track of each group of operands separatly as clauses can appear + // more than once. + for (const auto &clause : accClauseList.v) { + if (const auto *asyncClause = + std::get_if(&clause.u)) { + const auto &asyncClauseValue = asyncClause->v; + if (asyncClauseValue) { // async has a value. + async = fir::getBase(converter.genExprValue( + *Fortran::semantics::GetExpr(*asyncClauseValue))); + } else { + addAsyncAttr = true; + } + } else if (const auto *waitClause = + std::get_if(&clause.u)) { + const auto &waitClauseValue = waitClause->v; + if (waitClauseValue) { // wait has a value. + const Fortran::parser::AccWaitArgument &waitArg = *waitClauseValue; + const std::list &waitList = + std::get>(waitArg.t); + for (const Fortran::parser::ScalarIntExpr &value : waitList) { + mlir::Value v = fir::getBase( + converter.genExprValue(*Fortran::semantics::GetExpr(value))); + waitOperands.push_back(v); + } + + const std::optional &waitDevnumValue = + std::get>(waitArg.t); + if (waitDevnumValue) + waitDevnum = fir::getBase(converter.genExprValue( + *Fortran::semantics::GetExpr(*waitDevnumValue))); + } else { + addWaitAttr = true; + } + } else if (const auto *hostClause = + std::get_if(&clause.u)) { + genObjectList(hostClause->v, converter, hostOperands); + } else if (const auto *deviceClause = + std::get_if(&clause.u)) { + genObjectList(deviceClause->v, converter, deviceOperands); + } + } + + // Prepare the operand segement size attribute and the operands value range. + SmallVector operands; + SmallVector operandSegments; + addOperand(operands, operandSegments, async); + addOperand(operands, operandSegments, waitDevnum); + addOperands(operands, operandSegments, waitOperands); + addOperands(operands, operandSegments, hostOperands); + addOperands(operands, operandSegments, deviceOperands); + + auto updateOp = createSimpleOp( + firOpBuilder, currentLocation, operands, operandSegments); + + if (addAsyncAttr) + updateOp.asyncAttr(firOpBuilder.getUnitAttr()); + if (addWaitAttr) + updateOp.waitAttr(firOpBuilder.getUnitAttr()); + if (addIfPresentAttr) + updateOp.ifPresentAttr(firOpBuilder.getUnitAttr()); +} + static void genACC(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, diff --git a/flang/test/Lower/OpenACC/acc-update.f90 b/flang/test/Lower/OpenACC/acc-update.f90 new file mode 100644 index 0000000000000..1a3acaff34876 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-update.f90 @@ -0,0 +1,55 @@ +! This test checks lowering of OpenACC update directive. + +! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s + +subroutine acc_update + integer :: async = 1 + real, dimension(10, 10) :: a, b, c + logical :: ifCondition = .TRUE. + +!CHECK: [[A:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Ea"} +!CHECK: [[B:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Eb"} +!CHECK: [[C:%.*]] = fir.alloca !fir.array<10x10xf32> {name = "{{.*}}Ec"} + + !$acc update host(a) +!CHECK: acc.update host([[A]] : !fir.ref>){{$}} + + !$acc update host(a) host(b) host(c) +!CHECK: acc.update host([[A]], [[B]], [[C]] : !fir.ref>, !fir.ref>, !fir.ref>){{$}} + + !$acc update host(a) host(b) device(c) +!CHECK: acc.update host([[A]], [[B]] : !fir.ref>, !fir.ref>) device([[C]] : !fir.ref>){{$}} + + !$acc update host(a) async +!CHECK: acc.update host([[A]] : !fir.ref>) attributes {async} + + !$acc update host(a) wait +!CHECK: acc.update host([[A]] : !fir.ref>) attributes {wait} + + !$acc update host(a) async wait +!CHECK: acc.update host([[A]] : !fir.ref>) attributes {async, wait} + + !$acc update host(a) async(1) +!CHECK: [[ASYNC1:%.*]] = constant 1 : i32 +!CHECK: acc.update async([[ASYNC1]] : i32) host([[A]] : !fir.ref>) + + !$acc update host(a) async(async) +!CHECK: [[ASYNC2:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: acc.update async([[ASYNC2]] : i32) host([[A]] : !fir.ref>) + + !$acc update host(a) wait(1) +!CHECK: [[WAIT1:%.*]] = constant 1 : i32 +!CHECK: acc.update wait([[WAIT1]] : i32) host([[A]] : !fir.ref>) + + !$acc update host(a) wait(queues: 1, 2) +!CHECK: [[WAIT2:%.*]] = constant 1 : i32 +!CHECK: [[WAIT3:%.*]] = constant 2 : i32 +!CHECK: acc.update wait([[WAIT2]], [[WAIT3]] : i32, i32) host([[A]] : !fir.ref>) + + !$acc update host(a) wait(devnum: 1: queues: 1, 2) +!CHECK: [[WAIT4:%.*]] = constant 1 : i32 +!CHECK: [[WAIT5:%.*]] = constant 2 : i32 +!CHECK: [[WAIT6:%.*]] = constant 1 : i32 +!CHECK: acc.update wait_devnum([[WAIT6]] : i32) wait([[WAIT4]], [[WAIT5]] : i32, i32) host([[A]] : !fir.ref>) + +end subroutine acc_update \ No newline at end of file From 06300a21ea3b03697d01af45e02efd7c87d80e12 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 29 Oct 2020 06:28:44 -0700 Subject: [PATCH 0332/1017] Get assumed Shape working end-to-end - Always reflect rank when lowering fir.box type to its llvm type (make the dimension array explicit). This is needed to use the LLVM GEP when lowering fir.box_dims on callee side. - Fix my own incompetence of getting bad indexes for lower_bound and extent (1 and 2 instead of 0 and 1). - The front-end is not making implicit assumed shape lower bounds explicit (to 1) but is labeling as deferred. Due to this, the code was taking the lower bound of the descriptor instead of of 1. Workaround this for now, when we lower allocatable and pointer, we will want either to update the front-end to make assumed shape lower bound explicit or to handle this better in lowering. - Align lit tests With this patch, assumed shape associated with contiguous intrinsic variable are compiling OK end to end. --- flang/lib/Lower/Bridge.cpp | 10 ++++++--- flang/lib/Optimizer/CodeGen/TypeConverter.h | 23 ++++++++++++++++++++- flang/test/Fir/box.fir | 8 +++---- flang/test/Lower/assumed-shaped-callee.f90 | 13 +++++++----- 4 files changed, 41 insertions(+), 13 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 05a32973b7115..5c52b838ccc1b 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1998,7 +1998,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto dim = builder->createIntegerConstant(loc, idxTy, iter.index()); auto dimInfo = builder->create(loc, idxTy, idxTy, idxTy, box, dim); - shapes.emplace_back(dimInfo.getResult(2)); + shapes.emplace_back(dimInfo.getResult(1)); } else if (spec->ubound().isAssumed()) { shapes.emplace_back(mlir::Value{}); } else { @@ -2019,14 +2019,18 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto dim = builder->createIntegerConstant(loc, idxTy, iter.index()); dimInfo = builder->create(loc, idxTy, idxTy, idxTy, box, dim); - extents.emplace_back(dimInfo.getResult(2)); + extents.emplace_back(dimInfo.getResult(1)); if (auto low = spec->lbound().GetExplicit()) { auto expr = Fortran::semantics::SomeExpr{*low}; auto lb = builder->createConvert(loc, idxTy, createFIRExpr(loc, &expr)); lbounds.emplace_back(lb); } else { - lbounds.emplace_back(dimInfo.getResult(1)); + // FIXME: The front-end is not setting up the implicit lower + // bounds to 1 for assumed shape array. Do this here for now, + // but that is absolutely wrong for allocatable and pointers. + // lbounds.emplace_back(dimInfo.getResult(0)); + lbounds.emplace_back(builder->createIntegerConstant(loc, idxTy, 1)); } } else { if (auto low = spec->lbound().GetExplicit()) { diff --git a/flang/lib/Optimizer/CodeGen/TypeConverter.h b/flang/lib/Optimizer/CodeGen/TypeConverter.h index c8c144b08e844..41614d42090d9 100644 --- a/flang/lib/Optimizer/CodeGen/TypeConverter.h +++ b/flang/lib/Optimizer/CodeGen/TypeConverter.h @@ -123,9 +123,12 @@ class LLVMTypeConverter : public mlir::LLVMTypeConverter { // TODO bool requiresExtendedDesc() { return false; } + // Magic value to indicate we do not know the rank of an entity, either + // because it is assumed rank or because we have not determined it yet. + static constexpr int unknownRank() { return -1; } // This corresponds to the descriptor as defined ISO_Fortran_binding.h and the // addendum defined in descriptor.h. - mlir::LLVM::LLVMType convertBoxType(BoxType box, int rank = -1) { + mlir::LLVM::LLVMType convertBoxType(BoxType box, int rank = unknownRank()) { // (buffer*, ele-size, rank, type-descriptor, attribute, [dims]) SmallVector parts; mlir::Type ele = box.getEleTy(); @@ -141,6 +144,24 @@ class LLVMTypeConverter : public mlir::LLVMTypeConverter { parts.push_back(getDescFieldTypeModel<4>()(&getContext())); parts.push_back(getDescFieldTypeModel<5>()(&getContext())); parts.push_back(getDescFieldTypeModel<6>()(&getContext())); + if (rank == unknownRank()) { + if (auto seqTy = ele.dyn_cast()) { + if (seqTy.getEleTy().isa()) { + auto dim = seqTy.getDimension(); + if (dim == 0) { + emitError(UnknownLoc::get(&getContext())) + << "missing length in character sequence type :" << eleTy; + rank = 0; + } else { + rank = dim - 1; + } + } else { + rank = seqTy.getDimension(); + } + } else { + rank = 0; + } + } if (rank > 0) { auto rowTy = getDescFieldTypeModel<7>()(&getContext()); parts.push_back(mlir::LLVM::LLVMType::getArrayTy(rowTy, rank)); diff --git a/flang/test/Fir/box.fir b/flang/test/Fir/box.fir index 5438407a8446b..6749edb8c5a21 100644 --- a/flang/test/Fir/box.fir +++ b/flang/test/Fir/box.fir @@ -2,7 +2,7 @@ // CHECK-LABEL: declare void @g({ float*, i64, i32, i8, i8, i8, i8 }*) func @g(%b : !fir.box) -// CHECK-LABEL: declare void @ga({ float*, i64, i32, i8, i8, i8, i8 }*) +// CHECK-LABEL: declare void @ga({ float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }*) func @ga(%b : !fir.box>) // CHECK-LABEL: define void @f @@ -62,7 +62,7 @@ func @b1(%arg0 : !fir.ref>>, %arg1 : index) -> !fir.bo } // Boxing of a dynamic array of character with static length (5) -// CHECK-LABEL: define { [5 x i8]*, i64, i32, i8, i8, i8, i8 }* @b2( +// CHECK-LABEL: define { [5 x i8]*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* @b2( // CHECK-SAME: [5 x i8]* %[[arg0:.*]], i64 %[[arg1:.*]]) func @b2(%arg0 : !fir.ref>>, %arg1 : index) -> !fir.box>> { %1 = fir.shape %arg1 : (index) -> !fir.shape<1> @@ -76,7 +76,7 @@ func @b2(%arg0 : !fir.ref>>, %arg1 : index) -> !fir. } // Boxing of a dynamic array of character of dynamic length -// CHECK-LABEL: define { i8*, i64, i32, i8, i8, i8, i8 }* @b3( +// CHECK-LABEL: define { i8*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* @b3( // CHECK-SAME: i8* %[[arg0:.*]], i64 %[[arg1:.*]], i64 %[[arg2:.*]]) func @b3(%arg0 : !fir.ref>>, %arg1 : index, %arg2 : index) -> !fir.box>> { %1 = fir.shape %arg2 : (index) -> !fir.shape<1> @@ -90,7 +90,7 @@ func @b3(%arg0 : !fir.ref>>, %arg1 : index, %arg2 : } // Boxing of a static array of character of dynamic length -// CHECK-LABEL: define { i8*, i64, i32, i8, i8, i8, i8 }* @b4( +// CHECK-LABEL: define { i8*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* @b4( // CHECK-SAME: i8* %[[arg0:.*]], i64 %[[arg1:.*]]) func @b4(%arg0 : !fir.ref>>, %arg1 : index) -> !fir.box>> { %c_7 = constant 7 : index diff --git a/flang/test/Lower/assumed-shaped-callee.f90 b/flang/test/Lower/assumed-shaped-callee.f90 index cb24b878ea144..ec35c2bc9f665 100644 --- a/flang/test/Lower/assumed-shaped-callee.f90 +++ b/flang/test/Lower/assumed-shaped-callee.f90 @@ -8,11 +8,12 @@ subroutine test_assumed_shape_1(x) ! CHECK: %[[addr:.*]] = fir.box_addr %arg0 : (!fir.box>) -> !fir.ref> ! CHECK: %[[c0:.*]] = constant 0 : index ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %[[c0]] : (!fir.box>, index) -> (index, index, index) + ! CHECK: %[[c1:.*]] = constant 1 : index print *, x ! Test extent/lower bound use in the IO statement ! CHECK: %[[cookie:.*]] = fir.call @_FortranAioBeginExternalListOutput - ! CHECK: %[[shape:.*]] = fir.shape_shift %[[dims]]#1, %[[dims]]#2 : (index, index) -> !fir.shapeshift<1> + ! CHECK: %[[shape:.*]] = fir.shape_shift %[[c1]], %[[dims]]#1 : (index, index) -> !fir.shapeshift<1> ! CHECK: %[[newbox:.*]] = fir.embox %[[addr]](%[[shape]]) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box> ! CHECK: %[[castedBox:.*]] = fir.convert %[[newbox]] : (!fir.box>) -> !fir.box ! CHECK: fir.call @_FortranAioOutputDescriptor(%[[cookie]], %[[castedBox]]) : (!fir.ref, !fir.box) -> i1 @@ -27,7 +28,7 @@ subroutine test_assumed_shape_2(x) ! CHECK: %[[dims2:.*]]:3 = fir.box_dims print *, x ! CHECK: fir.call @_FortranAioBeginExternalListOutput - ! CHECK: fir.shape %[[dims1]]#2, %[[dims2]]#2 + ! CHECK: fir.shape %[[dims1]]#1, %[[dims2]]#1 end subroutine ! explicit lower bounds different from 1 @@ -56,9 +57,10 @@ subroutine test_assumed_shape_char(c) ! CHECK: %[[addr:.*]] = fir.box_addr %arg0 : (!fir.box>>) -> !fir.ref>> ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %c0 : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[c1:.*]] = constant 1 : index print *, c - ! CHECK: %[[shape:.*]] = fir.shape_shift %[[dims]]#1, %[[dims]]#2 : (index, index) -> !fir.shapeshift<1> + ! CHECK: %[[shape:.*]] = fir.shape_shift %[[c1]], %[[dims]]#1 : (index, index) -> !fir.shapeshift<1> ! CHECK: fir.embox %[[addr]](%[[shape]]) : (!fir.ref>>, !fir.shapeshift<1>) -> !fir.box>> end subroutine @@ -70,9 +72,10 @@ subroutine test_assumed_shape_char_2(c) ! CHECK: %[[len:.*]] = fir.box_elesize %arg0 : (!fir.box>>) -> index ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %c0 : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[c1:.*]] = constant 1 : index print *, c - ! CHECK: %[[shape:.*]] = fir.shape_shift %[[dims]]#1, %[[dims]]#2 : (index, index) -> !fir.shapeshift<1> + ! CHECK: %[[shape:.*]] = fir.shape_shift %[[c1]], %[[dims]]#1 : (index, index) -> !fir.shapeshift<1> ! CHECK: fir.embox %[[addr]](%[[shape]]) typeparams %[[len]] : (!fir.ref>>, !fir.shapeshift<1>, index) -> !fir.box>> end subroutine @@ -87,5 +90,5 @@ subroutine test_assumed_shape_char_3(c) ! CHECK: %[[dims2:.*]]:3 = fir.box_dims print *, c ! CHECK: fir.call @_FortranAioBeginExternalListOutput - ! CHECK: fir.shape %[[dims1]]#2, %[[dims2]]#2 + ! CHECK: fir.shape %[[dims1]]#1, %[[dims2]]#1 end subroutine From d696f30c28c91eb6e9df71d5d701760b4dad84b0 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Wed, 28 Oct 2020 11:45:57 -0400 Subject: [PATCH 0333/1017] [flang][openacc] Lower init and shutdown directive --- flang/lib/Lower/OpenACC.cpp | 79 ----------------------- flang/test/Lower/OpenACC/acc-init.f90 | 30 +++++++++ flang/test/Lower/OpenACC/acc-shutdown.f90 | 30 +++++++++ 3 files changed, 60 insertions(+), 79 deletions(-) create mode 100644 flang/test/Lower/OpenACC/acc-init.f90 create mode 100644 flang/test/Lower/OpenACC/acc-shutdown.f90 diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp index bdefc3200527e..49bccc1d46c6e 100644 --- a/flang/lib/Lower/OpenACC.cpp +++ b/flang/lib/Lower/OpenACC.cpp @@ -892,85 +892,6 @@ genACCUpdateOp(Fortran::lower::AbstractConverter &converter, updateOp.ifPresentAttr(firOpBuilder.getUnitAttr()); } -static void -genACCUpdateOp(Fortran::lower::AbstractConverter &converter, - const Fortran::parser::AccClauseList &accClauseList) { - mlir::Value ifCond, async, waitDevnum; - SmallVector hostOperands, deviceOperands, waitOperands; - - // Async and wait clause have optional values but can be present with - // no value as well. When there is no value, the op has an attribute to - // represent the clause. - bool addAsyncAttr = false; - bool addWaitAttr = false; - bool addIfPresentAttr = false; - - auto &firOpBuilder = converter.getFirOpBuilder(); - auto currentLocation = converter.getCurrentLocation(); - - // Lower clauses values mapped to operands. - // Keep track of each group of operands separatly as clauses can appear - // more than once. - for (const auto &clause : accClauseList.v) { - if (const auto *asyncClause = - std::get_if(&clause.u)) { - const auto &asyncClauseValue = asyncClause->v; - if (asyncClauseValue) { // async has a value. - async = fir::getBase(converter.genExprValue( - *Fortran::semantics::GetExpr(*asyncClauseValue))); - } else { - addAsyncAttr = true; - } - } else if (const auto *waitClause = - std::get_if(&clause.u)) { - const auto &waitClauseValue = waitClause->v; - if (waitClauseValue) { // wait has a value. - const Fortran::parser::AccWaitArgument &waitArg = *waitClauseValue; - const std::list &waitList = - std::get>(waitArg.t); - for (const Fortran::parser::ScalarIntExpr &value : waitList) { - mlir::Value v = fir::getBase( - converter.genExprValue(*Fortran::semantics::GetExpr(value))); - waitOperands.push_back(v); - } - - const std::optional &waitDevnumValue = - std::get>(waitArg.t); - if (waitDevnumValue) - waitDevnum = fir::getBase(converter.genExprValue( - *Fortran::semantics::GetExpr(*waitDevnumValue))); - } else { - addWaitAttr = true; - } - } else if (const auto *hostClause = - std::get_if(&clause.u)) { - genObjectList(hostClause->v, converter, hostOperands); - } else if (const auto *deviceClause = - std::get_if(&clause.u)) { - genObjectList(deviceClause->v, converter, deviceOperands); - } - } - - // Prepare the operand segement size attribute and the operands value range. - SmallVector operands; - SmallVector operandSegments; - addOperand(operands, operandSegments, async); - addOperand(operands, operandSegments, waitDevnum); - addOperands(operands, operandSegments, waitOperands); - addOperands(operands, operandSegments, hostOperands); - addOperands(operands, operandSegments, deviceOperands); - - auto updateOp = createSimpleOp( - firOpBuilder, currentLocation, operands, operandSegments); - - if (addAsyncAttr) - updateOp.asyncAttr(firOpBuilder.getUnitAttr()); - if (addWaitAttr) - updateOp.waitAttr(firOpBuilder.getUnitAttr()); - if (addIfPresentAttr) - updateOp.ifPresentAttr(firOpBuilder.getUnitAttr()); -} - static void genACC(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, diff --git a/flang/test/Lower/OpenACC/acc-init.f90 b/flang/test/Lower/OpenACC/acc-init.f90 new file mode 100644 index 0000000000000..9b1574eab357f --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-init.f90 @@ -0,0 +1,30 @@ +! This test checks lowering of OpenACC init directive. + +! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s + +subroutine acc_init + logical :: ifCondition = .TRUE. + + !$acc init +!CHECK: acc.init{{$}} + + !$acc init if(.true.) +!CHECK: [[IF1:%.*]] = constant true +!CHECK: acc.init if([[IF1]]){{$}} + + !$acc init if(ifCondition) +!CHECK: [[IFCOND:%.*]] = fir.load %{{.*}} : !fir.ref> +!CHECK: [[IF2:%.*]] = fir.convert [[IFCOND]] : (!fir.logical<4>) -> i1 +!CHECK: acc.init if([[IF2]]){{$}} + + !$acc init device_num(1) +!CHECK: [[DEVNUM:%.*]] = constant 1 : i32 +!CHECK: acc.init device_num([[DEVNUM]] : i32){{$}} + + !$acc init device_num(1) device_type(1, 2) +!CHECK: [[DEVNUM:%.*]] = constant 1 : i32 +!CHECK: [[DEVTYPE1:%.*]] = constant 1 : i32 +!CHECK: [[DEVTYPE2:%.*]] = constant 2 : i32 +!CHECK: acc.init device_type([[DEVTYPE1]], [[DEVTYPE2]] : i32, i32) device_num([[DEVNUM]] : i32){{$}} + +end subroutine acc_init \ No newline at end of file diff --git a/flang/test/Lower/OpenACC/acc-shutdown.f90 b/flang/test/Lower/OpenACC/acc-shutdown.f90 new file mode 100644 index 0000000000000..bb854b6459fa9 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-shutdown.f90 @@ -0,0 +1,30 @@ +! This test checks lowering of OpenACC shutdown directive. + +! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s + +subroutine acc_shutdown + logical :: ifCondition = .TRUE. + + !$acc shutdown +!CHECK: acc.shutdown{{$}} + + !$acc shutdown if(.true.) +!CHECK: [[IF1:%.*]] = constant true +!CHECK: acc.shutdown if([[IF1]]){{$}} + + !$acc shutdown if(ifCondition) +!CHECK: [[IFCOND:%.*]] = fir.load %{{.*}} : !fir.ref> +!CHECK: [[IF2:%.*]] = fir.convert [[IFCOND]] : (!fir.logical<4>) -> i1 +!CHECK: acc.shutdown if([[IF2]]){{$}} + + !$acc shutdown device_num(1) +!CHECK: [[DEVNUM:%.*]] = constant 1 : i32 +!CHECK: acc.shutdown device_num([[DEVNUM]] : i32){{$}} + + !$acc shutdown device_num(1) device_type(1, 2) +!CHECK: [[DEVNUM:%.*]] = constant 1 : i32 +!CHECK: [[DEVTYPE1:%.*]] = constant 1 : i32 +!CHECK: [[DEVTYPE2:%.*]] = constant 2 : i32 +!CHECK: acc.shutdown device_type([[DEVTYPE1]], [[DEVTYPE2]] : i32, i32) device_num([[DEVNUM]] : i32){{$}} + +end subroutine acc_shutdown \ No newline at end of file From 6b1576a6a9e7ae86bedd2f7117706adbb6f49dea Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Wed, 28 Oct 2020 15:04:46 -0400 Subject: [PATCH 0334/1017] [flang][openacc] Lower wait directive --- flang/lib/Semantics/check-acc-structure.cpp | 8 ++++ flang/test/Lower/OpenACC/acc-wait.f90 | 41 +++++++++++++++++++++ 2 files changed, 49 insertions(+) create mode 100644 flang/test/Lower/OpenACC/acc-wait.f90 diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp index 537b59d925aeb..99eb6a4843a0c 100644 --- a/flang/lib/Semantics/check-acc-structure.cpp +++ b/flang/lib/Semantics/check-acc-structure.cpp @@ -161,6 +161,14 @@ void AccStructureChecker::Leave( dirContext_.pop_back(); } +void AccStructureChecker::Enter(const parser::OpenACCWaitConstruct &x) { + PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_wait); +} + +void AccStructureChecker::Leave(const parser::OpenACCWaitConstruct &) { + dirContext_.pop_back(); +} + void AccStructureChecker::Enter(const parser::OpenACCCombinedConstruct &x) { const auto &beginCombinedDir{ std::get(x.t)}; diff --git a/flang/test/Lower/OpenACC/acc-wait.f90 b/flang/test/Lower/OpenACC/acc-wait.f90 new file mode 100644 index 0000000000000..0b765e9a115e8 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-wait.f90 @@ -0,0 +1,41 @@ +! This test checks lowering of OpenACC wait directive. + +! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s + +subroutine acc_update + integer :: async = 1 + logical :: ifCondition = .TRUE. + + !$acc wait +!CHECK: acc.wait{{$}} + + !$acc wait if(.true.) +!CHECK: [[IF1:%.*]] = constant true +!CHECK: acc.wait if([[IF1]]){{$}} + + !$acc wait if(ifCondition) +!CHECK: [[IFCOND:%.*]] = fir.load %{{.*}} : !fir.ref> +!CHECK: [[IF2:%.*]] = fir.convert [[IFCOND]] : (!fir.logical<4>) -> i1 +!CHECK: acc.wait if([[IF2]]){{$}} + + !$acc wait(1, 2) +!CHECK: [[WAIT1:%.*]] = constant 1 : i32 +!CHECK: [[WAIT2:%.*]] = constant 2 : i32 +!CHECK: acc.wait([[WAIT1]], [[WAIT2]] : i32, i32){{$}} + + !$acc wait(1) async +!CHECK: [[WAIT3:%.*]] = constant 1 : i32 +!CHECK: acc.wait([[WAIT3]] : i32) attributes {async} + + !$acc wait(1) async(async) +!CHECK: [[WAIT3:%.*]] = constant 1 : i32 +!CHECK: [[ASYNC1:%.*]] = fir.load %{{.*}} : !fir.ref +!CHECK: acc.wait([[WAIT3]] : i32) async([[ASYNC1]] : i32){{$}} + + !$acc wait(devnum: 3: queues: 1, 2) +!CHECK: [[WAIT1:%.*]] = constant 1 : i32 +!CHECK: [[WAIT2:%.*]] = constant 2 : i32 +!CHECK: [[DEVNUM:%.*]] = constant 3 : i32 +!CHECK: acc.wait([[WAIT1]], [[WAIT2]] : i32, i32) wait_devnum([[DEVNUM]] : i32){{$}} + +end subroutine acc_update From 3b1e781aeedd988d96cb859a7ae1741a2e92ff9b Mon Sep 17 00:00:00 2001 From: vdonaldson <37090318+vdonaldson@users.noreply.github.com> Date: Fri, 30 Oct 2020 10:59:24 -0700 Subject: [PATCH 0335/1017] Add END statements to the PFT - Fix #503 and #524 (#533) * Add END statements to the PFT - Fix #503 and #524 Program unit end statements may have labels that may be branch targets. Modify the PFT to include these statements. Update the PFT dump to insert a blank in PFT annotations, so 'EndSubroutineStmt', which is an actual PFT node, is somewhat differentiated from 'End Subroutine', which is not. There is an additional front end bug that when addressed will fix additional instances of #524. --- flang/include/flang/Lower/PFTBuilder.h | 15 +++++++-- flang/lib/Lower/Bridge.cpp | 19 ++++++----- flang/lib/Lower/PFTBuilder.cpp | 46 +++++++++++++++++++------- flang/test/Lower/pre-fir-tree01.f90 | 14 -------- 4 files changed, 58 insertions(+), 36 deletions(-) diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 70e16f7ee0140..b586530910283 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -137,6 +137,10 @@ using ConstructStmts = std::tuple< parser::MaskedElsewhereStmt, parser::ElsewhereStmt, parser::EndWhereStmt, parser::ForallConstructStmt, parser::EndForallStmt>; +using EndStmts = + std::tuple; + using Constructs = std::tuple}; template static constexpr bool isConstructStmt{common::HasMember}; +template +static constexpr bool isEndStmt{common::HasMember}; + template static constexpr bool isConstruct{common::HasMember}; @@ -196,8 +203,8 @@ template using MakeReferenceVariant = typename MakeReferenceVariantHelper::type; using EvaluationTuple = - common::CombineTuples; + common::CombineTuples; /// Hide non-nullable pointers to the parse-tree node. /// Build type std::variant /// from EvaluationTuple type (std::tuple). @@ -237,6 +244,10 @@ struct Evaluation : EvaluationVariant { return pft::isConstructStmt>; }}); } + constexpr bool isEndStmt() const { + return visit(common::visitors{ + [](auto &r) { return pft::isEndStmt>; }}); + } constexpr bool isConstruct() const { return visit(common::visitors{ [](auto &r) { return pft::isConstruct>; }}); diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 5c52b838ccc1b..183f84ad7800d 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -1214,20 +1214,23 @@ class FirConverter : public Fortran::lower::AbstractConverter { valueList, blockList); } - // Nop statements - Code is generated elsewhere, often at the construct level. + // Nop statements - No code, or code is generated elsewhere. void genFIR(const Fortran::parser::CaseStmt &) {} // nop - void genFIR(const Fortran::parser::EndSelectStmt &) {} // nop void genFIR(const Fortran::parser::ContinueStmt &) {} // nop - void genFIR(const Fortran::parser::NonLabelDoStmt &) {} // nop - void genFIR(const Fortran::parser::EndDoStmt &) {} // nop - void genFIR(const Fortran::parser::EntryStmt &) {} // nop - void genFIR(const Fortran::parser::IfThenStmt &) {} // nop void genFIR(const Fortran::parser::ElseIfStmt &) {} // nop void genFIR(const Fortran::parser::ElseStmt &) {} // nop + void genFIR(const Fortran::parser::EndDoStmt &) {} // nop + void genFIR(const Fortran::parser::EndForallStmt &) {} // nop + void genFIR(const Fortran::parser::EndFunctionStmt &) {} // nop void genFIR(const Fortran::parser::EndIfStmt &) {} // nop - void genFIR(const Fortran::parser::ForallConstructStmt &) {} // nop + void genFIR(const Fortran::parser::EndMpSubprogramStmt &) {} // nop + void genFIR(const Fortran::parser::EndSelectStmt &) {} // nop + void genFIR(const Fortran::parser::EndSubroutineStmt &) {} // nop + void genFIR(const Fortran::parser::EntryStmt &) {} // nop void genFIR(const Fortran::parser::ForallAssignmentStmt &s) {} // nop - void genFIR(const Fortran::parser::EndForallStmt &) {} // nop + void genFIR(const Fortran::parser::ForallConstructStmt &) {} // nop + void genFIR(const Fortran::parser::IfThenStmt &) {} // nop + void genFIR(const Fortran::parser::NonLabelDoStmt &) {} // nop void genFIR(const Fortran::parser::AssociateConstruct &) { TODO(""); } void genFIR(const Fortran::parser::AssociateStmt &) { TODO(""); } diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index c054c7408a661..3a82d577d4595 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -191,16 +191,38 @@ class PFTBuilder { resetFunctionState(); } - /// Ensure that a function ends with a valid branch target (and is nonempty). + /// Add the end statement Evaluation of a sub/program to the PFT. + /// There may be intervening internal subprogram definitions between + /// prior statements and this end statement. void endFunctionBody() { if (evaluationListStack.empty()) return; auto evaluationList = evaluationListStack.back(); - if (evaluationList->empty() || - !evaluationList->back().isA()) { - static const parser::ContinueStmt endTarget{}; - addEvaluation( - lower::pft::Evaluation{endTarget, parentVariantStack.back(), {}, {}}); + if (evaluationList->empty() || !evaluationList->back().isEndStmt()) { + const auto &endStmt = + parentVariantStack.back().get().endStmt; + endStmt.visit(common::visitors{ + [&](const parser::Statement &s) { + addEvaluation(lower::pft::Evaluation{ + s.statement, parentVariantStack.back(), s.source, s.label}); + }, + [&](const parser::Statement &s) { + addEvaluation(lower::pft::Evaluation{ + s.statement, parentVariantStack.back(), s.source, s.label}); + }, + [&](const parser::Statement &s) { + addEvaluation(lower::pft::Evaluation{ + s.statement, parentVariantStack.back(), s.source, s.label}); + }, + [&](const parser::Statement &s) { + addEvaluation(lower::pft::Evaluation{ + s.statement, parentVariantStack.back(), s.source, s.label}); + }, + [&](const auto &s) { + llvm_unreachable("missing end statement or unexpected begin " + "statement reference"); + }, + }); } lastLexicalEvaluation = nullptr; } @@ -307,7 +329,7 @@ class PFTBuilder { auto &entryPointList = eval.getOwningProcedure()->entryPointList; evaluationListStack.back()->emplace_back(std::move(eval)); lower::pft::Evaluation *p = &evaluationListStack.back()->back(); - if (p->isActionStmt() || p->isConstructStmt()) { + if (p->isActionStmt() || p->isConstructStmt() || p->isEndStmt()) { if (lastLexicalEvaluation) { lastLexicalEvaluation->lexicalSuccessor = p; p->printIndex = lastLexicalEvaluation->printIndex + 1; @@ -833,7 +855,7 @@ class PFTDumper { [&](const lower::pft::BlockDataUnit &unit) { outputStream << getNodeIndex(unit) << " "; outputStream << "BlockData: "; - outputStream << "\nEndBlockData\n\n"; + outputStream << "\nEnd BlockData\n\n"; }, [&](const lower::pft::FunctionLikeUnit &func) { dumpFunctionLikeUnit(outputStream, func); @@ -945,9 +967,9 @@ class PFTDumper { outputStream << "\nContains\n"; for (auto &func : functionLikeUnit.nestedFunctions) dumpFunctionLikeUnit(outputStream, func); - outputStream << "EndContains\n"; + outputStream << "End Contains\n"; } - outputStream << "End" << unitKind << ' ' << name << "\n\n"; + outputStream << "End " << unitKind << ' ' << name << "\n\n"; } void dumpModuleLikeUnit(llvm::raw_ostream &outputStream, @@ -957,7 +979,7 @@ class PFTDumper { outputStream << "\nContains\n"; for (auto &func : moduleLikeUnit.nestedFunctions) dumpFunctionLikeUnit(outputStream, func); - outputStream << "EndContains\nEndModuleLike\n\n"; + outputStream << "End Contains\nEnd ModuleLike\n\n"; } // Top level directives @@ -968,7 +990,7 @@ class PFTDumper { outputStream << "CompilerDirective: !"; outputStream << directive.get() .source.ToString(); - outputStream << "\nEndCompilerDirective\n\n"; + outputStream << "\nEnd CompilerDirective\n\n"; } template diff --git a/flang/test/Lower/pre-fir-tree01.f90 b/flang/test/Lower/pre-fir-tree01.f90 index 81e93fdd88a46..c48611441499f 100644 --- a/flang/test/Lower/pre-fir-tree01.f90 +++ b/flang/test/Lower/pre-fir-tree01.f90 @@ -143,20 +143,6 @@ subroutine test_directive() end subroutine ! CHECK: EndSubroutine -! Test top level directives -!DIR$ INTEGER=64 -! CHECK: CompilerDirective: -! CHECK: EndCompilerDirective - -! Test nested directive -! CHECK: Subroutine test_directive -subroutine test_directive() - !DIR$ INTEGER=64 - ! CHECK: <> - ! CHECK: <> -end subroutine -! CHECK: EndSubroutine - ! CHECK: Program ! check specification parts are not part of the PFT. ! CHECK-NOT: node From 7a28c537e7f82421b8064d85e2a99ec09cd45067 Mon Sep 17 00:00:00 2001 From: Eric Date: Fri, 30 Oct 2020 10:31:04 -0700 Subject: [PATCH 0336/1017] fix bug in array_coor code gen --- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index d247937183240..091c1113edc48 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -173,11 +173,12 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { if (shapeOp) { populateShape(shapeOpers, shapeOp); rank = shapeOp.getType().cast().getRank(); - } else { - auto shiftOp = dyn_cast(shapeVal.getDefiningOp()); - if (shiftOp) - populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); + } else if (auto shiftOp = + dyn_cast(shapeVal.getDefiningOp())) { + populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); rank = shiftOp.getType().cast().getRank(); + } else { + return mlir::failure(); } mlir::NamedAttrList attrs; auto idxTy = rewriter.getIndexType(); @@ -195,6 +196,9 @@ class ArrayCoorConversion : public mlir::OpRewritePattern { auto dimAttr = rewriter.getIntegerAttr(idxTy, shapeOpers.size()); attrs.push_back( rewriter.getNamedAttr(XArrayCoorOp::shapeAttrName(), dimAttr)); + auto shiftAttr = rewriter.getIntegerAttr(idxTy, shiftOpers.size()); + attrs.push_back( + rewriter.getNamedAttr(XArrayCoorOp::shiftAttrName(), shiftAttr)); llvm::SmallVector sliceOpers; if (auto s = arrCoor.slice()) if (auto sliceOp = dyn_cast_or_null(s.getDefiningOp())) From 3616bfb24f3728cac86a8e051df57c3bce29b7d0 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Mon, 2 Nov 2020 01:43:22 -0800 Subject: [PATCH 0337/1017] Use fir.array> for the type of the fir.boxchar address result - This was a left over TODO from character refactoring, scalar character base address type fir.ref should not be propagated anymore since character related utilities are expecting a sequence type with the length as first dimension. This prevented unformatted IO with scalar characters to lower. - Lower character length directly in translateSymbolToFIRType - Remove genTypeWithCharFixup now translateSymbolToFIRType handles this --- flang/lib/Lower/Bridge.cpp | 49 ++++++++++------------ flang/lib/Lower/ConvertType.cpp | 35 +++++++++++----- flang/test/Lower/assumed-shaped-caller.f90 | 4 +- flang/test/Lower/character-assignment.f90 | 15 +++---- flang/test/Lower/concat.f90 | 6 +-- flang/test/Lower/dummy-procedure.f90 | 2 +- flang/test/Lower/intrinsics.f90 | 5 ++- flang/test/Lower/io-item-list.f90 | 24 +++++------ flang/test/Lower/pointer.f90 | 8 ++-- flang/test/Lower/stmt-function.f90 | 3 +- 10 files changed, 77 insertions(+), 74 deletions(-) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 183f84ad7800d..181ef37fb98d8 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -291,22 +291,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { bridge.getDefaultKinds(), tc); } - // FIXME: Should we fold the CHARACTER fixup into genType itself? - mlir::Type genTypeWithCharFixup(Fortran::lower::SymbolRef sym) { - auto symTy = genType(sym); - if (symTy.isa()) { - auto paramVal = sym->GetType()->characterTypeSpec().length(); - auto expr = paramVal.GetExplicit(); - assert(expr); - auto eval = Fortran::evaluate::AsGenericExpr(std::move(*expr)); - auto lenVal = Fortran::evaluate::ToInt64(eval); - assert(lenVal); - fir::SequenceType::Shape len = {*lenVal}; - symTy = fir::SequenceType::get(len, symTy); - } - return symTy; - } - mlir::Location getCurrentLocation() override final { return toLocation(); } /// Generate a dummy location. @@ -1867,7 +1851,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { counter = mem->offset(); } if (memDet->init()) { - auto memTy = genTypeWithCharFixup(*mem); + auto memTy = genType(*mem); members.push_back(memTy); counter = mem->offset() + mem->size(); } @@ -1956,8 +1940,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::SmallVector offs{ builder->createIntegerConstant(loc, idxTy, sym.offset() - aliasOffset)}; auto ptr = builder->create(loc, i8Ptr, store, offs); - auto preAlloc = builder->createConvert( - loc, builder->getRefType(genTypeWithCharFixup(sym)), ptr); + auto preAlloc = + builder->createConvert(loc, builder->getRefType(genType(sym)), ptr); mapSymbolAttributes(var, storeMap, preAlloc); } @@ -2117,16 +2101,25 @@ class FirConverter : public Fortran::lower::AbstractConverter { auto charLen = x.charLen(); if (replace) { auto symBox = lookupSymbol(sym); - auto unboxchar = charHelp.createUnboxChar(symBox.getAddr()); - auto boxAddr = unboxchar.first; + auto boxAddr = symBox.getAddr(); mlir::Value len; - if (charLen) { - // Set/override LEN with an expression - len = createFIRExpr(loc, &*charLen); + auto addrTy = boxAddr.getType(); + if (addrTy.isa() || addrTy.isa()) { + std::tie(boxAddr, len) = + charHelp.createUnboxChar(symBox.getAddr()); } else { - // LEN is from the boxchar - len = unboxchar.second; + // dummy from an other entry case: we cannot get a dynamic length + // for it, it's illegal for the user program to use it. However, + // since we are lowering all function unit statements regardless + // of whether the execution will reach them or not, we need to + // fill a value for the length here. + auto helper = Fortran::lower::CharacterExprHelper{*builder, loc}; + len = builder->createIntegerConstant(loc, helper.getLengthType(), + 1); } + // Override LEN with an expression + if (charLen) + len = createFIRExpr(loc, &*charLen); addCharSymbol(sym, boxAddr, len, true); return; } @@ -2577,7 +2570,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { counter = mem->offset(); } if (memDet->init()) { - auto memTy = genTypeWithCharFixup(*mem); + auto memTy = genType(*mem); members.push_back(memTy); counter = mem->offset() + mem->size(); } @@ -2654,7 +2647,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::SmallVector offs{builder->createIntegerConstant( loc, builder->getIndexType(), byteOffset)}; auto varAddr = builder->create(loc, i8Ptr, base, offs); - auto localTy = builder->getRefType(genTypeWithCharFixup(var.getSymbol())); + auto localTy = builder->getRefType(genType(var.getSymbol())); mlir::Value local = builder->createConvert(loc, localTy, varAddr); mapSymbolAttributes(var, storeMap, local); } diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp index eb805b2edb350..a7257a7ecb334 100644 --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -318,6 +318,20 @@ class TypeBuilder { return seqShapeHelper(symbol, bounds); } + fir::SequenceType::Extent + getCharacterLength(const Fortran::semantics::Symbol &symbol) { + if (symbol.GetType()->category() != + Fortran::semantics::DeclTypeSpec::Character) + llvm::report_fatal_error("not a character symbol"); + const auto &lenParam = symbol.GetType()->characterTypeSpec().length(); + if (auto expr = lenParam.GetExplicit()) { + auto len = Fortran::evaluate::AsGenericExpr(std::move(*expr)); + if (auto asInt = Fortran::evaluate::ToInt64(len)) + return *asInt; + } + return fir::SequenceType::getUnknownExtent(); + } + mlir::Type genSymbolHelper(const Fortran::semantics::Symbol &symbol, bool isAlloc = false, bool isPtr = false) { mlir::Type ty; @@ -377,18 +391,19 @@ class TypeBuilder { if (symbol.IsObjectArray()) { if (symbol.GetType()->category() == Fortran::semantics::DeclTypeSpec::Character) { - auto charLen = fir::SequenceType::getUnknownExtent(); - const auto &lenParam = symbol.GetType()->characterTypeSpec().length(); - if (auto expr = lenParam.GetExplicit()) { - auto len = Fortran::evaluate::AsGenericExpr(std::move(*expr)); - auto asInt = Fortran::evaluate::ToInt64(len); - if (asInt) - charLen = *asInt; - } - return fir::SequenceType::get(genSeqShape(symbol, charLen), ty); + auto charLen = getCharacterLength(symbol); + ty = fir::SequenceType::get(genSeqShape(symbol, charLen), ty); + } else { + ty = fir::SequenceType::get(genSeqShape(symbol), ty); } - return fir::SequenceType::get(genSeqShape(symbol), ty); } + + if (ty.isa()) { + auto charLen = getCharacterLength(symbol); + fir::SequenceType::Shape shape = {charLen}; + ty = fir::SequenceType::get(shape, ty); + } + if (isPtr || Fortran::semantics::IsPointer(symbol)) ty = fir::PointerType::get(ty); else if (isAlloc || Fortran::semantics::IsAllocatable(symbol)) diff --git a/flang/test/Lower/assumed-shaped-caller.f90 b/flang/test/Lower/assumed-shaped-caller.f90 index e2ac5b3896d43..48f3a06f2d75b 100644 --- a/flang/test/Lower/assumed-shaped-caller.f90 +++ b/flang/test/Lower/assumed-shaped-caller.f90 @@ -34,8 +34,8 @@ subroutine bar_char(x) end subroutine end interface character(*) :: x(42, 55, 12) - ! CHECK-DAG: %[[x:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) - ! CHECK-DAG: %[[addr:.*]] = fir.convert %[[x]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK-DAG: %[[x:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>>, index) + ! CHECK-DAG: %[[addr:.*]] = fir.convert %[[x]]#0 : (!fir.ref>>) -> !fir.ref>> ! CHECK-DAG: %[[c42:.*]] = constant 42 : index ! CHECK-DAG: %[[c55:.*]] = constant 55 : index ! CHECK-DAG: %[[c12:.*]] = constant 12 : index diff --git a/flang/test/Lower/character-assignment.f90 b/flang/test/Lower/character-assignment.f90 index d50cc8580d9e3..81b4c08622f5c 100644 --- a/flang/test/Lower/character-assignment.f90 +++ b/flang/test/Lower/character-assignment.f90 @@ -16,8 +16,7 @@ subroutine assign1(lhs, rhs) ! Copy of rhs into temp ! CHECK: fir.do_loop %[[i:.*]] = - ! CHECK: %[[rhs_addr2:.*]] = fir.convert %{{[0-9]+}}#0 - ! CHECK-DAG: %[[rhs_addr:.*]] = fir.coordinate_of %[[rhs_addr2]], %[[i]] + ! CHECK-DAG: %[[rhs_addr:.*]] = fir.coordinate_of %[[rhs]]#0, %[[i]] ! CHECK-DAG: %[[rhs_elt:.*]] = fir.load %[[rhs_addr]] ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[i]] ! CHECK: fir.store %[[rhs_elt]] to %[[tmp_addr]] @@ -27,8 +26,7 @@ subroutine assign1(lhs, rhs) ! CHECK: fir.do_loop %[[ii:.*]] = ! CHECK-DAG: %[[tmp_addr:.*]] = fir.coordinate_of %[[tmp]], %[[ii]] ! CHECK-DAG: %[[tmp_elt:.*]] = fir.load %[[tmp_addr]] - ! CHECK-DAG: %[[lhs_addr2:.*]] = fir.convert %[[lhs]]#0 - ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs_addr2]], %[[ii]] + ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[ii]] ! CHECK: fir.store %[[tmp_elt]] to %[[lhs_addr]] ! CHECK-NEXT: } @@ -36,8 +34,7 @@ subroutine assign1(lhs, rhs) ! CHECK-DAG: %[[c32:.*]] = constant 32 : i8 ! CHECK-DAG: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> ! CHECK: fir.do_loop %[[ij:.*]] = - ! CHECK: %[[lhs_addr2:.*]] = fir.convert %[[lhs]]#0 - ! CHECK: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs_addr2]], %[[ij]] + ! CHECK: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[ij]] ! CHECK: fir.store %[[blank]] to %[[lhs_addr]] ! CHECK-NEXT: } end subroutine @@ -56,8 +53,7 @@ subroutine assign_substring1(str, rhs, lb, ub) ! CHECK-DAG: %[[lbi:.*]] = fir.convert %[[lb]] : (i64) -> index ! CHECK-DAG: %[[c1:.*]] = constant 1 ! CHECK-DAG: %[[offset:.*]] = subi %[[lbi]], %[[c1]] - ! CHECK-DAG: %[[lhs_addr2:.*]] = fir.convert %[[str]]#0 - ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[lhs_addr2]], %[[offset]] + ! CHECK-DAG: %[[lhs_addr:.*]] = fir.coordinate_of %[[str]]#0, %[[offset]] ! Compute substring length ! CHECK-DAG: %[[ubi:.*]] = fir.convert %[[ub]] : (i64) -> index @@ -96,8 +92,7 @@ subroutine assign_constant(lhs) ! CHECK-DAG: %[[c32:.*]] = constant 32 : i8 ! CHECK-DAG: %[[blank:.*]] = fir.convert %[[c32]] : (i8) -> !fir.char<1> ! CHECK: fir.do_loop %[[j:.*]] = %{{.*}} to %{{.*}} { - ! CHECK: %[[jhs_addr2:.*]] = fir.convert %[[lhs]]#0 - ! CHECK: %[[jhs_addr:.*]] = fir.coordinate_of %[[jhs_addr2]], %[[j]] + ! CHECK: %[[jhs_addr:.*]] = fir.coordinate_of %[[lhs]]#0, %[[j]] ! CHECK: fir.store %[[blank]] to %[[jhs_addr]] ! CHECK: } end subroutine diff --git a/flang/test/Lower/concat.f90 b/flang/test/Lower/concat.f90 index ee05ad636acb0..4a129af42978f 100644 --- a/flang/test/Lower/concat.f90 +++ b/flang/test/Lower/concat.f90 @@ -19,8 +19,7 @@ subroutine concat_1(a, b) ! CHECK-DAG: %[[c1:.*]] = constant 1 ! CHECK-DAG: %[[count:.*]] = subi %[[a]]#1, %[[c1]] ! CHECK: fir.do_loop %[[index:.*]] = %[[c0]] to %[[count]] step %[[c1]] { - ! CHECK: %[[a_addr2:.*]] = fir.convert %[[a]]#0 - ! CHECK: %[[a_addr:.*]] = fir.coordinate_of %[[a_addr2]], %[[index]] + ! CHECK: %[[a_addr:.*]] = fir.coordinate_of %[[a]]#0, %[[index]] ! CHECK-DAG: %[[a_elt:.*]] = fir.load %[[a_addr]] ! CHECK: %[[temp_addr:.*]] = fir.coordinate_of %[[temp]], %[[index]] ! CHECK: fir.store %[[a_elt]] to %[[temp_addr]] @@ -30,8 +29,7 @@ subroutine concat_1(a, b) ! CHECK: %[[count2:.*]] = subi %[[len]], %[[c1_0]] ! CHECK: fir.do_loop %[[index2:.*]] = %[[a]]#1 to %[[count2]] step %[[c1_0]] { ! CHECK: %[[b_index:.*]] = subi %[[index]], %[[a]]#1 - ! CHECK: %[[b_addr2:.*]] = fir.convert %[[b]]#0 - ! CHECK: %[[b_addr:.*]] = fir.coordinate_of %[[b_addr2]], %[[b_index]] + ! CHECK: %[[b_addr:.*]] = fir.coordinate_of %[[b]]#0, %[[b_index]] ! CHECK-DAG: %[[b_elt:.*]] = fir.load %[[b_addr]] ! CHECK: %[[temp_addr2:.*]] = fir.coordinate_of %[[temp]], %[[index2]] ! CHECK: fir.store %[[b_elt]] to %[[temp_addr2]] diff --git a/flang/test/Lower/dummy-procedure.f90 b/flang/test/Lower/dummy-procedure.f90 index 0fe3c164a1962..e43495e7dcaeb 100644 --- a/flang/test/Lower/dummy-procedure.f90 +++ b/flang/test/Lower/dummy-procedure.f90 @@ -147,6 +147,6 @@ subroutine todo3(dummy_proc) !CHECK: return %[[imag]] : f32 !CHECK-LABEL: func @fir.len.i32.bc1(%arg0: !fir.boxchar<1>) - !CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) + !CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>>, index) !CHECK: %[[len:.*]] = fir.convert %[[unboxed]]#1 : (index) -> i32 !CHECK: return %[[len]] : i32 diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index df244f621aeef..fe0887f585025 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -185,8 +185,9 @@ subroutine ichar_test(c) ! CHECK-DAG: %[[unbox:.*]]:2 = fir.unboxchar ! CHECK-DAG: %[[J:.*]] = fir.alloca i32 {name = "{{.*}}Ej"} ! CHECK-DAG: %[[STR:.*]] = fir.alloca !fir.array{{.*}} {name = "{{.*}}Estr"} - ! CHECK: %[[BOX:.*]] = fir.load %[[unbox]]#0 : !fir.ref> - ! CHECK: = fir.convert %[[BOX]] : (!fir.char<1>) -> i32 + ! CHECK: %[[BOX:.*]] = fir.convert %[[unbox]]#0 : (!fir.ref>>) -> !fir.ref> + ! CHECK: %[[CHAR:.*]] = fir.load %[[BOX]] : !fir.ref> + ! CHECK: = fir.convert %[[CHAR]] : (!fir.char<1>) -> i32 print *, ichar(c) ! CHECK: fir.call @{{.*}}EndIoStatement diff --git a/flang/test/Lower/io-item-list.f90 b/flang/test/Lower/io-item-list.f90 index bd1b3aa8dac30..c0a2863b6cbd9 100644 --- a/flang/test/Lower/io-item-list.f90 +++ b/flang/test/Lower/io-item-list.f90 @@ -1,22 +1,22 @@ ! RUN: bbc -emit-fir %s -o - | FileCheck %s -! Test that IO item list +! Test that IO item list are lowered and passed correctly -! FIXME: embox does not like getting a length when it gets -! a !fir.ref> buffer. Either the verifier -! should be relaxed, or we should finish up ensuring character -! type for such buffer are !fir.ref>> -! -!subroutine pass_assumed_len_char(c) -! character(*) :: c -! write(1, rec=1) c -!end +! CHECK-LABEL: func @_QPpass_assumed_len_char_unformatted_io +subroutine pass_assumed_len_char_unformatted_io(c) + character(*) :: c + ! CHECK: %[[unbox:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>>, index) + write(1, rec=1) c + ! CHECK: %[[box:.*]] = fir.embox %[[unbox]]#0 typeparams %[[unbox]]#1 : (!fir.ref>>, index) -> !fir.box>> + ! CHECK: %[[castedBox:.*]] = fir.convert %[[box]] : (!fir.box>>) -> !fir.box + ! CHECK: fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[castedBox]]) : (!fir.ref, !fir.box) -> i1 +end ! CHECK-LABEL: func @_QPpass_assumed_len_char_array subroutine pass_assumed_len_char_array(carray) character(*) :: carray(2, 3) - ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) - ! CHECK-DAG: %[[buffer:.*]] = fir.convert %[[unboxed]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>>, index) + ! CHECK-DAG: %[[buffer:.*]] = fir.convert %[[unboxed]]#0 : (!fir.ref>>) -> !fir.ref>> ! CHECK-DAG: %[[c2:.*]] = constant 2 : index ! CHECK-DAG: %[[c3:.*]] = constant 3 : index ! CHECK-DAG: %[[shape:.*]] = fir.shape %[[c2]], %[[c3]] : (index, index) -> !fir.shape<2> diff --git a/flang/test/Lower/pointer.f90 b/flang/test/Lower/pointer.f90 index fb9a20fb484d5..fe2d5e1549ca7 100644 --- a/flang/test/Lower/pointer.f90 +++ b/flang/test/Lower/pointer.f90 @@ -23,12 +23,12 @@ subroutine pointerTests ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> ! CHECK: fir.has_value [[reg2]] : !fir.ptr> - ! CHECK: fir.global internal @_QFpointertestsEptr4 : !fir.ptr> - character, pointer :: ptr4 => NULL() + ! CHECK: fir.global internal @_QFpointertestsEptr4 : !fir.ptr>> + character(:), pointer :: ptr4 => NULL() ! CHECK: %[[c0:.*]] = constant 0 : index ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref - ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> - ! CHECK: fir.has_value [[reg2]] : !fir.ptr> + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr>> + ! CHECK: fir.has_value [[reg2]] : !fir.ptr>> ! CHECK: fir.global internal @_QFpointertestsEptr5 : !fir.ptr> logical, pointer :: ptr5 => NULL() diff --git a/flang/test/Lower/stmt-function.f90 b/flang/test/Lower/stmt-function.f90 index 7a5288b4a68a7..e8012eeb911e8 100644 --- a/flang/test/Lower/stmt-function.f90 +++ b/flang/test/Lower/stmt-function.f90 @@ -92,7 +92,8 @@ integer function test_stmt_character(c, j) character(10) :: c, argc ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : ! CHECK-DAG: %[[c10:.*]] = constant 10 : - ! CHECK: %[[c:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10]] + ! CHECK: %[[addr:.*]] = fir.convert %[[unboxed]]#0 : (!fir.ref>>) -> !fir.ref> + ! CHECK: %[[c:.*]] = fir.emboxchar %[[addr]], %[[c10]] func(argc, argj) = len_trim(argc, 4) + argj ! CHECK: addi %{{.*}}, %{{.*}} : i From 610e7646f30ffa0ce53052be138075806e9f9187 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 2 Nov 2020 15:29:25 -0800 Subject: [PATCH 0338/1017] rebase fallout --- flang/include/flang/Optimizer/Transforms/Passes.h | 3 ++- flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp | 4 ++-- flang/lib/Optimizer/Transforms/Inliner.cpp | 8 ++++++-- flang/lib/Optimizer/Transforms/RewriteLoop.cpp | 4 ++-- flang/lib/Semantics/check-acc-structure.cpp | 8 -------- 5 files changed, 12 insertions(+), 15 deletions(-) diff --git a/flang/include/flang/Optimizer/Transforms/Passes.h b/flang/include/flang/Optimizer/Transforms/Passes.h index c8fa189611a14..5e9ec67584c78 100644 --- a/flang/include/flang/Optimizer/Transforms/Passes.h +++ b/flang/include/flang/Optimizer/Transforms/Passes.h @@ -50,8 +50,9 @@ std::unique_ptr createFirToCfgPass(); std::unique_ptr createMemToRegPass(); /// Support for inlining on FIR. -bool canLegallyInline(mlir::Operation *op, mlir::Region *reg, +bool canLegallyInline(mlir::Operation *op, mlir::Region *reg, bool, mlir::BlockAndValueMapping &map); +bool canLegallyInline(mlir::Operation *, mlir::Operation *, bool); // declarative passes #define GEN_PASS_REGISTRATION diff --git a/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp index c04e6f844d7fb..cbd47c9520ec0 100644 --- a/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp +++ b/flang/lib/Optimizer/Transforms/ControlFlowConverter.cpp @@ -153,8 +153,8 @@ class ControlFlowLoweringPass mlir::StandardOpsDialect>(); target.addIllegalOp(); - if (mlir::failed( - mlir::applyPartialConversion(getFunction(), target, patterns))) + if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, + std::move(patterns)))) signalPassFailure(); } }; diff --git a/flang/lib/Optimizer/Transforms/Inliner.cpp b/flang/lib/Optimizer/Transforms/Inliner.cpp index 716665a5c240c..feadcd43835e4 100644 --- a/flang/lib/Optimizer/Transforms/Inliner.cpp +++ b/flang/lib/Optimizer/Transforms/Inliner.cpp @@ -18,7 +18,11 @@ static llvm::cl::opt llvm::cl::init(false)); /// Should we inline the callable `op` into region `reg`? -bool fir::canLegallyInline(mlir::Operation *op, mlir::Region *reg, - mlir::BlockAndValueMapping &map) { +bool fir::canLegallyInline(mlir::Operation *, mlir::Region *, bool, + mlir::BlockAndValueMapping &) { + return aggressivelyInline; +} + +bool fir::canLegallyInline(mlir::Operation *, mlir::Operation *, bool) { return aggressivelyInline; } diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 90f08e80e4fdf..baf7efa351705 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -292,8 +292,8 @@ class CfgConversion : public CFGConversionBase { // apply the patterns target.addIllegalOp(); target.markUnknownOpDynamicallyLegal([](Operation *) { return true; }); - if (mlir::failed( - mlir::applyPartialConversion(getFunction(), target, patterns))) { + if (mlir::failed(mlir::applyPartialConversion(getFunction(), target, + std::move(patterns)))) { mlir::emitError(mlir::UnknownLoc::get(context), "error in converting to CFG\n"); signalPassFailure(); diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp index 99eb6a4843a0c..537b59d925aeb 100644 --- a/flang/lib/Semantics/check-acc-structure.cpp +++ b/flang/lib/Semantics/check-acc-structure.cpp @@ -161,14 +161,6 @@ void AccStructureChecker::Leave( dirContext_.pop_back(); } -void AccStructureChecker::Enter(const parser::OpenACCWaitConstruct &x) { - PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_wait); -} - -void AccStructureChecker::Leave(const parser::OpenACCWaitConstruct &) { - dirContext_.pop_back(); -} - void AccStructureChecker::Enter(const parser::OpenACCCombinedConstruct &x) { const auto &beginCombinedDir{ std::get(x.t)}; From 1084aeb33df17bda20bb298ce1386bb425519530 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Mon, 2 Nov 2020 20:59:41 -0500 Subject: [PATCH 0339/1017] [flang][openacc] Lower if and device_type clause for update op --- flang/test/Lower/OpenACC/acc-update.f90 | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/flang/test/Lower/OpenACC/acc-update.f90 b/flang/test/Lower/OpenACC/acc-update.f90 index 1a3acaff34876..86ed061673178 100644 --- a/flang/test/Lower/OpenACC/acc-update.f90 +++ b/flang/test/Lower/OpenACC/acc-update.f90 @@ -14,6 +14,15 @@ subroutine acc_update !$acc update host(a) !CHECK: acc.update host([[A]] : !fir.ref>){{$}} + !$acc update host(a) if(.true.) +!CHECK: [[IF1:%.*]] = constant true +!CHECK: acc.update if([[IF1]]) host([[A]] : !fir.ref>){{$}} + + !$acc update host(a) if(ifCondition) +!CHECK: [[IFCOND:%.*]] = fir.load %{{.*}} : !fir.ref> +!CHECK: [[IF2:%.*]] = fir.convert [[IFCOND]] : (!fir.logical<4>) -> i1 +!CHECK: acc.update if([[IF2]]) host([[A]] : !fir.ref>){{$}} + !$acc update host(a) host(b) host(c) !CHECK: acc.update host([[A]], [[B]], [[C]] : !fir.ref>, !fir.ref>, !fir.ref>){{$}} @@ -52,4 +61,12 @@ subroutine acc_update !CHECK: [[WAIT6:%.*]] = constant 1 : i32 !CHECK: acc.update wait_devnum([[WAIT6]] : i32) wait([[WAIT4]], [[WAIT5]] : i32, i32) host([[A]] : !fir.ref>) -end subroutine acc_update \ No newline at end of file + !$acc update host(a) device_type(1, 2) +!CHECK: [[DEVTYPE1:%.*]] = constant 1 : i32 +!CHECK: [[DEVTYPE2:%.*]] = constant 2 : i32 +!CHECK: acc.update device_type([[DEVTYPE1]], [[DEVTYPE2]] : i32, i32) host([[A]] : !fir.ref>){{$}} + + !$acc update host(a) device_type(*) +!CHECK: [[DEVTYPE3:%.*]] = constant -1 : i32 +!CHECK: acc.update device_type([[DEVTYPE3]] : i32) host([[A]] : !fir.ref>){{$}} +end subroutine acc_update From 2aefe178a66e105353f5aa0f6bd30d3e479bd9bd Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 5 Nov 2020 12:33:38 -0800 Subject: [PATCH 0340/1017] Fix the CFG rewriting pass to properly handle the iterate_while when it has negative step (count down) as well as positive. --- flang/lib/Optimizer/Transforms/RewriteLoop.cpp | 17 +++++++++++++++-- flang/test/Fir/loop01.fir | 6 +++--- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index baf7efa351705..69bfb8fa31bbd 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -258,10 +258,23 @@ class CfgIterWhileConv : public mlir::OpRewritePattern { // With the body block done, we can fill in the condition block. rewriter.setInsertionPointToEnd(conditionBlock); - auto comp1 = + // The comparison depends on the sign of the step value. We fully expect + // this expression to be folded by the optimizer or LLVM. This expression + // is written this way so that `step == 0` always returns `false`. + auto zero = rewriter.create(loc, 0); + auto compl0 = + rewriter.create(loc, CmpIPredicate::slt, zero, step); + auto compl1 = rewriter.create(loc, CmpIPredicate::slt, iv, upperBound); + auto compl2 = + rewriter.create(loc, CmpIPredicate::slt, step, zero); + auto compl3 = + rewriter.create(loc, CmpIPredicate::slt, upperBound, iv); + auto cmp0 = rewriter.create(loc, compl0, compl1); + auto cmp1 = rewriter.create(loc, compl2, compl3); + auto cmp2 = rewriter.create(loc, cmp0, cmp1); // Remember to AND in the early-exit bool. - auto comparison = rewriter.create(loc, comp1, iterateVar); + auto comparison = rewriter.create(loc, iterateVar, cmp2); rewriter.create(loc, comparison, firstBodyBlock, llvm::ArrayRef(), endBlock, llvm::ArrayRef()); diff --git a/flang/test/Fir/loop01.fir b/flang/test/Fir/loop01.fir index 40f0afa527ea6..0760ac630b546 100644 --- a/flang/test/Fir/loop01.fir +++ b/flang/test/Fir/loop01.fir @@ -29,7 +29,7 @@ func @x2(%lo : index, %up : index, %ok : i1) { // CHECK-DAG: %[[count:.*]] = phi i64 // CHECK-DAG: %[[exit:.*]] = phi i1 // CHECK: %[[cond:.*]] = icmp slt i64 %[[count]], % - // CHECK: %[[and:.*]] = and i1 %[[cond]], %[[exit]] + // CHECK: %[[and:.*]] = and i1 %[[exit]], %[[cond]] // CHECK: br i1 %[[and]] %unused = fir.iterate_while (%i = %lo to %up step %c1) and (%ok1 = %ok) { %ok2 = fir.call @f2() : () -> i1 @@ -69,7 +69,7 @@ func @y3(%lo : index, %up : index) -> i1 { // CHECK-DAG: %[[ok3:.*]] = phi i1 {{.*}}[ true // CHECK-DAG: %[[j:.*]] = phi i1 {{.*}}[ %[[ok4]] // CHECK: %[[prev:.*]] = icmp slt i64 %[[count]], - // CHECK: = and i1 %[[prev]], %[[ok3]] + // CHECK: = and i1 %[[ok3]], %[[prev]] %ok2:2 = fir.iterate_while (%i = %lo to %up step %c1) and (%ok3 = %ok1) iter_args(%j = %ok4) -> i1 { %ok = fir.call @f2() : () -> i1 fir.result %ok3, %ok : i1, i1 @@ -160,7 +160,7 @@ func @y5(%lo : index, %up : index) -> index { // CHECK-DAG: %[[ok2:.*]] = phi i1 {{.*}}[ true, // CHECK-DAG: %[[s:.*]] = phi i16 {{.*}}[ 42, // CHECK: icmp slt i64 %[[i]] - // CHECK: and i1 {{.*}}%[[ok2]] + // CHECK: and i1 %[[ok2]] %v:3 = fir.iterate_while (%i = %lo to %up step %c1) and (%ok2 = %ok1) iter_args(%s = %s1) -> (index, i1, i16) { // CHECK: call i1 @f2 %ok = fir.call @f2() : () -> i1 From fcee935ace2e2320f7df55648544a4fc1586eb75 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Fri, 6 Nov 2020 10:53:12 -0800 Subject: [PATCH 0341/1017] Fix the bounds check on iterate_while. The upper bound is defined to be inclusive. (The iteration set is a closed iterval [lo, lo+step, ... hi], where hi is included if it is equal to lo+k*step for some integer k) --- flang/lib/Optimizer/Transforms/RewriteLoop.cpp | 4 ++-- flang/test/Fir/loop01.fir | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp index 69bfb8fa31bbd..7c65c8d434d53 100644 --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -265,11 +265,11 @@ class CfgIterWhileConv : public mlir::OpRewritePattern { auto compl0 = rewriter.create(loc, CmpIPredicate::slt, zero, step); auto compl1 = - rewriter.create(loc, CmpIPredicate::slt, iv, upperBound); + rewriter.create(loc, CmpIPredicate::sle, iv, upperBound); auto compl2 = rewriter.create(loc, CmpIPredicate::slt, step, zero); auto compl3 = - rewriter.create(loc, CmpIPredicate::slt, upperBound, iv); + rewriter.create(loc, CmpIPredicate::sle, upperBound, iv); auto cmp0 = rewriter.create(loc, compl0, compl1); auto cmp1 = rewriter.create(loc, compl2, compl3); auto cmp2 = rewriter.create(loc, cmp0, cmp1); diff --git a/flang/test/Fir/loop01.fir b/flang/test/Fir/loop01.fir index 0760ac630b546..361b7f6f2469d 100644 --- a/flang/test/Fir/loop01.fir +++ b/flang/test/Fir/loop01.fir @@ -28,7 +28,7 @@ func @x2(%lo : index, %up : index, %ok : i1) { %c1 = constant 1 : index // CHECK-DAG: %[[count:.*]] = phi i64 // CHECK-DAG: %[[exit:.*]] = phi i1 - // CHECK: %[[cond:.*]] = icmp slt i64 %[[count]], % + // CHECK: %[[cond:.*]] = icmp sle i64 %[[count]], % // CHECK: %[[and:.*]] = and i1 %[[exit]], %[[cond]] // CHECK: br i1 %[[and]] %unused = fir.iterate_while (%i = %lo to %up step %c1) and (%ok1 = %ok) { @@ -68,7 +68,7 @@ func @y3(%lo : index, %up : index) -> i1 { // CHECK-DAG: %[[count:.*]] = phi i64 // CHECK-DAG: %[[ok3:.*]] = phi i1 {{.*}}[ true // CHECK-DAG: %[[j:.*]] = phi i1 {{.*}}[ %[[ok4]] - // CHECK: %[[prev:.*]] = icmp slt i64 %[[count]], + // CHECK: %[[prev:.*]] = icmp sle i64 %[[count]], // CHECK: = and i1 %[[ok3]], %[[prev]] %ok2:2 = fir.iterate_while (%i = %lo to %up step %c1) and (%ok3 = %ok1) iter_args(%j = %ok4) -> i1 { %ok = fir.call @f2() : () -> i1 @@ -110,7 +110,7 @@ func @y4(%lo : index, %up : index) -> index { %ok1 = constant true // CHECK-DAG: %[[i:.*]] = phi i64 [ // CHECK-DAG: %[[ok2:.*]] = phi i1 [ - // CHECK: icmp slt i64 %[[i]] + // CHECK: icmp sle i64 %[[i]] // CHECK: and i1 %v:2 = fir.iterate_while (%i = %lo to %up step %c1) and (%ok2 = %ok1) -> (index, i1) { %i1 = fir.convert %i : (index) -> i32 @@ -159,7 +159,7 @@ func @y5(%lo : index, %up : index) -> index { // CHECK-DAG: %[[i:.*]] = phi i64 {{.*}}[ %[[lo]], // CHECK-DAG: %[[ok2:.*]] = phi i1 {{.*}}[ true, // CHECK-DAG: %[[s:.*]] = phi i16 {{.*}}[ 42, - // CHECK: icmp slt i64 %[[i]] + // CHECK: icmp sle i64 %[[i]] // CHECK: and i1 %[[ok2]] %v:3 = fir.iterate_while (%i = %lo to %up step %c1) and (%ok2 = %ok1) iter_args(%s = %s1) -> (index, i1, i16) { // CHECK: call i1 @f2 From 8a4c611def4e835ae19d1a57e87eb73dd3b334b3 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 3 Nov 2020 04:24:54 -0800 Subject: [PATCH 0342/1017] Get length of assumed length named constant in mlir type --- flang/include/flang/Lower/ConvertType.h | 16 ++-- flang/lib/Lower/Bridge.cpp | 8 +- flang/lib/Lower/ConvertType.cpp | 110 ++++++++++++++++++++++-- 3 files changed, 112 insertions(+), 22 deletions(-) diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h index ba1a5f1dbd4e6..57cda49d7c3f1 100644 --- a/flang/include/flang/Lower/ConvertType.h +++ b/flang/include/flang/Lower/ConvertType.h @@ -38,7 +38,7 @@ class Reference; } // namespace common namespace evaluate { -struct DataRef; +class DataRef; template class Designator; template @@ -101,16 +101,14 @@ mlir::Type translateSomeExprToFIRType(mlir::MLIRContext *ctxt, const SomeExpr *expr); /// Translate a Fortran::semantics::Symbol to an mlir::Type. -mlir::Type -translateSymbolToFIRType(mlir::MLIRContext *ctxt, - common::IntrinsicTypeDefaultKinds const &defaults, - const SymbolRef symbol); +mlir::Type translateSymbolToFIRType(mlir::MLIRContext *ctxt, + Fortran::evaluate::FoldingContext &, + const SymbolRef symbol); /// Translate a Fortran::lower::pft::Variable to an mlir::Type. -mlir::Type -translateVariableToFIRType(mlir::MLIRContext *ctxt, - common::IntrinsicTypeDefaultKinds const &defaults, - const pft::Variable &variable); +mlir::Type translateVariableToFIRType(mlir::MLIRContext *ctxt, + Fortran::evaluate::FoldingContext &, + const pft::Variable &variable); /// Translate a REAL of KIND to the mlir::Type. mlir::Type convertReal(mlir::MLIRContext *ctxt, int KIND); diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 181ef37fb98d8..a38f7aaf0aab4 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -274,12 +274,12 @@ class FirConverter : public Fortran::lower::AbstractConverter { foldingContext, &expr); } mlir::Type genType(const Fortran::lower::pft::Variable &var) override final { - return Fortran::lower::translateVariableToFIRType( - &getMLIRContext(), bridge.getDefaultKinds(), var); + return Fortran::lower::translateVariableToFIRType(&getMLIRContext(), + foldingContext, var); } mlir::Type genType(Fortran::lower::SymbolRef sym) override final { - return Fortran::lower::translateSymbolToFIRType( - &getMLIRContext(), bridge.getDefaultKinds(), sym); + return Fortran::lower::translateSymbolToFIRType(&getMLIRContext(), + foldingContext, sym); } mlir::Type genType(Fortran::common::TypeCategory tc, int kind) override final { diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp index a7257a7ecb334..e232f57ba9754 100644 --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -490,7 +490,7 @@ class TypeBuilder { /// current one (The old one is still used for DataRef and Designator). struct NewTypeBuilder { - mlir::Type gen(const Fortran::lower::SomeExpr &expr) { + mlir::Type genExprType(const Fortran::lower::SomeExpr &expr) { auto dynamicType = expr.GetType(); if (!dynamicType) llvm::report_fatal_error("lowering typeless expression type"); @@ -499,7 +499,7 @@ struct NewTypeBuilder { TODO("derived types lowering"); auto shapeExpr = Fortran::evaluate::GetShape(foldingContext, expr); if (!shapeExpr) - TODO("implied shape expression type lowering"); + TODO("Assumed rank expression type lowering"); auto baseType = TypeBuilder{context, foldingContext.defaults()}.genFIRTy( category, dynamicType->kind()); @@ -535,6 +535,100 @@ struct NewTypeBuilder { Fortran::evaluate::Fold(foldingContext, std::move(expr))); } + mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol, + bool isAlloc = false, bool isPtr = false) { + // TODO: translate symbol location to mlir loc. Need converter + auto loc = mlir::UnknownLoc::get(context); + mlir::Type ty; + if (auto *type{symbol.GetType()}) { + if (auto *tySpec{type->AsIntrinsic()}) { + int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value(); + ty = TypeBuilder{context, foldingContext.defaults()}.genFIRTy( + tySpec->category(), kind); + } else if (auto *tySpec = type->AsDerived()) { + std::vector> ps; + std::vector> cs; + auto &symbol = tySpec->typeSymbol(); + auto rec = fir::RecordType::get(context, toStringRef(symbol.name())); + // TODO: use Fortran::semantics::ComponentIterator to go through + // components. or use similar mechanism. We probably want to go through + // the Ordered components. + TODO("lower derived type to fir types"); + rec.finalize(ps, cs); + ty = rec; + } else { + mlir::emitError(loc, "symbol's type must have a type spec"); + return {}; + } + } else { + mlir::emitError(loc, "symbol must have a type"); + return {}; + } + if (symbol.IsObjectArray()) { + auto shapeExpr = + Fortran::evaluate::GetShapeHelper{foldingContext}(symbol); + if (!shapeExpr) + TODO("assumed rank symbol type lowering"); + fir::SequenceType::Shape shape; + if (symbol.GetType()->category() == + Fortran::semantics::DeclTypeSpec::Character) + shape.push_back(getCharacterLength(symbol)); + translateShape(shape, std::move(*shapeExpr)); + ty = fir::SequenceType::get(shape, ty); + } + + if (ty.isa()) { + auto charLen = getCharacterLength(symbol); + fir::SequenceType::Shape shape = {charLen}; + ty = fir::SequenceType::get(shape, ty); + } + + if (isPtr || Fortran::semantics::IsPointer(symbol)) + ty = fir::PointerType::get(ty); + else if (isAlloc || Fortran::semantics::IsAllocatable(symbol)) + ty = fir::HeapType::get(ty); + return ty; + } + + // To get the character length from a symbol, make an fold a designator for + // the symbol to cover the case where the symbol is an assumed length named + // constant and its length comes from its init expression length. + template + fir::SequenceType::Extent + getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) { + using TC = + Fortran::evaluate::Type; + auto designator = Fortran::evaluate::Fold( + foldingContext, + Fortran::evaluate::Expr{Fortran::evaluate::Designator{symbol}}); + if (auto len = toInt64(std::move(designator.LEN()))) + return *len; + return fir::SequenceType::getUnknownExtent(); + } + fir::SequenceType::Extent + getCharacterLength(const Fortran::semantics::Symbol &symbol) { + auto *type = symbol.GetType(); + if (!type || + type->category() != Fortran::semantics::DeclTypeSpec::Character || + !type->AsIntrinsic()) + llvm::report_fatal_error("not a character symbol"); + int kind = + toInt64(Fortran::common::Clone(type->AsIntrinsic()->kind())).value(); + switch (kind) { + case 1: + return getCharacterLengthHelper<1>(symbol); + case 2: + return getCharacterLengthHelper<2>(symbol); + case 4: + return getCharacterLengthHelper<4>(symbol); + } + llvm::report_fatal_error("unknown character kind"); + } + + mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) { + return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer()); + } + mlir::MLIRContext *context; Fortran::evaluate::FoldingContext &foldingContext; }; @@ -565,21 +659,19 @@ mlir::Type Fortran::lower::translateDataRefToFIRType( mlir::Type Fortran::lower::translateSomeExprToFIRType( mlir::MLIRContext *context, Fortran::evaluate::FoldingContext &foldingCtx, const SomeExpr *expr) { - return NewTypeBuilder{context, foldingCtx}.gen(*expr); + return NewTypeBuilder{context, foldingCtx}.genExprType(*expr); } mlir::Type Fortran::lower::translateSymbolToFIRType( - mlir::MLIRContext *context, - const Fortran::common::IntrinsicTypeDefaultKinds &defaults, + mlir::MLIRContext *context, Fortran::evaluate::FoldingContext &foldingCtx, const SymbolRef symbol) { - return TypeBuilder{context, defaults}.gen(symbol); + return NewTypeBuilder{context, foldingCtx}.genSymbolType(symbol); } mlir::Type Fortran::lower::translateVariableToFIRType( - mlir::MLIRContext *context, - const Fortran::common::IntrinsicTypeDefaultKinds &defaults, + mlir::MLIRContext *context, Fortran::evaluate::FoldingContext &foldingCtx, const Fortran::lower::pft::Variable &var) { - return TypeBuilder{context, defaults}.gen(var); + return NewTypeBuilder{context, foldingCtx}.genVariableType(var); } mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) { From 09297b3d360acb7d36cdd2b808d9b264bcbf8c79 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 3 Nov 2020 06:01:47 -0800 Subject: [PATCH 0343/1017] Remove old TypeBuilder and simplify type translation - Change all entry points to use the type builder that does not visit the expression tree but uses GetSahpe/LEN() + Fold instead. - Remove unused type translation entry points. - Remove some template arguments that can now be handled by using different function name (they used explicit template instantiation in the remaining usages, which is less readable). - Set the location in error messages when lowering symbol types. - Lower typeless expressions to fir type (function pointer to their fir types, the rest to fir.ref/NoneType). --- flang/include/flang/Lower/AbstractConverter.h | 3 - flang/include/flang/Lower/ConvertType.h | 60 +- flang/lib/Lower/Bridge.cpp | 20 +- flang/lib/Lower/ConvertType.cpp | 611 ++++-------------- 4 files changed, 139 insertions(+), 555 deletions(-) diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h index ea4c300f2e1d6..164d2fa22d081 100644 --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -25,7 +25,6 @@ class Reference; } namespace evaluate { -struct DataRef; template class Expr; class FoldingContext; @@ -99,8 +98,6 @@ class AbstractConverter { // Types //===--------------------------------------------------------------------===// - /// Generate the type of a DataRef - virtual mlir::Type genType(const Fortran::evaluate::DataRef &) = 0; /// Generate the type of an Expr virtual mlir::Type genType(const SomeExpr &) = 0; /// Generate the type of a Symbol diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h index 57cda49d7c3f1..b0a77cd68c20d 100644 --- a/flang/include/flang/Lower/ConvertType.h +++ b/flang/include/flang/Lower/ConvertType.h @@ -32,23 +32,14 @@ class Type; namespace Fortran { namespace common { -class IntrinsicTypeDefaultKinds; template class Reference; } // namespace common namespace evaluate { -class DataRef; -template -class Designator; template class Expr; -template -struct SomeKind; struct SomeType; -template -class Type; -class FoldingContext; } // namespace evaluate namespace semantics { @@ -56,6 +47,7 @@ class Symbol; } // namespace semantics namespace lower { +class AbstractConverter; namespace pft { struct Variable; } @@ -64,62 +56,24 @@ using SomeExpr = evaluate::Expr; using SymbolRef = common::Reference; /// Get a FIR type based on a category and kind. -mlir::Type getFIRType(mlir::MLIRContext *ctxt, - common::IntrinsicTypeDefaultKinds const &defaults, - common::TypeCategory tc, int kind); - -/// Get a FIR type based on a category. -mlir::Type getFIRType(mlir::MLIRContext *ctxt, - common::IntrinsicTypeDefaultKinds const &defaults, - common::TypeCategory tc); - -/// Translate a Fortran::evaluate::DataRef to an mlir::Type. -mlir::Type -translateDataRefToFIRType(mlir::MLIRContext *ctxt, - common::IntrinsicTypeDefaultKinds const &defaults, - const evaluate::DataRef &dataRef); - -/// Translate a Fortran::evaluate::Designator<> to an mlir::Type. -template -inline mlir::Type translateDesignatorToFIRType( - mlir::MLIRContext *ctxt, common::IntrinsicTypeDefaultKinds const &defaults, - const evaluate::Designator> &) { - return getFIRType(ctxt, defaults, TC, KIND); -} - -/// Translate a Fortran::evaluate::Designator<> to an mlir::Type. -template -inline mlir::Type translateDesignatorToFIRType( - mlir::MLIRContext *ctxt, common::IntrinsicTypeDefaultKinds const &defaults, - const evaluate::Designator> &) { - return getFIRType(ctxt, defaults, TC); -} +mlir::Type getFIRType(mlir::MLIRContext *ctxt, common::TypeCategory tc, + int kind); /// Translate a SomeExpr to an mlir::Type. -mlir::Type translateSomeExprToFIRType(mlir::MLIRContext *ctxt, - evaluate::FoldingContext &, - const SomeExpr *expr); +mlir::Type translateSomeExprToFIRType(Fortran::lower::AbstractConverter &, + const SomeExpr &expr); /// Translate a Fortran::semantics::Symbol to an mlir::Type. -mlir::Type translateSymbolToFIRType(mlir::MLIRContext *ctxt, - Fortran::evaluate::FoldingContext &, +mlir::Type translateSymbolToFIRType(Fortran::lower::AbstractConverter &, const SymbolRef symbol); /// Translate a Fortran::lower::pft::Variable to an mlir::Type. -mlir::Type translateVariableToFIRType(mlir::MLIRContext *ctxt, - Fortran::evaluate::FoldingContext &, +mlir::Type translateVariableToFIRType(Fortran::lower::AbstractConverter &, const pft::Variable &variable); /// Translate a REAL of KIND to the mlir::Type. mlir::Type convertReal(mlir::MLIRContext *ctxt, int KIND); -// Given a ReferenceType of a base type, returns the ReferenceType to -// the SequenceType of this base type. -// The created SequenceType has one dimension of unknown extent. -// This is useful to do pointer arithmetic using fir::CoordinateOp that requires -// a memory reference to a sequence type. -mlir::Type getSequenceRefType(mlir::Type referenceType); - } // namespace lower } // namespace Fortran diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index a38f7aaf0aab4..506333457299a 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -265,30 +265,22 @@ class FirConverter : public Fortran::lower::AbstractConverter { return foldingContext; } - mlir::Type genType(const Fortran::evaluate::DataRef &data) override final { - return Fortran::lower::translateDataRefToFIRType( - &getMLIRContext(), bridge.getDefaultKinds(), data); - } mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final { - return Fortran::lower::translateSomeExprToFIRType(&getMLIRContext(), - foldingContext, &expr); + return Fortran::lower::translateSomeExprToFIRType(*this, expr); } mlir::Type genType(const Fortran::lower::pft::Variable &var) override final { - return Fortran::lower::translateVariableToFIRType(&getMLIRContext(), - foldingContext, var); + return Fortran::lower::translateVariableToFIRType(*this, var); } mlir::Type genType(Fortran::lower::SymbolRef sym) override final { - return Fortran::lower::translateSymbolToFIRType(&getMLIRContext(), - foldingContext, sym); + return Fortran::lower::translateSymbolToFIRType(*this, sym); } mlir::Type genType(Fortran::common::TypeCategory tc, int kind) override final { - return Fortran::lower::getFIRType(&getMLIRContext(), - bridge.getDefaultKinds(), tc, kind); + return Fortran::lower::getFIRType(&getMLIRContext(), tc, kind); } mlir::Type genType(Fortran::common::TypeCategory tc) override final { - return Fortran::lower::getFIRType(&getMLIRContext(), - bridge.getDefaultKinds(), tc); + return Fortran::lower::getFIRType( + &getMLIRContext(), tc, bridge.getDefaultKinds().GetDefaultKind(tc)); } mlir::Location getCurrentLocation() override final { return toLocation(); } diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp index e232f57ba9754..e991bcf264456 100644 --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -9,6 +9,8 @@ #include "flang/Lower/ConvertType.h" #include "flang/Evaluate/fold.h" #include "flang/Evaluate/shape.h" +#include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/CallInterface.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Todo.h" #include "flang/Lower/Utils.h" @@ -18,501 +20,129 @@ #include "mlir/IR/Builders.h" #include "mlir/IR/BuiltinTypes.h" -template -bool isConstant(const Fortran::evaluate::Expr &e) { - return Fortran::evaluate::IsConstantExpr(Fortran::lower::SomeExpr{e}); -} - -template -int64_t toConstant(const Fortran::evaluate::Expr &e) { - auto opt = Fortran::evaluate::ToInt64(e); - assert(opt.has_value() && "expression didn't resolve to a constant"); - return opt.value(); -} - -// one argument template, must be specialized -template -mlir::Type genFIRType(mlir::MLIRContext *, int) { - return {}; -} - -// two argument template -template -mlir::Type genFIRType(mlir::MLIRContext *context) { - if constexpr (TC == Fortran::common::TypeCategory::Integer) { - auto bits{Fortran::evaluate::Type::Scalar::bits}; - return mlir::IntegerType::get(context, bits); - } else if constexpr (TC == Fortran::common::TypeCategory::Logical || - TC == Fortran::common::TypeCategory::Character || - TC == Fortran::common::TypeCategory::Complex) { - return genFIRType(context, KIND); - } else { - return {}; - } -} - -template <> -mlir::Type -genFIRType(mlir::MLIRContext *context) { - return mlir::FloatType::getF16(context); -} - -template <> -mlir::Type -genFIRType(mlir::MLIRContext *context) { - return mlir::FloatType::getBF16(context); -} - -template <> -mlir::Type -genFIRType(mlir::MLIRContext *context) { - return mlir::FloatType::getF32(context); -} - -template <> -mlir::Type -genFIRType(mlir::MLIRContext *context) { - return mlir::FloatType::getF64(context); -} - -template <> -mlir::Type genFIRType( - mlir::MLIRContext *context) { - return fir::RealType::get(context, 10); -} +//===--------------------------------------------------------------------===// +// Intrinsic type translation helpers +//===--------------------------------------------------------------------===// -template <> -mlir::Type genFIRType( - mlir::MLIRContext *context) { - return fir::RealType::get(context, 16); -} - -template <> -mlir::Type -genFIRType(mlir::MLIRContext *context, - int kind) { +static mlir::Type genRealType(mlir::MLIRContext *context, int kind) { if (Fortran::evaluate::IsValidKindOfIntrinsicType( Fortran::common::TypeCategory::Real, kind)) { switch (kind) { case 2: - return genFIRType(context); + return mlir::FloatType::getF16(context); case 3: - return genFIRType(context); + return mlir::FloatType::getBF16(context); case 4: - return genFIRType(context); + return mlir::FloatType::getF32(context); case 8: - return genFIRType(context); + return mlir::FloatType::getF64(context); case 10: - return genFIRType(context); + return fir::RealType::get(context, 10); case 16: - return genFIRType(context); + return fir::RealType::get(context, 16); } } llvm_unreachable("REAL type translation not implemented"); } -template <> -mlir::Type -genFIRType(mlir::MLIRContext *context, - int kind) { +template +int getIntegerBits() { + return Fortran::evaluate::Type::Scalar::bits; +} +static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind) { if (Fortran::evaluate::IsValidKindOfIntrinsicType( Fortran::common::TypeCategory::Integer, kind)) { switch (kind) { case 1: - return genFIRType(context); + return mlir::IntegerType::get(getIntegerBits<1>(), context); case 2: - return genFIRType(context); + return mlir::IntegerType::get(getIntegerBits<2>(), context); case 4: - return genFIRType(context); + return mlir::IntegerType::get(getIntegerBits<4>(), context); case 8: - return genFIRType(context); + return mlir::IntegerType::get(getIntegerBits<8>(), context); case 16: - return genFIRType(context); + return mlir::IntegerType::get(getIntegerBits<16>(), context); } } llvm_unreachable("INTEGER type translation not implemented"); } -template <> -mlir::Type -genFIRType(mlir::MLIRContext *context, - int KIND) { +static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) { if (Fortran::evaluate::IsValidKindOfIntrinsicType( Fortran::common::TypeCategory::Logical, KIND)) return fir::LogicalType::get(context, KIND); return {}; } -template <> -mlir::Type -genFIRType(mlir::MLIRContext *context, - int KIND) { +static mlir::Type genCharacterType(mlir::MLIRContext *context, int KIND) { if (Fortran::evaluate::IsValidKindOfIntrinsicType( Fortran::common::TypeCategory::Character, KIND)) return fir::CharacterType::get(context, KIND, 1); return {}; } -template <> -mlir::Type -genFIRType(mlir::MLIRContext *context, - int KIND) { +static mlir::Type genComplexType(mlir::MLIRContext *context, int KIND) { if (Fortran::evaluate::IsValidKindOfIntrinsicType( Fortran::common::TypeCategory::Complex, KIND)) return fir::ComplexType::get(context, KIND); return {}; } -namespace { - -/// Discover the type of an Fortran::evaluate::Expr and convert it to an -/// mlir::Type. The type returned may be an MLIR standard or FIR type. -class TypeBuilder { -public: - /// Constructor. - explicit TypeBuilder( - mlir::MLIRContext *context, - const Fortran::common::IntrinsicTypeDefaultKinds &defaults) - : context{context}, defaults{defaults} {} - - //===--------------------------------------------------------------------===// - // Generate type entry points - //===--------------------------------------------------------------------===// - - template