1 //===-- lib/Semantics/target.cpp ------------------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "flang/Evaluate/target.h"
10 #include "flang/Common/template.h"
11 #include "flang/Evaluate/common.h"
12 #include "flang/Evaluate/type.h"
13 
14 namespace Fortran::evaluate {
15 
16 Rounding TargetCharacteristics::defaultRounding;
17 
18 TargetCharacteristics::TargetCharacteristics() {
19   // TODO: Fill in the type information from command-line targeting information.
20   auto enableCategoryKinds{[this](TypeCategory category) {
21     for (int kind{0}; kind < maxKind; ++kind) {
22       if (CanSupportType(category, kind)) {
23         auto byteSize{static_cast<std::size_t>(kind)};
24         if (category == TypeCategory::Real ||
25             category == TypeCategory::Complex) {
26           if (kind == 3) {
27             // non-IEEE 16-bit format (truncated 32-bit)
28             byteSize = 2;
29           } else if (kind == 10) {
30             // x87 floating-point
31             // Follow gcc precedent for "long double"
32             byteSize = 16;
33           }
34         }
35         std::size_t align{byteSize};
36         if (category == TypeCategory::Complex) {
37           byteSize = 2 * byteSize;
38         }
39         EnableType(category, kind, byteSize, align);
40       }
41     }
42   }};
43   enableCategoryKinds(TypeCategory::Integer);
44   enableCategoryKinds(TypeCategory::Real);
45   enableCategoryKinds(TypeCategory::Complex);
46   enableCategoryKinds(TypeCategory::Character);
47   enableCategoryKinds(TypeCategory::Logical);
48 
49   isBigEndian_ = !isHostLittleEndian;
50 
51   areSubnormalsFlushedToZero_ = false;
52 }
53 
54 bool TargetCharacteristics::CanSupportType(
55     TypeCategory category, std::int64_t kind) {
56   return IsValidKindOfIntrinsicType(category, kind);
57 }
58 
59 bool TargetCharacteristics::EnableType(common::TypeCategory category,
60     std::int64_t kind, std::size_t byteSize, std::size_t align) {
61   if (CanSupportType(category, kind)) {
62     byteSize_[static_cast<int>(category)][kind] = byteSize;
63     align_[static_cast<int>(category)][kind] = align;
64     maxByteSize_ = std::max(maxByteSize_, byteSize);
65     maxAlignment_ = std::max(maxAlignment_, align);
66     return true;
67   } else {
68     return false;
69   }
70 }
71 
72 void TargetCharacteristics::DisableType(
73     common::TypeCategory category, std::int64_t kind) {
74   if (kind >= 0 && kind < maxKind) {
75     align_[static_cast<int>(category)][kind] = 0;
76   }
77 }
78 
79 std::size_t TargetCharacteristics::GetByteSize(
80     common::TypeCategory category, std::int64_t kind) const {
81   if (kind >= 0 && kind < maxKind) {
82     return byteSize_[static_cast<int>(category)][kind];
83   } else {
84     return 0;
85   }
86 }
87 
88 std::size_t TargetCharacteristics::GetAlignment(
89     common::TypeCategory category, std::int64_t kind) const {
90   if (kind >= 0 && kind < maxKind) {
91     return align_[static_cast<int>(category)][kind];
92   } else {
93     return 0;
94   }
95 }
96 
97 bool TargetCharacteristics::IsTypeEnabled(
98     common::TypeCategory category, std::int64_t kind) const {
99   return GetAlignment(category, kind) > 0;
100 }
101 
102 void TargetCharacteristics::set_isBigEndian(bool isBig) {
103   isBigEndian_ = isBig;
104 }
105 
106 void TargetCharacteristics::set_areSubnormalsFlushedToZero(bool yes) {
107   areSubnormalsFlushedToZero_ = yes;
108 }
109 
110 void TargetCharacteristics::set_roundingMode(Rounding rounding) {
111   roundingMode_ = rounding;
112 }
113 
114 // SELECTED_INT_KIND() -- F'2018 16.9.169
115 class SelectedIntKindVisitor {
116 public:
117   SelectedIntKindVisitor(
118       const TargetCharacteristics &targetCharacteristics, std::int64_t p)
119       : targetCharacteristics_{targetCharacteristics}, precision_{p} {}
120   using Result = std::optional<int>;
121   using Types = IntegerTypes;
122   template <typename T> Result Test() const {
123     if (Scalar<T>::RANGE >= precision_ &&
124         targetCharacteristics_.IsTypeEnabled(T::category, T::kind)) {
125       return T::kind;
126     } else {
127       return std::nullopt;
128     }
129   }
130 
131 private:
132   const TargetCharacteristics &targetCharacteristics_;
133   std::int64_t precision_;
134 };
135 
136 int TargetCharacteristics::SelectedIntKind(std::int64_t precision) const {
137   if (auto kind{
138           common::SearchTypes(SelectedIntKindVisitor{*this, precision})}) {
139     return *kind;
140   } else {
141     return -1;
142   }
143 }
144 
145 // SELECTED_REAL_KIND() -- F'2018 16.9.170
146 class SelectedRealKindVisitor {
147 public:
148   SelectedRealKindVisitor(const TargetCharacteristics &targetCharacteristics,
149       std::int64_t p, std::int64_t r)
150       : targetCharacteristics_{targetCharacteristics}, precision_{p}, range_{
151                                                                           r} {}
152   using Result = std::optional<int>;
153   using Types = RealTypes;
154   template <typename T> Result Test() const {
155     if (Scalar<T>::PRECISION >= precision_ && Scalar<T>::RANGE >= range_ &&
156         targetCharacteristics_.IsTypeEnabled(T::category, T::kind)) {
157       return {T::kind};
158     } else {
159       return std::nullopt;
160     }
161   }
162 
163 private:
164   const TargetCharacteristics &targetCharacteristics_;
165   std::int64_t precision_, range_;
166 };
167 
168 int TargetCharacteristics::SelectedRealKind(
169     std::int64_t precision, std::int64_t range, std::int64_t radix) const {
170   if (radix != 2) {
171     return -5;
172   }
173   if (auto kind{common::SearchTypes(
174           SelectedRealKindVisitor{*this, precision, range})}) {
175     return *kind;
176   }
177   // No kind has both sufficient precision and sufficient range.
178   // The negative return value encodes whether any kinds exist that
179   // could satisfy either constraint independently.
180   bool pOK{common::SearchTypes(SelectedRealKindVisitor{*this, precision, 0})};
181   bool rOK{common::SearchTypes(SelectedRealKindVisitor{*this, 0, range})};
182   if (pOK) {
183     if (rOK) {
184       return -4;
185     } else {
186       return -2;
187     }
188   } else {
189     if (rOK) {
190       return -1;
191     } else {
192       return -3;
193     }
194   }
195 }
196 
197 } // namespace Fortran::evaluate
198