//===-- lib/Support/Fortran.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 // //===----------------------------------------------------------------------===// #include "flang/Support/Fortran.h" #include "flang/Support/Fortran-features.h" #include "llvm/Support/raw_ostream.h" namespace Fortran::common { const char *AsFortran(NumericOperator opr) { switch (opr) { SWITCH_COVERS_ALL_CASES case NumericOperator::Power: return "**"; case NumericOperator::Multiply: return "*"; case NumericOperator::Divide: return "/"; case NumericOperator::Add: return "+"; case NumericOperator::Subtract: return "-"; } } const char *AsFortran(LogicalOperator opr) { switch (opr) { SWITCH_COVERS_ALL_CASES case LogicalOperator::And: return ".and."; case LogicalOperator::Or: return ".or."; case LogicalOperator::Eqv: return ".eqv."; case LogicalOperator::Neqv: return ".neqv."; case LogicalOperator::Not: return ".not."; } } const char *AsFortran(RelationalOperator opr) { switch (opr) { SWITCH_COVERS_ALL_CASES case RelationalOperator::LT: return "<"; case RelationalOperator::LE: return "<="; case RelationalOperator::EQ: return "=="; case RelationalOperator::NE: return "/="; case RelationalOperator::GE: return ">="; case RelationalOperator::GT: return ">"; } } const char *AsFortran(DefinedIo x) { switch (x) { SWITCH_COVERS_ALL_CASES case DefinedIo::ReadFormatted: return "read(formatted)"; case DefinedIo::ReadUnformatted: return "read(unformatted)"; case DefinedIo::WriteFormatted: return "write(formatted)"; case DefinedIo::WriteUnformatted: return "write(unformatted)"; } } std::string AsFortran(IgnoreTKRSet tkr) { std::string result; if (tkr.test(IgnoreTKR::Type)) { result += 'T'; } if (tkr.test(IgnoreTKR::Kind)) { result += 'K'; } if (tkr.test(IgnoreTKR::Rank)) { result += 'R'; } if (tkr.test(IgnoreTKR::Device)) { result += 'D'; } if (tkr.test(IgnoreTKR::Managed)) { result += 'M'; } if (tkr.test(IgnoreTKR::Contiguous)) { result += 'C'; } if (tkr.test(IgnoreTKR::Pointer)) { result += 'P'; } return result; } /// Check compatibilty of CUDA attribute. /// When `allowUnifiedMatchingRule` is enabled, argument `x` represents the /// dummy argument attribute while `y` represents the actual argument attribute. bool AreCompatibleCUDADataAttrs(std::optional x, std::optional y, IgnoreTKRSet ignoreTKR, bool allowUnifiedMatchingRule, bool isHostDeviceProcedure, const LanguageFeatureControl *features) { bool isCudaManaged{features ? features->IsEnabled(common::LanguageFeature::CudaManaged) : false}; bool isCudaUnified{features ? features->IsEnabled(common::LanguageFeature::CudaUnified) : false}; if (ignoreTKR.test(common::IgnoreTKR::Device)) { return true; } // A use_device(...) actual is compatible only with a Device dummy or a // host dummy (no CUDA attribute); other attributes (Managed, Unified, // Pinned, ...) require the actual to live in that specific kind of memory. if (y && *y == CUDADataAttr::UseDevice) return !x || *x == CUDADataAttr::Device; if (!y && isHostDeviceProcedure) { return true; } if (!x && !y) { return true; } else if (x && y && *x == *y) { return true; } else if ((!x && y && *y == CUDADataAttr::Pinned) || (x && *x == CUDADataAttr::Pinned && !y)) { return true; } else if (ignoreTKR.test(IgnoreTKR::Device) && x.value_or(CUDADataAttr::Device) == CUDADataAttr::Device && y.value_or(CUDADataAttr::Device) == CUDADataAttr::Device) { return true; } else if (ignoreTKR.test(IgnoreTKR::Managed) && (!x || *x == CUDADataAttr::Managed || *x == CUDADataAttr::Unified) && (!y || *y == CUDADataAttr::Managed || *y == CUDADataAttr::Unified)) { return true; } else if (allowUnifiedMatchingRule) { if (!x) { // Dummy argument has no attribute -> host if ((y && (*y == CUDADataAttr::Managed || *y == CUDADataAttr::Unified)) || (!y && (isCudaUnified || isCudaManaged))) { return true; } } else { if (*x == CUDADataAttr::Device) { if (y && (*y == CUDADataAttr::Managed || *y == CUDADataAttr::Unified || *y == CUDADataAttr::Shared || *y == CUDADataAttr::Constant)) { return true; } // A device dummy carrying !dir$ ignore_tkr(m) opts out of the // -gpu=mem:{unified,managed} relaxation that would otherwise let // an unattributed host actual bind to it. The (m) letter is used // by host modules to mark device-typed dummies as overload // discriminators that should only accept actuals with an explicit // device/managed/unified attribute. if (!y && (isCudaUnified || isCudaManaged) && !ignoreTKR.test(IgnoreTKR::Managed)) { return true; } } else if (*x == CUDADataAttr::Managed) { if ((y && *y == CUDADataAttr::Unified) || (!y && (isCudaUnified || isCudaManaged))) { return true; } } else if (*x == CUDADataAttr::Unified) { if ((y && *y == CUDADataAttr::Managed) || (!y && (isCudaUnified || isCudaManaged))) { return true; } } } return false; } else { return false; } } std::string FormatVectorTypeAsFortran( int category, int64_t elementCategory, int64_t elementKind) { std::string buf; llvm::raw_string_ostream ss{buf}; switch (static_cast(category)) { case (VectorTypeCategory::IntrinsicVector): { CHECK(elementCategory >= 0 && elementKind > 0); ss << "vector("; switch (static_cast(elementCategory)) { case VectorElementCategory::Integer: ss << "integer(" << elementKind << ")"; break; case VectorElementCategory::Unsigned: ss << "unsigned(" << elementKind << ")"; break; case VectorElementCategory::Real: ss << "real(" << elementKind << ")"; break; } ss << ")"; break; } case (VectorTypeCategory::PairVector): ss << "__vector_pair"; break; case (VectorTypeCategory::QuadVector): ss << "__vector_quad"; break; default: CHECK(false && "Vector element type not implemented"); } return buf; } } // namespace Fortran::common