Index: flang/include/flang/Evaluate/target.h =================================================================== --- flang/include/flang/Evaluate/target.h +++ flang/include/flang/Evaluate/target.h @@ -14,6 +14,7 @@ #include "flang/Common/Fortran.h" #include "flang/Evaluate/common.h" +#include "llvm/ADT/Triple.h" #include namespace Fortran::evaluate { @@ -34,7 +35,7 @@ class TargetCharacteristics { public: - TargetCharacteristics(); + TargetCharacteristics(std::string triple); TargetCharacteristics &operator=(const TargetCharacteristics &) = default; bool isBigEndian() const { return isBigEndian_; } @@ -58,6 +59,8 @@ std::size_t maxByteSize() const { return maxByteSize_; } std::size_t maxAlignment() const { return maxAlignment_; } + static bool IsTargetValidType( + common::TypeCategory, std::int64_t kind, llvm::Triple &targetTriple); static bool CanSupportType(common::TypeCategory, std::int64_t kind); bool EnableType(common::TypeCategory category, std::int64_t kind, std::size_t byteSize, std::size_t align); Index: flang/include/flang/Semantics/semantics.h =================================================================== --- flang/include/flang/Semantics/semantics.h +++ flang/include/flang/Semantics/semantics.h @@ -64,7 +64,8 @@ class SemanticsContext { public: SemanticsContext(const common::IntrinsicTypeDefaultKinds &, - const common::LanguageFeatureControl &, parser::AllCookedSources &); + const common::LanguageFeatureControl &, parser::AllCookedSources &, + const evaluate::TargetCharacteristics &); ~SemanticsContext(); const common::IntrinsicTypeDefaultKinds &defaultKinds() const { Index: flang/lib/Evaluate/target.cpp =================================================================== --- flang/lib/Evaluate/target.cpp +++ flang/lib/Evaluate/target.cpp @@ -10,16 +10,16 @@ #include "flang/Common/template.h" #include "flang/Evaluate/common.h" #include "flang/Evaluate/type.h" +#include "llvm/Support/Host.h" namespace Fortran::evaluate { Rounding TargetCharacteristics::defaultRounding; -TargetCharacteristics::TargetCharacteristics() { - // TODO: Fill in the type information from command-line targeting information. - auto enableCategoryKinds{[this](TypeCategory category) { +TargetCharacteristics::TargetCharacteristics(std::string triple) { + auto enableCategoryKinds{[this](TypeCategory category, llvm::Triple tpl) { for (int kind{0}; kind < maxKind; ++kind) { - if (CanSupportType(category, kind)) { + if (IsTargetValidType(category, kind, tpl)) { auto byteSize{static_cast(kind)}; if (category == TypeCategory::Real || category == TypeCategory::Complex) { @@ -40,17 +40,39 @@ } } }}; - enableCategoryKinds(TypeCategory::Integer); - enableCategoryKinds(TypeCategory::Real); - enableCategoryKinds(TypeCategory::Complex); - enableCategoryKinds(TypeCategory::Character); - enableCategoryKinds(TypeCategory::Logical); + if (triple.empty()) { + triple = llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()); + } + llvm::Triple targetTriple{llvm::Triple(triple)}; + enableCategoryKinds(TypeCategory::Integer, targetTriple); + enableCategoryKinds(TypeCategory::Real, targetTriple); + enableCategoryKinds(TypeCategory::Complex, targetTriple); + enableCategoryKinds(TypeCategory::Character, targetTriple); + enableCategoryKinds(TypeCategory::Logical, targetTriple); isBigEndian_ = !isHostLittleEndian; areSubnormalsFlushedToZero_ = false; } +bool TargetCharacteristics::IsTargetValidType( + TypeCategory category, std::int64_t kind, llvm::Triple &targetTriple) { + // FIXME: Handle real(3) ? + if (category == TypeCategory::Real && kind == 10) { + switch (targetTriple.getArch()) { + default: + break; + case llvm::Triple::ArchType::x86: + case llvm::Triple::ArchType::x86_64: + return true; + case llvm::Triple::ArchType::aarch64: + case llvm::Triple::ArchType::ppc64le: + return false; + } + } + return IsValidKindOfIntrinsicType(category, kind); +} + bool TargetCharacteristics::CanSupportType( TypeCategory category, std::int64_t kind) { return IsValidKindOfIntrinsicType(category, kind); Index: flang/lib/Frontend/CompilerInvocation.cpp =================================================================== --- flang/lib/Frontend/CompilerInvocation.cpp +++ flang/lib/Frontend/CompilerInvocation.cpp @@ -12,6 +12,7 @@ #include "flang/Frontend/CompilerInvocation.h" #include "flang/Common/Fortran-features.h" +#include "flang/Evaluate/target.h" #include "flang/Frontend/CodeGenOptions.h" #include "flang/Frontend/PreprocessorOptions.h" #include "flang/Frontend/TargetOptions.h" @@ -816,9 +817,10 @@ void CompilerInvocation::setSemanticsOpts( Fortran::parser::AllCookedSources &allCookedSources) { const auto &fortranOptions = getFortranOpts(); + Fortran::evaluate::TargetCharacteristics target(this->targetOpts.triple); semanticsContext = std::make_unique( - getDefaultKinds(), fortranOptions.features, allCookedSources); + getDefaultKinds(), fortranOptions.features, allCookedSources, target); semanticsContext->set_moduleDirectory(getModuleDir()) .set_searchDirectories(fortranOptions.searchDirectories) Index: flang/lib/Semantics/semantics.cpp =================================================================== --- flang/lib/Semantics/semantics.cpp +++ flang/lib/Semantics/semantics.cpp @@ -284,12 +284,14 @@ SemanticsContext::SemanticsContext( const common::IntrinsicTypeDefaultKinds &defaultKinds, const common::LanguageFeatureControl &languageFeatures, - parser::AllCookedSources &allCookedSources) + parser::AllCookedSources &allCookedSources, + const evaluate::TargetCharacteristics &target) : defaultKinds_{defaultKinds}, languageFeatures_{languageFeatures}, allCookedSources_{allCookedSources}, intrinsics_{evaluate::IntrinsicProcTable::Configure(defaultKinds_)}, - globalScope_{*this}, intrinsicModulesScope_{globalScope_.MakeScope( - Scope::Kind::IntrinsicModules, nullptr)}, + targetCharacteristics_{target}, globalScope_{*this}, + intrinsicModulesScope_{ + globalScope_.MakeScope(Scope::Kind::IntrinsicModules, nullptr)}, foldingContext_{parser::ContextualMessages{&messages_}, defaultKinds_, intrinsics_, targetCharacteristics_} {} Index: flang/module/__fortran_ieee_exceptions.f90 =================================================================== --- flang/module/__fortran_ieee_exceptions.f90 +++ flang/module/__fortran_ieee_exceptions.f90 @@ -43,15 +43,25 @@ ! Define specifics with 1 LOGICAL or REAL argument for generic G. #define SPECIFICS_L(G) \ G(1) G(2) G(4) G(8) +#if __x86_64__ #define SPECIFICS_R(G) \ G(2) G(3) G(4) G(8) G(10) G(16) +#else +#define SPECIFICS_R(G) \ + G(2) G(3) G(4) G(8) G(16) +#endif ! Set PRIVATE accessibility for specifics with 1 LOGICAL or REAL argument for ! generic G. #define PRIVATE_L(G) private :: \ G##_l1, G##_l2, G##_l4, G##_l8 +#if __x86_64__ #define PRIVATE_R(G) private :: \ G##_a2, G##_a3, G##_a4, G##_a8, G##_a10, G##_a16 +#else +#define PRIVATE_R(G) private :: \ + G##_a2, G##_a3, G##_a4, G##_a8, G##_a16 +#endif interface ieee_get_flag elemental subroutine ieee_get_flag_0(flag, flag_value) Index: flang/module/ieee_arithmetic.f90 =================================================================== --- flang/module/ieee_arithmetic.f90 +++ flang/module/ieee_arithmetic.f90 @@ -99,14 +99,20 @@ G(1) G(2) G(4) G(8) G(16) #define SPECIFICS_L(G) \ G(1) G(2) G(4) G(8) +#if __x86_64__ #define SPECIFICS_R(G) \ G(2) G(3) G(4) G(8) G(10) G(16) +#else +#define SPECIFICS_R(G) \ + G(2) G(3) G(4) G(8) G(16) +#endif #define SPECIFICS_II(G) \ G(1,1) G(1,2) G(1,4) G(1,8) G(1,16) \ G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \ G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \ G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \ G(16,1) G(16,2) G(16,4) G(16,8) G(16,16) +#if __x86_64__ #define SPECIFICS_RI(G) \ G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \ G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \ @@ -114,6 +120,16 @@ G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \ G(10,1) G(10,2) G(10,4) G(10,8) G(10,16) \ G(16,1) G(16,2) G(16,4) G(16,8) G(16,16) +#else +#define SPECIFICS_RI(G) \ + G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \ + G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \ + G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \ + G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \ + G(16,1) G(16,2) G(16,4) G(16,8) G(16,16) +#endif + +#if __x86_64__ #define SPECIFICS_RR(G) \ G(2,2) G(2,3) G(2,4) G(2,8) G(2,10) G(2,16) \ G(3,2) G(3,3) G(3,4) G(3,8) G(3,10) G(3,16) \ @@ -121,6 +137,14 @@ G(8,2) G(8,3) G(8,4) G(8,8) G(8,10) G(8,16) \ G(10,2) G(10,3) G(10,4) G(10,8) G(10,10) G(10,16) \ G(16,2) G(16,3) G(16,4) G(16,8) G(16,10) G(16,16) +#else +#define SPECIFICS_RR(G) \ + G(2,2) G(2,3) G(2,4) G(2,8) G(2,16) \ + G(3,2) G(3,3) G(3,4) G(3,8) G(3,16) \ + G(4,2) G(4,3) G(4,4) G(4,8) G(4,16) \ + G(8,2) G(8,3) G(8,4) G(8,8) G(8,16) \ + G(16,2) G(16,3) G(16,4) G(16,8) G(16,16) +#endif ! Set PRIVATE accessibility for specifics with 1 or 2 INTEGER, LOGICAL, or REAL ! arguments for generic G. @@ -128,14 +152,20 @@ G##_i1, G##_i2, G##_i4, G##_i8, G##_i16 #define PRIVATE_L(G) private :: \ G##_l1, G##_l2, G##_l4, G##_l8 +#if __x86_64__ #define PRIVATE_R(G) private :: \ G##_a2, G##_a3, G##_a4, G##_a8, G##_a10, G##_a16 +#else +#define PRIVATE_R(G) private :: \ + G##_a2, G##_a3, G##_a4, G##_a8, G##_a16 +#endif #define PRIVATE_II(G) private :: \ G##_i1_i1, G##_i1_i2, G##_i1_i4, G##_i1_i8, G##_i1_i16, \ G##_i2_i1, G##_i2_i2, G##_i2_i4, G##_i2_i8, G##_i2_i16, \ G##_i4_i1, G##_i4_i2, G##_i4_i4, G##_i4_i8, G##_i4_i16, \ G##_i8_i1, G##_i8_i2, G##_i8_i4, G##_i8_i8, G##_i8_i16, \ G##_i16_i1, G##_i16_i2, G##_i16_i4, G##_i16_i8, G##_i16_i16 +#if __x86_64__ #define PRIVATE_RI(G) private :: \ G##_a2_i1, G##_a2_i2, G##_a2_i4, G##_a2_i8, G##_a2_i16, \ G##_a3_i1, G##_a3_i2, G##_a3_i4, G##_a3_i8, G##_a3_i16, \ @@ -143,6 +173,15 @@ G##_a8_i1, G##_a8_i2, G##_a8_i4, G##_a8_i8, G##_a8_i16, \ G##_a10_i1, G##_a10_i2, G##_a10_i4, G##_a10_i8, G##_a10_i16, \ G##_a16_i1, G##_a16_i2, G##_a16_i4, G##_a16_i8, G##_a16_i16 +#else +#define PRIVATE_RI(G) private :: \ + G##_a2_i1, G##_a2_i2, G##_a2_i4, G##_a2_i8, G##_a2_i16, \ + G##_a3_i1, G##_a3_i2, G##_a3_i4, G##_a3_i8, G##_a3_i16, \ + G##_a4_i1, G##_a4_i2, G##_a4_i4, G##_a4_i8, G##_a4_i16, \ + G##_a8_i1, G##_a8_i2, G##_a8_i4, G##_a8_i8, G##_a8_i16, \ + G##_a16_i1, G##_a16_i2, G##_a16_i4, G##_a16_i8, G##_a16_i16 +#endif +#if __x86_64__ #define PRIVATE_RR(G) private :: \ G##_a2_a2, G##_a2_a3, G##_a2_a4, G##_a2_a8, G##_a2_a10, G##_a2_a16, \ G##_a3_a2, G##_a3_a3, G##_a3_a4, G##_a3_a8, G##_a3_a10, G##_a3_a16, \ @@ -150,6 +189,14 @@ G##_a8_a2, G##_a8_a3, G##_a8_a4, G##_a8_a8, G##_a8_a10, G##_a8_a16, \ G##_a10_a2, G##_a10_a3, G##_a10_a4, G##_a10_a8, G##_a10_a10, G##_a10_a16, \ G##_a16_a2, G##_a16_a3, G##_a16_a4, G##_a16_a8, G##_a16_a10, G##_a16_a16 +#else +#define PRIVATE_RR(G) private :: \ + G##_a2_a2, G##_a2_a3, G##_a2_a4, G##_a2_a8, G##_a2_a16, \ + G##_a3_a2, G##_a3_a3, G##_a3_a4, G##_a3_a8, G##_a3_a16, \ + G##_a4_a2, G##_a4_a3, G##_a4_a4, G##_a4_a8, G##_a4_a16, \ + G##_a8_a2, G##_a8_a3, G##_a8_a4, G##_a8_a8, G##_a8_a16, \ + G##_a16_a2, G##_a16_a3, G##_a16_a4, G##_a16_a8, G##_a16_a16 +#endif #define IEEE_CLASS_R(XKIND) \ elemental type(ieee_class_type) function ieee_class_a##XKIND(x); \ Index: flang/test/Evaluate/folding07.f90 =================================================================== --- flang/test/Evaluate/folding07.f90 +++ flang/test/Evaluate/folding07.f90 @@ -25,9 +25,11 @@ real(8), parameter :: & eps8 = epsilon(0._8), zeps8 = real(z'3cb0000000000000', kind=8), & deps8 = 2.2204460492503130808472633361816406250e-16_8 +#if __x86_64__ real(10), parameter :: & eps10 = epsilon(0._10), zeps10 = real(z'3fc08000000000000000', kind=10), & deps10 = 1.08420217248550443400745280086994171142578125e-19_10 +#endif real(16), parameter :: & eps16 = epsilon(0._16), & zeps16 = real(z'3f8f0000000000000000000000000000', kind=16), & @@ -36,7 +38,9 @@ logical, parameter :: test_eps3 = eps3 == zeps3 .and. eps3 == deps3 logical, parameter :: test_eps4 = eps4 == zeps4 .and. eps4 == deps4 logical, parameter :: test_eps8 = eps8 == zeps8 .and. eps8 == deps8 +#if __x86_64__ logical, parameter :: test_eps10 = eps10 == zeps10 .and. eps10 == deps10 +#endif logical, parameter :: test_eps16 = eps16 == zeps16 .and. eps16 == deps16 integer(1), parameter :: & @@ -73,6 +77,7 @@ &1540458953514382464234321326889464182768467546703537516986049910576551282076245490090389328944075868& &5084551339423045832369032229481658085593321233482747978262041447231687381771809192998812504040261841& &24858368e308_8 +#if __x86_64__ real(10), parameter :: & ahuge10 = huge(0._10), zahuge10 = real(z'7ffeffffffffffffffff', kind=10), & dahuge10 = 1.1897314953572317650212638530309702051690633222946242004403237338917370055229707226164102903365288828& @@ -125,6 +130,7 @@ &8416350972529537091114317204887747405539054009425375424119317944175137064689643861517718849867010341& &5325423859110896247108853858086888377772586485641459342621210866475884892600317623459607695088491496& &6244415660441955208681198977024e4932_10 +#endif real(16), parameter :: & ahuge16 = huge(0._16), zahuge16 = real(z'7ffeffffffffffffffffffffffffffff', kind=16), & dahuge16 = 1.1897314953572317650857593266280070161964690526416940455296988842121635797553123923249740128484620735& @@ -181,20 +187,26 @@ logical, parameter :: test_ahuge3 = ahuge3 == zahuge3 .and. ahuge3 == dahuge3 logical, parameter :: test_ahuge4 = ahuge4 == zahuge4 .and. ahuge4 == dahuge4 logical, parameter :: test_ahuge8 = ahuge8 == zahuge8 .and. ahuge8 == dahuge8 +#if __x86_64__ logical, parameter :: test_ahuge10 = ahuge10 == zahuge10 .and. ahuge10 == dahuge10 +#endif logical, parameter :: test_ahuge16 = ahuge16 == zahuge16 .and. ahuge16 == dahuge16 real(2), parameter :: tiny2 = tiny(0._2), ztiny2 = real(z'0400', kind=2) real(3), parameter :: tiny3 = tiny(0._3), ztiny3 = real(z'0080', kind=3) real(4), parameter :: tiny4 = tiny(0._4), ztiny4 = real(z'00800000', kind=4) real(8), parameter :: tiny8 = tiny(0._8), ztiny8 = real(z'0010000000000000', kind=8) +#if __x86_64__ real(10), parameter :: tiny10 = tiny(0._10), ztiny10 = real(z'00018000000000000000', kind=10) +#endif real(16), parameter :: tiny16 = tiny(0._16), ztiny16 = real(z'00010000000000000000000000000000', kind=16) logical, parameter :: test_tiny2 = tiny2 == ztiny2 logical, parameter :: test_tiny3 = tiny3 == ztiny3 logical, parameter :: test_tiny4 = tiny4 == ztiny4 logical, parameter :: test_tiny8 = tiny8 == ztiny8 +#if __x86_64__ logical, parameter :: test_tiny10 = tiny10 == ztiny10 +#endif logical, parameter :: test_tiny16 = tiny16 == ztiny16 real, parameter :: nan = real(z'7fc12345') @@ -222,13 +234,17 @@ max3 = maxexponent(0._3), & max4 = maxexponent(0._4), & max8 = maxexponent(0._8), & - max10 = maxexponent(0._10), & max16 = maxexponent(0._16) +#if __x86_64__ + integer, parameter :: max10 = maxexponent(0._10) +#endif logical, parameter :: test_max2 = max2 == 16 logical, parameter :: test_max3 = max3 == 128 logical, parameter :: test_max4 = max4 == 128 logical, parameter :: test_max8 = max8 == 1024 +#if __x86_64__ logical, parameter :: test_max10 = max10 == 16384 +#endif logical, parameter :: test_max16 = max16 == 16384 integer, parameter :: & @@ -236,13 +252,17 @@ min3 = minexponent(0._3), & min4 = minexponent(0._4), & min8 = minexponent(0._8), & - min10 = minexponent(0._10), & min16 = minexponent(0._16) +#if __x86_64__ + integer, parameter :: min10 = minexponent(0._10) +#endif logical, parameter :: test_min2 = min2 == -13 logical, parameter :: test_min3 = min3 == -125 logical, parameter :: test_min4 = min4 == -125 logical, parameter :: test_min8 = min8 == -1021 +#if __x86_64__ logical, parameter :: test_min10 = min10 == -16381 +#endif logical, parameter :: test_min16 = min16 == -16381 integer, parameter :: & @@ -262,13 +282,18 @@ arange3 = range(0._3), zrange3 = range((0._3, 0._3)), & arange4 = range(0._4), zrange4 = range((0._4, 0._4)), & arange8 = range(0._8), zrange8 = range((0._8, 0._8)), & - arange10 = range(0._10), zrange10 = range((0._10, 0._10)), & arange16 = range(0._16), zrange16 = range((0._16, 0._16)) +#if __x86_64__ + integer, parameter :: arange10 = & + range(0._10), zrange10 = range((0._10, 0._10)) +#endif logical, parameter :: test_arange2 = arange2 == 4 .and. zrange2 == 4 logical, parameter :: test_arange3 = arange3 == 37 .and. zrange3 == 37 logical, parameter :: test_zrange4 = arange4 == 37 .and. zrange4 == 37 logical, parameter :: test_zrange8 = arange8 == 307 .and. zrange8 == 307 +#if __x86_64__ logical, parameter :: test_zrange10 = arange10 == 4931 .and. zrange10 == 4931 +#endif logical, parameter :: test_zrange16 = arange16 == 4931 .and. zrange16 == 4931 logical, parameter :: test_set_exponent_z = set_exponent(0., 999) == 0. Index: flang/test/Semantics/kinds03.f90 =================================================================== --- flang/test/Semantics/kinds03.f90 +++ flang/test/Semantics/kinds03.f90 @@ -60,9 +60,6 @@ !DEF: /MainProgram1/a8 ObjectEntity TYPE(rpdt(k=8_4)) type(rpdt(8)) :: a8 !REF: /MainProgram1/rpdt - !DEF: /MainProgram1/a10 ObjectEntity TYPE(rpdt(k=10_4)) - type(rpdt(10)) :: a10 - !REF: /MainProgram1/rpdt !DEF: /MainProgram1/a16 ObjectEntity TYPE(rpdt(k=16_4)) type(rpdt(16)) :: a16 !REF: /MainProgram1/zpdt @@ -75,9 +72,6 @@ !DEF: /MainProgram1/z8 ObjectEntity TYPE(zpdt(k=8_4)) type(zpdt(8)) :: z8 !REF: /MainProgram1/zpdt - !DEF: /MainProgram1/z10 ObjectEntity TYPE(zpdt(k=10_4)) - type(zpdt(10)) :: z10 - !REF: /MainProgram1/zpdt !DEF: /MainProgram1/z16 ObjectEntity TYPE(zpdt(k=16_4)) type(zpdt(16)) :: z16 !REF: /MainProgram1/lpdt Index: flang/test/Semantics/modfile26.f90 =================================================================== --- flang/test/Semantics/modfile26.f90 +++ flang/test/Semantics/modfile26.f90 @@ -3,7 +3,7 @@ ! RADIX, DIGITS module m1 - ! INTEGER(KIND=1) handles 0 <= P < 3 + ! INTEGER(KIND=1) handles P < 3 ! INTEGER(KIND=2) handles 3 <= P < 5 ! INTEGER(KIND=4) handles 5 <= P < 10 ! INTEGER(KIND=8) handles 10 <= P < 19 @@ -17,50 +17,46 @@ logical, parameter :: ipcheck = & all([1, 1, 2, 2, 4, 4, 8, 8, 16, 16, -1] == intpkinds) - ! REAL(KIND=2) handles 0 <= P < 4 (if available) - ! REAL(KIND=3) handles 0 <= P < 3 (if available) + ! REAL(KIND=2) handles P < 4 (if available) + ! REAL(KIND=3) handles P < 3 (if available) ! REAL(KIND=4) handles 4 <= P < 7 ! REAL(KIND=8) handles 7 <= P < 16 - ! REAL(KIND=10) handles 16 <= P < 19 (if available; ifort is KIND=16) ! REAL(KIND=16) handles 19 <= P < 34 (would be 32 with Power double/double) integer, parameter :: realprecs(*) = & [precision(0._2), precision(0._3), precision(0._4), precision(0._8), & - precision(0._10), precision(0._16)] - logical, parameter :: rpreccheck = all([3, 2, 6, 15, 18, 33] == realprecs) - integer, parameter :: realpvals(*) = [0, 3, 4, 6, 7, 15, 16, 18, 19, 33, 34] + precision(0._16)] + logical, parameter :: rpreccheck = all([3, 2, 6, 15, 33] == realprecs) + integer, parameter :: realpvals(*) = [0, 3, 4, 6, 7, 15, 19, 33, 34] integer, parameter :: realpkinds(*) = & [(selected_real_kind(realpvals(j),0),j=1,size(realpvals))] logical, parameter :: realpcheck = & - all([2, 2, 4, 4, 8, 8, 10, 10, 16, 16, -1] == realpkinds) - ! REAL(KIND=2) handles 0 <= R < 5 (if available) + all([2, 2, 4, 4, 8, 8, 16, 16, -1] == realpkinds) + ! REAL(KIND=2) handles R < 5 (if available) ! REAL(KIND=3) handles 5 <= R < 38 (if available, same range as KIND=4) ! REAL(KIND=4) handles 5 <= R < 38 (if no KIND=3) ! REAL(KIND=8) handles 38 <= R < 308 - ! REAL(KIND=10) handles 308 <= R < 4932 (if available; ifort is KIND=16) ! REAL(KIND=16) handles 308 <= R < 4932 (except Power double/double) integer, parameter :: realranges(*) = & - [range(0._2), range(0._3), range(0._4), range(0._8), range(0._10), & - range(0._16)] + [range(0._2), range(0._3), range(0._4), range(0._8), range(0._16)] logical, parameter :: rrangecheck = & - all([4, 37, 37, 307, 4931, 4931] == realranges) + all([4, 37, 37, 307, 4931] == realranges) integer, parameter :: realrvals(*) = & - [0, 4, 5, 37, 38, 307, 308, 4931, 4932] + [0, 4, 5, 37, 38, 307, 4932] integer, parameter :: realrkinds(*) = & [(selected_real_kind(0,realrvals(j)),j=1,size(realrvals))] logical, parameter :: realrcheck = & - all([2, 2, 3, 3, 8, 8, 10, 10, -2] == realrkinds) + all([2, 2, 3, 3, 8, 8, -2] == realrkinds) logical, parameter :: radixcheck = & all([radix(0._2), radix(0._3), radix(0._4), radix(0._8), & - radix(0._10), radix(0._16)] == 2) + radix(0._16)] == 2) integer, parameter :: intdigits(*) = & [digits(0_1), digits(0_2), digits(0_4), digits(0_8), digits(0_16)] logical, parameter :: intdigitscheck = & all([7, 15, 31, 63, 127] == intdigits) integer, parameter :: realdigits(*) = & - [digits(0._2), digits(0._3), digits(0._4), digits(0._8), digits(0._10), & - digits(0._16)] + [digits(0._2), digits(0._3), digits(0._4), digits(0._8), digits(0._16)] logical, parameter :: realdigitscheck = & - all([11, 8, 24, 53, 64, 113] == realdigits) + all([11, 8, 24, 53, 113] == realdigits) end module m1 !Expect: m1.mod !module m1 @@ -73,23 +69,23 @@ !intrinsic::selected_int_kind !intrinsic::size !logical(4),parameter::ipcheck=.true._4 -!integer(4),parameter::realprecs(1_8:*)=[INTEGER(4)::3_4,2_4,6_4,15_4,18_4,33_4] +!integer(4),parameter::realprecs(1_8:*)=[INTEGER(4)::3_4,2_4,6_4,15_4,33_4] !intrinsic::precision !logical(4),parameter::rpreccheck=.true._4 -!integer(4),parameter::realpvals(1_8:*)=[INTEGER(4)::0_4,3_4,4_4,6_4,7_4,15_4,16_4,18_4,19_4,33_4,34_4] -!integer(4),parameter::realpkinds(1_8:*)=[INTEGER(4)::2_4,2_4,4_4,4_4,8_4,8_4,10_4,10_4,16_4,16_4,-1_4] +!integer(4),parameter::realpvals(1_8:*)=[INTEGER(4)::0_4,3_4,4_4,6_4,7_4,15_4,19_4,33_4,34_4] +!integer(4),parameter::realpkinds(1_8:*)=[INTEGER(4)::2_4,2_4,4_4,4_4,8_4,8_4,16_4,16_4,-1_4] !intrinsic::selected_real_kind !logical(4),parameter::realpcheck=.true._4 -!integer(4),parameter::realranges(1_8:*)=[INTEGER(4)::4_4,37_4,37_4,307_4,4931_4,4931_4] +!integer(4),parameter::realranges(1_8:*)=[INTEGER(4)::4_4,37_4,37_4,307_4,4931_4] !logical(4),parameter::rrangecheck=.true._4 -!integer(4),parameter::realrvals(1_8:*)=[INTEGER(4)::0_4,4_4,5_4,37_4,38_4,307_4,308_4,4931_4,4932_4] -!integer(4),parameter::realrkinds(1_8:*)=[INTEGER(4)::2_4,2_4,3_4,3_4,8_4,8_4,10_4,10_4,-2_4] +!integer(4),parameter::realrvals(1_8:*)=[INTEGER(4)::0_4,4_4,5_4,37_4,38_4,307_4,4932_4] +!integer(4),parameter::realrkinds(1_8:*)=[INTEGER(4)::2_4,2_4,3_4,3_4,8_4,8_4,-2_4] !logical(4),parameter::realrcheck=.true._4 !logical(4),parameter::radixcheck=.true._4 !intrinsic::radix !integer(4),parameter::intdigits(1_8:*)=[INTEGER(4)::7_4,15_4,31_4,63_4,127_4] !intrinsic::digits !logical(4),parameter::intdigitscheck=.true._4 -!integer(4),parameter::realdigits(1_8:*)=[INTEGER(4)::11_4,8_4,24_4,53_4,64_4,113_4] +!integer(4),parameter::realdigits(1_8:*)=[INTEGER(4)::11_4,8_4,24_4,53_4,113_4] !logical(4),parameter::realdigitscheck=.true._4 !end Index: flang/test/Semantics/real10-x86-01.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/real10-x86-01.f90 @@ -0,0 +1,28 @@ +! RUN: %python %S/test_symbols.py %s %flang_fc1 +! REQUIRES: x86-registered-target + + !DEF: /MainProgram1/rpdt DerivedType + !DEF: /MainProgram1/rpdt/k TypeParam INTEGER(4) + type :: rpdt(k) + !REF: /MainProgram1/rpdt/k + integer, kind :: k + !REF: /MainProgram1/rpdt/k + !DEF: /MainProgram1/rpdt/x ObjectEntity REAL(int(int(k,kind=4),kind=8)) + real(kind=k) :: x + end type rpdt + !DEF: /MainProgram1/zpdt DerivedType + !DEF: /MainProgram1/zpdt/k TypeParam INTEGER(4) + type :: zpdt(k) + !REF: /MainProgram1/zpdt/k + integer, kind :: k + !REF: /MainProgram1/zpdt/k + !DEF: /MainProgram1/zpdt/x ObjectEntity COMPLEX(int(int(k,kind=4),kind=8)) + complex(kind=k) :: x + end type zpdt + !REF: /MainProgram1/rpdt + !DEF: /MainProgram1/a10 ObjectEntity TYPE(rpdt(k=10_4)) + type(rpdt(10)) :: a10 + !REF: /MainProgram1/zpdt + !DEF: /MainProgram1/z10 ObjectEntity TYPE(zpdt(k=10_4)) + type(zpdt(10)) :: z10 +end program Index: flang/test/Semantics/real10-x86-02.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/real10-x86-02.f90 @@ -0,0 +1,48 @@ +! RUN: %python %S/test_modfile.py %s %flang_fc1 +! REQUIRES: x86-registered-target +! Intrinsics SELECTED_INT_KIND, SELECTED_REAL_KIND, PRECISION, RANGE, +! RADIX, DIGITS + +module m1 + ! REAL(KIND=10) handles 16 <= P < 19 (if available; ifort is KIND=16) + integer, parameter :: realprec = precision(0._10) + logical, parameter :: rpreccheck = 18 == realprec + integer, parameter :: realpvals(*) = [16, 18] + integer, parameter :: realpkinds(*) = & + [(selected_real_kind(realpvals(j),0),j=1,size(realpvals))] + logical, parameter :: realpcheck = all([10, 10] == realpkinds) + ! REAL(KIND=10) handles 308 <= R < 4932 (if available; ifort is KIND=16) + integer, parameter :: realrange = range(0._10) + logical, parameter :: rrangecheck = 4931 == realrange + integer, parameter :: realrvals(*) = [308, 4931] + integer, parameter :: realrkinds(*) = & + [(selected_real_kind(0,realrvals(j)),j=1,size(realrvals))] + logical, parameter :: realrcheck = all([10, 10] == realrkinds) + logical, parameter :: radixcheck = radix(0._10) == 2 + + integer, parameter :: realdigits = digits(0._10) + logical, parameter :: realdigitscheck = 64 == realdigits +end module m1 +!Expect: m1.mod +!module m1 +!integer(4),parameter::realprec=18_4 +!intrinsic::precision +!logical(4),parameter::rpreccheck=.true._4 +!integer(4),parameter::realpvals(1_8:*)=[INTEGER(4)::16_4,18_4] +!integer(4),parameter::realpkinds(1_8:*)=[INTEGER(4)::10_4,10_4] +!intrinsic::selected_real_kind +!intrinsic::size +!logical(4),parameter::realpcheck=.true._4 +!intrinsic::all +!integer(4),parameter::realrange=4931_4 +!intrinsic::range +!logical(4),parameter::rrangecheck=.true._4 +!integer(4),parameter::realrvals(1_8:*)=[INTEGER(4)::308_4,4931_4] +!integer(4),parameter::realrkinds(1_8:*)=[INTEGER(4)::10_4,10_4] +!logical(4),parameter::realrcheck=.true._4 +!logical(4),parameter::radixcheck=.true._4 +!intrinsic::radix +!integer(4),parameter::realdigits=64_4 +!intrinsic::digits +!logical(4),parameter::realdigitscheck=.true._4 +!end Index: flang/test/Semantics/realkinds-aarch64-01.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/realkinds-aarch64-01.f90 @@ -0,0 +1,11 @@ +! RUN: %python %S/test_modfile.py %s %flang_fc1 -triple aarch64-unknown-linux-gnu +! REQUIRES: aarch64-registered-target + +module m1 + logical, parameter :: realpcheck = 16 == selected_real_kind(16) +end module m1 +!Expect: m1.mod +!module m1 +!logical(4),parameter::realpcheck=.true._4 +!intrinsic::selected_real_kind +!end Index: flang/tools/bbc/bbc.cpp =================================================================== --- flang/tools/bbc/bbc.cpp +++ flang/tools/bbc/bbc.cpp @@ -322,8 +322,9 @@ Fortran::common::IntrinsicTypeDefaultKinds defaultKinds; Fortran::parser::AllSources allSources; Fortran::parser::AllCookedSources allCookedSources(allSources); + Fortran::evaluate::TargetCharacteristics target(""); Fortran::semantics::SemanticsContext semanticsContext{ - defaultKinds, options.features, allCookedSources}; + defaultKinds, options.features, allCookedSources, target}; semanticsContext.set_moduleDirectory(moduleDir) .set_moduleFileSuffix(moduleSuffix) .set_searchDirectories(includeDirs) Index: flang/unittests/Evaluate/expression.cpp =================================================================== --- flang/unittests/Evaluate/expression.cpp +++ flang/unittests/Evaluate/expression.cpp @@ -21,7 +21,7 @@ MATCH("2_4+3_4*(-4_4)", ex1.AsFortran()); Fortran::common::IntrinsicTypeDefaultKinds defaults; auto intrinsics{Fortran::evaluate::IntrinsicProcTable::Configure(defaults)}; - TargetCharacteristics targetCharacteristics; + TargetCharacteristics targetCharacteristics(""); FoldingContext context{Fortran::parser::ContextualMessages{nullptr}, defaults, intrinsics, targetCharacteristics}; ex1 = Fold(context, std::move(ex1)); Index: flang/unittests/Evaluate/folding.cpp =================================================================== --- flang/unittests/Evaluate/folding.cpp +++ flang/unittests/Evaluate/folding.cpp @@ -45,9 +45,9 @@ Fortran::parser::ContextualMessages messages{src, nullptr}; Fortran::common::IntrinsicTypeDefaultKinds defaults; auto intrinsics{Fortran::evaluate::IntrinsicProcTable::Configure(defaults)}; - TargetCharacteristics flushingTargetCharacteristics; + TargetCharacteristics flushingTargetCharacteristics(""); flushingTargetCharacteristics.set_areSubnormalsFlushedToZero(true); - TargetCharacteristics noFlushingTargetCharacteristics; + TargetCharacteristics noFlushingTargetCharacteristics(""); noFlushingTargetCharacteristics.set_areSubnormalsFlushedToZero(false); FoldingContext flushingContext{ messages, defaults, intrinsics, flushingTargetCharacteristics}; Index: flang/unittests/Evaluate/intrinsics.cpp =================================================================== --- flang/unittests/Evaluate/intrinsics.cpp +++ flang/unittests/Evaluate/intrinsics.cpp @@ -104,7 +104,7 @@ llvm::outs().flush(); CallCharacteristics call{fName.ToString()}; auto messages{strings.Messages(buffer)}; - TargetCharacteristics targetCharacteristics; + TargetCharacteristics targetCharacteristics(""); FoldingContext context{messages, defaults, table, targetCharacteristics}; std::optional si{table.Probe(call, args, context)}; if (resultType.has_value()) {