1 /*===-- flang/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