1 | //===-- lib/runtime/complex-powi.cpp ----------------------------*- C++ -*-===// |
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/Common/float128.h" |
10 | #include "flang/Runtime/cpp-type.h" |
11 | #include "flang/Runtime/entry-names.h" |
12 | #include <cstdint> |
13 | #include <cstdio> |
14 | #include <limits> |
15 | |
16 | namespace Fortran::runtime { |
17 | #ifdef __clang_major__ |
18 | #pragma clang diagnostic ignored "-Wc99-extensions" |
19 | #endif |
20 | |
21 | template <typename C, typename I> C tgpowi(C base, I exp) { |
22 | if (exp == 0) { |
23 | return C{1}; |
24 | } |
25 | |
26 | bool invertResult{exp < 0}; |
27 | bool isMin{exp == std::numeric_limits<I>::min()}; |
28 | |
29 | if (isMin) { |
30 | exp = std::numeric_limits<I>::max(); |
31 | } |
32 | |
33 | if (exp < 0) { |
34 | exp = exp * -1; |
35 | } |
36 | |
37 | C origBase{base}; |
38 | |
39 | while ((exp & 1) == 0) { |
40 | base *= base; |
41 | exp >>= 1; |
42 | } |
43 | |
44 | C acc{base}; |
45 | |
46 | while (exp > 1) { |
47 | exp >>= 1; |
48 | base *= base; |
49 | if ((exp & 1) == 1) { |
50 | acc *= base; |
51 | } |
52 | } |
53 | |
54 | if (isMin) { |
55 | acc *= origBase; |
56 | } |
57 | |
58 | if (invertResult) { |
59 | acc = C{1} / acc; |
60 | } |
61 | |
62 | return acc; |
63 | } |
64 | |
65 | #ifndef _MSC_VER |
66 | // With most compilers, C complex is implemented as a builtin type that may have |
67 | // specific ABI requirements |
68 | extern "C" float _Complex RTNAME(cpowi)(float _Complex base, std::int32_t exp) { |
69 | return tgpowi(base, exp); |
70 | } |
71 | |
72 | extern "C" double _Complex RTNAME(zpowi)( |
73 | double _Complex base, std::int32_t exp) { |
74 | return tgpowi(base, exp); |
75 | } |
76 | |
77 | extern "C" float _Complex RTNAME(cpowk)(float _Complex base, std::int64_t exp) { |
78 | return tgpowi(base, exp); |
79 | } |
80 | |
81 | extern "C" double _Complex RTNAME(zpowk)( |
82 | double _Complex base, std::int64_t exp) { |
83 | return tgpowi(base, exp); |
84 | } |
85 | |
86 | #if HAS_LDBL128 || HAS_FLOAT128 |
87 | // Duplicate CFloat128ComplexType definition from flang/Common/float128.h. |
88 | // float128.h does not define it for C++, because _Complex triggers |
89 | // c99-extension warnings. We decided to disable warnings for this |
90 | // particular file, so we can use _Complex here. |
91 | #if HAS_LDBL128 |
92 | typedef long double _Complex Qcomplex; |
93 | #elif HAS_FLOAT128 |
94 | #if !defined(_ARCH_PPC) || defined(__LONG_DOUBLE_IEEE128__) |
95 | typedef _Complex float __attribute__((mode(TC))) Qcomplex; |
96 | #else |
97 | typedef _Complex float __attribute__((mode(KC))) Qcomplex; |
98 | #endif |
99 | #endif |
100 | |
101 | extern "C" Qcomplex RTNAME(cqpowi)(Qcomplex base, std::int32_t exp) { |
102 | return tgpowi(base, exp); |
103 | } |
104 | extern "C" Qcomplex RTNAME(cqpowk)(Qcomplex base, std::int64_t exp) { |
105 | return tgpowi(base, exp); |
106 | } |
107 | #endif |
108 | |
109 | #else |
110 | // on MSVC, C complex is always just a struct of two members as it is not |
111 | // supported as a builtin type. So we use C++ complex here as that has the |
112 | // same ABI and layout. See: |
113 | // https://learn.microsoft.com/en-us/cpp/c-runtime-library/complex-math-support |
114 | #include <complex> |
115 | |
116 | // MSVC doesn't allow including <ccomplex> or <complex.h> in C++17 mode to get |
117 | // the Windows definitions of these structs so just redefine here. |
118 | struct Fcomplex { |
119 | CppTypeFor<TypeCategory::Real, 4> re; |
120 | CppTypeFor<TypeCategory::Real, 4> im; |
121 | }; |
122 | |
123 | struct Dcomplex { |
124 | CppTypeFor<TypeCategory::Real, 8> re; |
125 | CppTypeFor<TypeCategory::Real, 8> im; |
126 | }; |
127 | |
128 | extern "C" Fcomplex RTNAME(cpowi)(Fcomplex base, std::int32_t exp) { |
129 | auto cppbase = *(CppTypeFor<TypeCategory::Complex, 4> *)(&base); |
130 | auto cppres = tgpowi(cppbase, exp); |
131 | return *(Fcomplex *)(&cppres); |
132 | } |
133 | |
134 | extern "C" Dcomplex RTNAME(zpowi)(Dcomplex base, std::int32_t exp) { |
135 | auto cppbase = *(CppTypeFor<TypeCategory::Complex, 8> *)(&base); |
136 | auto cppres = tgpowi(cppbase, exp); |
137 | return *(Dcomplex *)(&cppres); |
138 | } |
139 | |
140 | extern "C" Fcomplex RTNAME(cpowk)(Fcomplex base, std::int64_t exp) { |
141 | auto cppbase = *(CppTypeFor<TypeCategory::Complex, 4> *)(&base); |
142 | auto cppres = tgpowi(cppbase, exp); |
143 | return *(Fcomplex *)(&cppres); |
144 | } |
145 | |
146 | extern "C" Dcomplex RTNAME(zpowk)(Dcomplex base, std::int64_t exp) { |
147 | auto cppbase = *(CppTypeFor<TypeCategory::Complex, 8> *)(&base); |
148 | auto cppres = tgpowi(cppbase, exp); |
149 | return *(Dcomplex *)(&cppres); |
150 | } |
151 | |
152 | #if HAS_LDBL128 || HAS_FLOAT128 |
153 | struct Qcomplex { |
154 | CFloat128Type re; |
155 | CFloat128Type im; |
156 | }; |
157 | |
158 | extern "C" Dcomplex RTNAME(cqpowi)(Qcomplex base, std::int32_t exp) { |
159 | auto cppbase = *(rtcmplx::complex<CFloat128Type> *)(&base); |
160 | auto cppres = tgpowi(cppbase, exp); |
161 | return *(Qcomplex *)(&cppres); |
162 | } |
163 | |
164 | extern "C" Dcomplex RTNAME(cqpowk)(Qcomplex base, std::int64_t exp) { |
165 | auto cppbase = *(rtcmplx::complex<CFloat128Type> *)(&base); |
166 | auto cppres = tgpowi(cppbase, exp); |
167 | return *(Qcomplex *)(&cppres); |
168 | } |
169 | #endif |
170 | #endif |
171 | } // namespace Fortran::runtime |
172 | |