1627f7eb2Smrg`/* Support routines for the intrinsic power (**) operator. 2*4c3eb207Smrg Copyright (C) 2004-2020 Free Software Foundation, Inc. 3627f7eb2Smrg Contributed by Paul Brook 4627f7eb2Smrg 5627f7eb2SmrgThis file is part of the GNU Fortran 95 runtime library (libgfortran). 6627f7eb2Smrg 7627f7eb2SmrgLibgfortran is free software; you can redistribute it and/or 8627f7eb2Smrgmodify it under the terms of the GNU General Public 9627f7eb2SmrgLicense as published by the Free Software Foundation; either 10627f7eb2Smrgversion 3 of the License, or (at your option) any later version. 11627f7eb2Smrg 12627f7eb2SmrgLibgfortran is distributed in the hope that it will be useful, 13627f7eb2Smrgbut WITHOUT ANY WARRANTY; without even the implied warranty of 14627f7eb2SmrgMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15627f7eb2SmrgGNU General Public License for more details. 16627f7eb2Smrg 17627f7eb2SmrgUnder Section 7 of GPL version 3, you are granted additional 18627f7eb2Smrgpermissions described in the GCC Runtime Library Exception, version 19627f7eb2Smrg3.1, as published by the Free Software Foundation. 20627f7eb2Smrg 21627f7eb2SmrgYou should have received a copy of the GNU General Public License and 22627f7eb2Smrga copy of the GCC Runtime Library Exception along with this program; 23627f7eb2Smrgsee the files COPYING3 and COPYING.RUNTIME respectively. If not, see 24627f7eb2Smrg<http://www.gnu.org/licenses/>. */ 25627f7eb2Smrg 26627f7eb2Smrg#include "libgfortran.h"' 27627f7eb2Smrg 28627f7eb2Smrginclude(iparm.m4)dnl 29627f7eb2Smrg 30627f7eb2Smrg/* Use Binary Method to calculate the powi. This is not an optimal but 31627f7eb2Smrg a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of 32627f7eb2Smrg Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art 33627f7eb2Smrg of Computer Programming", 3rd Edition, 1998. */ 34627f7eb2Smrg 35627f7eb2Smrg`#if defined (HAVE_'rtype_name`) && defined (HAVE_'atype_name`)' 36627f7eb2Smrg 37627f7eb2Smrgrtype_name `pow_'rtype_code`_'atype_code` ('rtype_name` a, 'atype_name` b); 38627f7eb2Smrgexport_proto(pow_'rtype_code`_'atype_code`); 39627f7eb2Smrg 40627f7eb2Smrg'rtype_name` 41627f7eb2Smrgpow_'rtype_code`_'atype_code` ('rtype_name` a, 'atype_name` b) 42627f7eb2Smrg{ 43627f7eb2Smrg 'rtype_name` pow, x; 44627f7eb2Smrg 'atype_name` n; 45627f7eb2Smrg GFC_UINTEGER_'atype_kind` u; 46627f7eb2Smrg 47627f7eb2Smrg n = b; 48627f7eb2Smrg x = a; 49627f7eb2Smrg pow = 1; 50627f7eb2Smrg if (n != 0) 51627f7eb2Smrg { 52627f7eb2Smrg if (n < 0) 53627f7eb2Smrg { 54627f7eb2Smrg'ifelse(rtype_letter,i,`dnl 55627f7eb2Smrg if (x == 1) 56627f7eb2Smrg return 1; 57627f7eb2Smrg if (x == -1) 58627f7eb2Smrg return (n & 1) ? -1 : 1; 59627f7eb2Smrg return (x == 0) ? 1 / x : 0; 60627f7eb2Smrg',` 61627f7eb2Smrg u = -n; 62627f7eb2Smrg x = pow / x; 63627f7eb2Smrg')dnl 64627f7eb2Smrg` } 65627f7eb2Smrg else 66627f7eb2Smrg { 67627f7eb2Smrg u = n; 68627f7eb2Smrg } 69627f7eb2Smrg for (;;) 70627f7eb2Smrg { 71627f7eb2Smrg if (u & 1) 72627f7eb2Smrg pow *= x; 73627f7eb2Smrg u >>= 1; 74627f7eb2Smrg if (u) 75627f7eb2Smrg x *= x; 76627f7eb2Smrg else 77627f7eb2Smrg break; 78627f7eb2Smrg } 79627f7eb2Smrg } 80627f7eb2Smrg return pow; 81627f7eb2Smrg} 82627f7eb2Smrg 83627f7eb2Smrg#endif' 84