annotate libgfortran/generated/pow_r8_i16.c @ 158:494b0b89df80 default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 1830386684a0
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 /* Support routines for the intrinsic power (**) operator.
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
2 Copyright (C) 2004-2020 Free Software Foundation, Inc.
111
kono
parents:
diff changeset
3 Contributed by Paul Brook
kono
parents:
diff changeset
4
kono
parents:
diff changeset
5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
kono
parents:
diff changeset
6
kono
parents:
diff changeset
7 Libgfortran is free software; you can redistribute it and/or
kono
parents:
diff changeset
8 modify it under the terms of the GNU General Public
kono
parents:
diff changeset
9 License as published by the Free Software Foundation; either
kono
parents:
diff changeset
10 version 3 of the License, or (at your option) any later version.
kono
parents:
diff changeset
11
kono
parents:
diff changeset
12 Libgfortran is distributed in the hope that it will be useful,
kono
parents:
diff changeset
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
kono
parents:
diff changeset
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
kono
parents:
diff changeset
15 GNU General Public License for more details.
kono
parents:
diff changeset
16
kono
parents:
diff changeset
17 Under Section 7 of GPL version 3, you are granted additional
kono
parents:
diff changeset
18 permissions described in the GCC Runtime Library Exception, version
kono
parents:
diff changeset
19 3.1, as published by the Free Software Foundation.
kono
parents:
diff changeset
20
kono
parents:
diff changeset
21 You should have received a copy of the GNU General Public License and
kono
parents:
diff changeset
22 a copy of the GCC Runtime Library Exception along with this program;
kono
parents:
diff changeset
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
kono
parents:
diff changeset
24 <http://www.gnu.org/licenses/>. */
kono
parents:
diff changeset
25
kono
parents:
diff changeset
26 #include "libgfortran.h"
kono
parents:
diff changeset
27
kono
parents:
diff changeset
28
kono
parents:
diff changeset
29 /* Use Binary Method to calculate the powi. This is not an optimal but
kono
parents:
diff changeset
30 a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
kono
parents:
diff changeset
31 Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
kono
parents:
diff changeset
32 of Computer Programming", 3rd Edition, 1998. */
kono
parents:
diff changeset
33
kono
parents:
diff changeset
34 #if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
kono
parents:
diff changeset
35
kono
parents:
diff changeset
36 GFC_REAL_8 pow_r8_i16 (GFC_REAL_8 a, GFC_INTEGER_16 b);
kono
parents:
diff changeset
37 export_proto(pow_r8_i16);
kono
parents:
diff changeset
38
kono
parents:
diff changeset
39 GFC_REAL_8
kono
parents:
diff changeset
40 pow_r8_i16 (GFC_REAL_8 a, GFC_INTEGER_16 b)
kono
parents:
diff changeset
41 {
kono
parents:
diff changeset
42 GFC_REAL_8 pow, x;
kono
parents:
diff changeset
43 GFC_INTEGER_16 n;
kono
parents:
diff changeset
44 GFC_UINTEGER_16 u;
kono
parents:
diff changeset
45
kono
parents:
diff changeset
46 n = b;
kono
parents:
diff changeset
47 x = a;
kono
parents:
diff changeset
48 pow = 1;
kono
parents:
diff changeset
49 if (n != 0)
kono
parents:
diff changeset
50 {
kono
parents:
diff changeset
51 if (n < 0)
kono
parents:
diff changeset
52 {
kono
parents:
diff changeset
53
kono
parents:
diff changeset
54 u = -n;
kono
parents:
diff changeset
55 x = pow / x;
kono
parents:
diff changeset
56 }
kono
parents:
diff changeset
57 else
kono
parents:
diff changeset
58 {
kono
parents:
diff changeset
59 u = n;
kono
parents:
diff changeset
60 }
kono
parents:
diff changeset
61 for (;;)
kono
parents:
diff changeset
62 {
kono
parents:
diff changeset
63 if (u & 1)
kono
parents:
diff changeset
64 pow *= x;
kono
parents:
diff changeset
65 u >>= 1;
kono
parents:
diff changeset
66 if (u)
kono
parents:
diff changeset
67 x *= x;
kono
parents:
diff changeset
68 else
kono
parents:
diff changeset
69 break;
kono
parents:
diff changeset
70 }
kono
parents:
diff changeset
71 }
kono
parents:
diff changeset
72 return pow;
kono
parents:
diff changeset
73 }
kono
parents:
diff changeset
74
kono
parents:
diff changeset
75 #endif