diff --git a/flang/include/flang/Evaluate/common.h b/flang/include/flang/Evaluate/common.h index d04c901929e74..c2c7711c4684e 100644 --- a/flang/include/flang/Evaluate/common.h +++ b/flang/include/flang/Evaluate/common.h @@ -256,9 +256,11 @@ class FoldingContext { const common::LanguageFeatureControl &languageFeatures() const { return languageFeatures_; } - bool inModuleFile() const { return inModuleFile_; } - FoldingContext &set_inModuleFile(bool yes = true) { - inModuleFile_ = yes; + std::optional moduleFileName() const { + return moduleFileName_; + } + FoldingContext &set_moduleFileName(std::optional n) { + moduleFileName_ = n; return *this; } @@ -288,7 +290,7 @@ class FoldingContext { const IntrinsicProcTable &intrinsics_; const TargetCharacteristics &targetCharacteristics_; const semantics::DerivedTypeSpec *pdtInstance_{nullptr}; - bool inModuleFile_{false}; + std::optional moduleFileName_; std::map impliedDos_; const common::LanguageFeatureControl &languageFeatures_; std::set &tempNames_; diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 7d721399072ca..0e14aa0957294 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -478,6 +478,14 @@ std::optional> NonPointerInitializationExpr(const Symbol &symbol, return {std::move(folded)}; } } else if (IsNamedConstant(symbol)) { + if (symbol.name() == "numeric_storage_size" && + symbol.owner().IsModule() && + DEREF(symbol.owner().symbol()).name() == "iso_fortran_env") { + // Very special case: numeric_storage_size is not folded until + // it read from the iso_fortran_env module file, as its value + // depends on compilation options. + return {std::move(folded)}; + } context.messages().Say( "Value of named constant '%s' (%s) cannot be computed as a constant value"_err_en_US, symbol.name(), folded.AsFortran()); diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h index 9dd8c3843465d..470dbe9e74099 100644 --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -1969,7 +1969,7 @@ Expr FoldOperation(FoldingContext &context, Divide &&x) { // NaN, and Inf respectively. bool isCanonicalNaNOrInf{false}; if constexpr (T::category == TypeCategory::Real) { - if (folded->second.IsZero() && context.inModuleFile()) { + if (folded->second.IsZero() && context.moduleFileName().has_value()) { using IntType = typename T::Scalar::Word; auto intNumerator{folded->first.template ToInteger()}; isCanonicalNaNOrInf = intNumerator.flags == RealFlags{} && diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp index 25ae4831ab208..0a6ff12049f30 100644 --- a/flang/lib/Evaluate/fold-integer.cpp +++ b/flang/lib/Evaluate/fold-integer.cpp @@ -1302,6 +1302,24 @@ Expr> FoldIntrinsicFunction( return FoldSum(context, std::move(funcRef)); } else if (name == "ubound") { return UBOUND(context, std::move(funcRef)); + } else if (name == "__builtin_numeric_storage_size") { + if (!context.moduleFileName()) { + // Don't fold this reference until it appears in the module file + // for ISO_FORTRAN_ENV -- the value depends on the compiler options + // that might be in force. + } else { + auto intBytes{ + context.targetCharacteristics().GetByteSize(TypeCategory::Integer, + context.defaults().GetDefaultKind(TypeCategory::Integer))}; + auto realBytes{ + context.targetCharacteristics().GetByteSize(TypeCategory::Real, + context.defaults().GetDefaultKind(TypeCategory::Real))}; + if (intBytes != realBytes) { + context.messages().Say(*context.moduleFileName(), + "NUMERIC_STORAGE_SIZE from ISO_FORTRAN_ENV is not well-defined when default INTEGER and REAL are not consistent due to compiler options"_warn_en_US); + } + return Expr{8 * std::min(intBytes, realBytes)}; + } } return Expr{std::move(funcRef)}; } diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 9b98d22cc58e5..7226d69f6391c 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -903,6 +903,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"back", AnyLogical, Rank::elemental, Optionality::optional}, DefaultingKIND}, KINDInt}, + {"__builtin_compiler_options", {}, DefaultChar}, + {"__builtin_compiler_version", {}, DefaultChar}, {"__builtin_fma", {{"f1", SameReal}, {"f2", SameReal}, {"f3", SameReal}}, SameReal}, {"__builtin_ieee_is_nan", {{"a", AnyFloating}}, DefaultLogical}, @@ -941,8 +943,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"__builtin_ieee_support_underflow_control", {{"x", AnyReal, Rank::elemental, Optionality::optional}}, DefaultLogical}, - {"__builtin_compiler_options", {}, DefaultChar}, - {"__builtin_compiler_version", {}, DefaultChar}, + {"__builtin_numeric_storage_size", {}, DefaultInt}, }; // TODO: Coarray intrinsic functions diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index 5d0d210fa3487..4a531c3c0f99f 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -1458,11 +1458,11 @@ Scope *ModFileReader::Read(SourceName name, std::optional isIntrinsic, parentScope = ancestor; } // Process declarations from the module file - bool wasInModuleFile{context_.foldingContext().inModuleFile()}; - context_.foldingContext().set_inModuleFile(true); + auto wasModuleFileName{context_.foldingContext().moduleFileName()}; + context_.foldingContext().set_moduleFileName(name); GetModuleDependences(context_.moduleDependences(), sourceFile->content()); ResolveNames(context_, parseTree, topScope); - context_.foldingContext().set_inModuleFile(wasInModuleFile); + context_.foldingContext().set_moduleFileName(wasModuleFileName); if (!moduleSymbol) { // Submodule symbols' storage are owned by their parents' scopes, // but their names are not in their parents' dictionaries -- we diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index c69c702ecae25..f0198cb792280 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -175,7 +175,9 @@ class BaseVisitor { } } - bool InModuleFile() const { return GetFoldingContext().inModuleFile(); } + bool InModuleFile() const { + return GetFoldingContext().moduleFileName().has_value(); + } // Make a placeholder symbol for a Name that otherwise wouldn't have one. // It is not in any scope and always has MiscDetails. diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90 index 23e22e1f64de6..6ca98e518aeac 100644 --- a/flang/module/iso_fortran_env.f90 +++ b/flang/module/iso_fortran_env.f90 @@ -6,8 +6,7 @@ ! !===------------------------------------------------------------------------===! -! See Fortran 2018, clause 16.10.2 -! TODO: These are placeholder values so that some tests can be run. +! See Fortran 2023, subclause 16.10.2 include '../include/flang/Runtime/magic-numbers.h' @@ -24,27 +23,20 @@ module iso_fortran_env compiler_version => __builtin_compiler_version implicit none - - ! Set PRIVATE by default to explicitly only export what is meant - ! to be exported by this MODULE. private public :: event_type, notify_type, lock_type, team_type, & atomic_int_kind, atomic_logical_kind, compiler_options, & compiler_version - - ! TODO: Use PACK([x],test) in place of the array constructor idiom - ! [(x, integer::j=1,COUNT([test]))] below once PACK() can be folded. - integer, parameter :: & selectedASCII = selected_char_kind('ASCII'), & selectedUCS_2 = selected_char_kind('UCS-2'), & selectedUnicode = selected_char_kind('ISO_10646') integer, parameter, public :: character_kinds(*) = [ & - [(selectedASCII, integer :: j=1, count([selectedASCII >= 0]))], & - [(selectedUCS_2, integer :: j=1, count([selectedUCS_2 >= 0]))], & - [(selectedUnicode, integer :: j=1, count([selectedUnicode >= 0]))]] + pack([selectedASCII], selectedASCII >= 0), & + pack([selectedUCS_2], selectedUCS_2 >= 0), & + pack([selectedUnicode], selectedUnicode >= 0)] integer, parameter :: & selectedInt8 = selected_int_kind(2), & @@ -76,19 +68,18 @@ module iso_fortran_env integer, parameter, public :: integer_kinds(*) = [ & selected_int_kind(0), & - ((selected_int_kind(k), & - integer :: j=1, count([selected_int_kind(k) >= 0 .and. & - selected_int_kind(k) /= & - selected_int_kind(k-1)])), & - integer :: k=1, 39)] + [(pack([selected_int_kind(k)], & + selected_int_kind(k) >= 0 .and. & + selected_int_kind(k) /= selected_int_kind(k-1)), & + integer :: k=1, 39)]] integer, parameter, public :: & logical8 = int8, logical16 = int16, logical32 = int32, logical64 = int64 integer, parameter, public :: logical_kinds(*) = [ & - [(logical8, integer :: j=1, count([logical8 >= 0]))], & - [(logical16, integer :: j=1, count([logical16 >= 0]))], & - [(logical32, integer :: j=1, count([logical32 >= 0]))], & - [(logical64, integer :: j=1, count([logical64 >= 0]))]] + pack([logical8], logical8 >= 0), & + pack([logical16], logical16 >= 0), & + pack([logical32], logical32 >= 0), & + pack([logical64], logical64 >= 0)] integer, parameter :: & selectedReal16 = selected_real_kind(3, 4), & ! IEEE half @@ -129,35 +120,40 @@ module iso_fortran_env digits(real(0,kind=safeReal128)) == 113) integer, parameter, public :: real_kinds(*) = [ & - [(real16, integer :: j=1, count([real16 >= 0]))], & - [(bfloat16, integer :: j=1, count([bfloat16 >= 0]))], & - [(real32, integer :: j=1, count([real32 >= 0]))], & - [(real64, integer :: j=1, count([real64 >= 0]))], & - [(real80, integer :: j=1, count([real80 >= 0]))], & - [(real64x2, integer :: j=1, count([real64x2 >= 0]))], & - [(real128, integer :: j=1, count([real128 >= 0]))]] - - integer, parameter, public :: current_team = -1, initial_team = -2, parent_team = -3 - - integer, parameter, public :: output_unit = FORTRAN_DEFAULT_OUTPUT_UNIT - integer, parameter, public :: input_unit = FORTRAN_DEFAULT_INPUT_UNIT - integer, parameter, public :: error_unit = FORTRAN_ERROR_UNIT - integer, parameter, public :: iostat_end = FORTRAN_RUNTIME_IOSTAT_END - integer, parameter, public :: iostat_eor = FORTRAN_RUNTIME_IOSTAT_EOR - integer, parameter, public :: iostat_inquire_internal_unit = & - FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT + pack([real16], real16 >= 0), & + pack([bfloat16], bfloat16 >= 0), & + pack([real32], real32 >= 0), & + pack([real64], real64 >= 0), & + pack([real80], real80 >= 0), & + pack([real64x2], real64x2 >= 0), & + pack([real128], real128 >= 0)] + + integer, parameter, public :: current_team = -1, & + initial_team = -2, & + parent_team = -3 integer, parameter, public :: character_storage_size = 8 integer, parameter, public :: file_storage_size = 8 - integer, parameter, public :: numeric_storage_size = 32 - integer, parameter, public :: stat_failed_image = FORTRAN_RUNTIME_STAT_FAILED_IMAGE - integer, parameter, public :: stat_locked = FORTRAN_RUNTIME_STAT_LOCKED - integer, parameter, public :: & - stat_locked_other_image = FORTRAN_RUNTIME_STAT_LOCKED_OTHER_IMAGE - integer, parameter, public :: stat_stopped_image = FORTRAN_RUNTIME_STAT_STOPPED_IMAGE - integer, parameter, public :: stat_unlocked = FORTRAN_RUNTIME_STAT_UNLOCKED + intrinsic :: __builtin_numeric_storage_size + ! This value depends on any -fdefault-integer-N and -fdefault-real-N + ! compiler options that are active when the module file is read. + integer, parameter, public :: numeric_storage_size = & + __builtin_numeric_storage_size() + + ! From Runtime/magic-numbers.h: integer, parameter, public :: & + output_unit = FORTRAN_DEFAULT_OUTPUT_UNIT, & + input_unit = FORTRAN_DEFAULT_INPUT_UNIT, & + error_unit = FORTRAN_ERROR_UNIT, & + iostat_end = FORTRAN_RUNTIME_IOSTAT_END, & + iostat_eor = FORTRAN_RUNTIME_IOSTAT_EOR, & + iostat_inquire_internal_unit = FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT, & + stat_failed_image = FORTRAN_RUNTIME_STAT_FAILED_IMAGE, & + stat_locked = FORTRAN_RUNTIME_STAT_LOCKED, & + stat_locked_other_image = FORTRAN_RUNTIME_STAT_LOCKED_OTHER_IMAGE, & + stat_stopped_image = FORTRAN_RUNTIME_STAT_STOPPED_IMAGE, & + stat_unlocked = FORTRAN_RUNTIME_STAT_UNLOCKED, & stat_unlocked_failed_image = FORTRAN_RUNTIME_STAT_UNLOCKED_FAILED_IMAGE end module iso_fortran_env diff --git a/flang/test/Semantics/numeric_storage_size.f90 b/flang/test/Semantics/numeric_storage_size.f90 new file mode 100644 index 0000000000000..720297c0feb30 --- /dev/null +++ b/flang/test/Semantics/numeric_storage_size.f90 @@ -0,0 +1,40 @@ +! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s --check-prefix=CHECK +! RUN: %flang_fc1 -fdebug-unparse -fdefault-integer-8 %s 2>&1 | FileCheck %s --check-prefix=CHECK-I8 +! RUN: %flang_fc1 -fdebug-unparse %s -fdefault-real-8 2>&1 | FileCheck %s --check-prefix=CHECK-R8 +! RUN: %flang_fc1 -fdebug-unparse %s -fdefault-integer-8 -fdefault-real-8 2>&1 | FileCheck %s --check-prefix=CHECK-I8-R8 + +use iso_fortran_env + +!CHECK-NOT: warning +!CHECK: nss = 32_4 +!CHECK-I8: warning: NUMERIC_STORAGE_SIZE from ISO_FORTRAN_ENV is not well-defined when default INTEGER and REAL are not consistent due to compiler options +!CHECK-I8: nss = 32_4 +!CHECK-R8: warning: NUMERIC_STORAGE_SIZE from ISO_FORTRAN_ENV is not well-defined when default INTEGER and REAL are not consistent due to compiler options +!CHECK-R8: nss = 32_4 +!CHECK-I8-R8: nss = 64_4 +integer, parameter :: nss = numeric_storage_size + +!CHECK: iss = 32_4 +!CHECK-I8: iss = 64_8 +!CHECK-R8: iss = 32_4 +!CHECK-I8-R8: iss = 64_8 +integer, parameter :: iss = storage_size(1) + +!CHECK: rss = 32_4 +!CHECK-I8: rss = 32_8 +!CHECK-R8: rss = 64_4 +!CHECK-I8-R8: rss = 64_8 +integer, parameter :: rss = storage_size(1.) + +!CHECK: zss = 64_4 +!CHECK-I8: zss = 64_8 +!CHECK-R8: zss = 128_4 +!CHECK-I8-R8: zss = 128_8 +integer, parameter :: zss = storage_size((1.,0.)) + +!CHECK: lss = 32_4 +!CHECK-I8: lss = 64_8 +!CHECK-R8: lss = 32_4 +!CHECK-I8-R8: lss = 64_8 +integer, parameter :: lss = storage_size(.true.) +end diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt index 3a31f4df1607a..e266055a4bf01 100644 --- a/flang/tools/f18/CMakeLists.txt +++ b/flang/tools/f18/CMakeLists.txt @@ -17,8 +17,6 @@ set(MODULES "ieee_features" "iso_c_binding" "iso_fortran_env" - "__fortran_builtins" - "__fortran_type_info" ) # Create module files directly from the top-level module source directory. @@ -27,22 +25,20 @@ set(MODULES # can't be used for generating module files. if (NOT CMAKE_CROSSCOMPILING) foreach(filename ${MODULES}) - set(base ${FLANG_INTRINSIC_MODULES_DIR}/${filename}) - if(${filename} STREQUAL "__fortran_builtins") - set(depends "") - elseif(${filename} STREQUAL "__ppc_types") - set(depends "") + set(depends "") + if(${filename} STREQUAL "__fortran_builtins" OR + ${filename} STREQUAL "__ppc_types") elseif(${filename} STREQUAL "__ppc_intrinsics" OR ${filename} STREQUAL "mma") set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__ppc_types.mod) else() set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_builtins.mod) if(NOT ${filename} STREQUAL "__fortran_type_info") - set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_type_info.mod) + set(depends ${depends} ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_type_info.mod) endif() if(${filename} STREQUAL "ieee_arithmetic" OR ${filename} STREQUAL "ieee_exceptions") - set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_ieee_exceptions.mod) + set(depends ${depends} ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_ieee_exceptions.mod) endif() endif() @@ -58,6 +54,7 @@ if (NOT CMAKE_CROSSCOMPILING) endif() endif() + set(base ${FLANG_INTRINSIC_MODULES_DIR}/${filename}) # TODO: We may need to flag this with conditional, in case Flang is built w/o OpenMP support add_custom_command(OUTPUT ${base}.mod COMMAND ${CMAKE_COMMAND} -E make_directory ${FLANG_INTRINSIC_MODULES_DIR}