1!   Copyright (C) 2002-2019 Free Software Foundation, Inc.
2!   Contributed by Tobias Schl"uter
3!
4!This file is part of the GNU Fortran 95 runtime library (libgfortran).
5!
6!GNU libgfortran is free software; you can redistribute it and/or
7!modify it under the terms of the GNU General Public
8!License as published by the Free Software Foundation; either
9!version 3 of the License, or (at your option) any later version.
10!
11!GNU libgfortran is distributed in the hope that it will be useful,
12!but WITHOUT ANY WARRANTY; without even the implied warranty of
13!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14!GNU General Public License for more details.
15!
16!Under Section 7 of GPL version 3, you are granted additional
17!permissions described in the GCC Runtime Library Exception, version
18!3.1, as published by the Free Software Foundation.
19!
20!You should have received a copy of the GNU General Public License and
21!a copy of the GCC Runtime Library Exception along with this program;
22!see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
23!<http://www.gnu.org/licenses/>.
24
25! Specifics for the intrinsics whose calling conventions change if
26! -ff2c is used.
27!
28! There are two annoyances WRT the preprocessor:
29!  - we're using -traditional-cpp, so we can't use the ## operator.
30!  - macros expand to a single line, and Fortran lines can't be wider
31!    than 132 characters, therefore we use two macros to split the lines
32!
33! The cases we need to implement are functions returning default REAL
34! or COMPLEX.  The former need to return DOUBLE PRECISION instead of REAL,
35! the latter become subroutines returning via a hidden first argument.
36
37! one argument functions
38#define REAL_HEAD(NAME) \
39elemental function _gfortran_f2c_specific__/**/NAME/**/_r4 (parm) result(res);
40
41#define REAL_BODY(NAME) \
42  REAL, intent (in) :: parm; \
43  DOUBLE PRECISION :: res; \
44  res = NAME (parm); \
45end function
46
47#define COMPLEX_HEAD(NAME) \
48subroutine _gfortran_f2c_specific__/**/NAME/**/_c4 (res, parm);
49
50#define COMPLEX_BODY(NAME) \
51  COMPLEX, intent (in) :: parm; \
52  COMPLEX, intent (out) :: res; \
53  res = NAME (parm); \
54end subroutine
55
56#define DCOMPLEX_HEAD(NAME) \
57subroutine _gfortran_f2c_specific__/**/NAME/**/_c8 (res, parm);
58
59#define DCOMPLEX_BODY(NAME) \
60  DOUBLE COMPLEX, intent (in) :: parm; \
61  DOUBLE COMPLEX, intent (out) :: res; \
62  res = NAME (parm); \
63end subroutine
64
65REAL_HEAD(abs)
66REAL_BODY(abs)
67
68! abs is special in that the result is real
69elemental function _gfortran_f2c_specific__abs_c4 (parm) result (res)
70  COMPLEX, intent(in) :: parm
71  DOUBLE PRECISION :: res
72  res = abs(parm)
73end function
74
75
76! aimag is special in that the result is real
77elemental function _gfortran_f2c_specific__aimag_c4 (parm)
78  complex(kind=4), intent(in) :: parm
79  double precision :: _gfortran_f2c_specific__aimag_c4
80  _gfortran_f2c_specific__aimag_c4 = aimag(parm)
81end function
82
83elemental function _gfortran_f2c_specific__aimag_c8 (parm)
84  complex(kind=8), intent(in) :: parm
85  double precision :: _gfortran_f2c_specific__aimag_c8
86  _gfortran_f2c_specific__aimag_c8 = aimag(parm)
87end function
88
89
90REAL_HEAD(exp)
91REAL_BODY(exp)
92COMPLEX_HEAD(exp)
93COMPLEX_BODY(exp)
94DCOMPLEX_HEAD(exp)
95DCOMPLEX_BODY(exp)
96
97REAL_HEAD(log)
98REAL_BODY(log)
99COMPLEX_HEAD(log)
100COMPLEX_BODY(log)
101DCOMPLEX_HEAD(log)
102DCOMPLEX_BODY(log)
103
104REAL_HEAD(log10)
105REAL_BODY(log10)
106
107REAL_HEAD(sqrt)
108REAL_BODY(sqrt)
109COMPLEX_HEAD(sqrt)
110COMPLEX_BODY(sqrt)
111DCOMPLEX_HEAD(sqrt)
112DCOMPLEX_BODY(sqrt)
113
114REAL_HEAD(asin)
115REAL_BODY(asin)
116
117REAL_HEAD(acos)
118REAL_BODY(acos)
119
120REAL_HEAD(atan)
121REAL_BODY(atan)
122
123REAL_HEAD(asinh)
124REAL_BODY(asinh)
125
126REAL_HEAD(acosh)
127REAL_BODY(acosh)
128
129REAL_HEAD(atanh)
130REAL_BODY(atanh)
131
132REAL_HEAD(sin)
133REAL_BODY(sin)
134COMPLEX_HEAD(sin)
135COMPLEX_BODY(sin)
136DCOMPLEX_HEAD(sin)
137DCOMPLEX_BODY(sin)
138
139REAL_HEAD(cos)
140REAL_BODY(cos)
141COMPLEX_HEAD(cos)
142COMPLEX_BODY(cos)
143DCOMPLEX_HEAD(cos)
144DCOMPLEX_BODY(cos)
145
146REAL_HEAD(tan)
147REAL_BODY(tan)
148
149REAL_HEAD(sinh)
150REAL_BODY(sinh)
151
152REAL_HEAD(cosh)
153REAL_BODY(cosh)
154
155REAL_HEAD(tanh)
156REAL_BODY(tanh)
157
158REAL_HEAD(aint)
159REAL_BODY(aint)
160
161REAL_HEAD(anint)
162REAL_BODY(anint)
163
164! two argument functions
165#define REAL2_HEAD(NAME) \
166elemental function _gfortran_f2c_specific__/**/NAME/**/_r4 (p1, p2) result(res);
167
168#define REAL2_BODY(NAME) \
169  REAL, intent (in) :: p1, p2; \
170  DOUBLE PRECISION :: res; \
171  res = NAME (p1, p2); \
172end function
173
174REAL2_HEAD(sign)
175REAL2_BODY(sign)
176
177REAL2_HEAD(dim)
178REAL2_BODY(dim)
179
180REAL2_HEAD(atan2)
181REAL2_BODY(atan2)
182
183REAL2_HEAD(mod)
184REAL2_BODY(mod)
185
186! conjg is special-cased because it is not suffixed _c4 but _4
187subroutine _gfortran_f2c_specific__conjg_4 (res, parm)
188  COMPLEX, intent (in) :: parm
189  COMPLEX, intent (out) :: res
190  res = conjg (parm)
191end subroutine
192subroutine _gfortran_f2c_specific__conjg_8 (res, parm)
193  DOUBLE COMPLEX, intent (in) :: parm
194  DOUBLE COMPLEX, intent (out) :: res
195  res = conjg (parm)
196end subroutine
197
198