Skip to content

[flang] Clean up ISO_FORTRAN_ENV, fix NUMERIC_STORAGE_SIZE #87566

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Apr 8, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 6 additions & 4 deletions flang/include/flang/Evaluate/common.h
Original file line number Diff line number Diff line change
Expand Up @@ -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<parser::CharBlock> moduleFileName() const {
return moduleFileName_;
}
FoldingContext &set_moduleFileName(std::optional<parser::CharBlock> n) {
moduleFileName_ = n;
return *this;
}

Expand Down Expand Up @@ -288,7 +290,7 @@ class FoldingContext {
const IntrinsicProcTable &intrinsics_;
const TargetCharacteristics &targetCharacteristics_;
const semantics::DerivedTypeSpec *pdtInstance_{nullptr};
bool inModuleFile_{false};
std::optional<parser::CharBlock> moduleFileName_;
std::map<parser::CharBlock, ConstantSubscript> impliedDos_;
const common::LanguageFeatureControl &languageFeatures_;
std::set<std::string> &tempNames_;
Expand Down
8 changes: 8 additions & 0 deletions flang/lib/Evaluate/check-expression.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -478,6 +478,14 @@ std::optional<Expr<SomeType>> 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());
Expand Down
2 changes: 1 addition & 1 deletion flang/lib/Evaluate/fold-implementation.h
Original file line number Diff line number Diff line change
Expand Up @@ -1969,7 +1969,7 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&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<IntType>()};
isCanonicalNaNOrInf = intNumerator.flags == RealFlags{} &&
Expand Down
18 changes: 18 additions & 0 deletions flang/lib/Evaluate/fold-integer.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -1302,6 +1302,24 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return FoldSum<T>(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<T>{8 * std::min(intBytes, realBytes)};
}
}
return Expr<T>{std::move(funcRef)};
}
Expand Down
5 changes: 3 additions & 2 deletions flang/lib/Evaluate/intrinsics.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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},
Expand Down Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions flang/lib/Semantics/mod-file.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -1458,11 +1458,11 @@ Scope *ModFileReader::Read(SourceName name, std::optional<bool> 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
Expand Down
4 changes: 3 additions & 1 deletion flang/lib/Semantics/resolve-names.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
86 changes: 41 additions & 45 deletions flang/module/iso_fortran_env.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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'

Expand All @@ -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), &
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
40 changes: 40 additions & 0 deletions flang/test/Semantics/numeric_storage_size.f90
Original file line number Diff line number Diff line change
@@ -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
15 changes: 6 additions & 9 deletions flang/tools/f18/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -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()

Expand All @@ -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}
Expand Down