]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/m4/set_exponent.m4
re PR libfortran/19308 (I/O library should support more real and integer kinds)
[thirdparty/gcc.git] / libgfortran / m4 / set_exponent.m4
CommitLineData
6de9cd9a
DN
1`/* Implementation of the SET_EXPONENT intrinsic
2 Copyright 2003 Free Software Foundation, Inc.
3 Contributed by Richard Henderson <rth@redhat.com>.
4
57dea9f6 5This file is part of the GNU Fortran 95 runtime library (libgfortran).
6de9cd9a 6
57dea9f6
TM
7Libgfortran is free software; you can redistribute it and/or
8modify it under the terms of the GNU General Public
6de9cd9a 9License as published by the Free Software Foundation; either
57dea9f6 10version 2 of the License, or (at your option) any later version.
6de9cd9a 11
57dea9f6
TM
12In addition to the permissions in the GNU General Public License, the
13Free Software Foundation gives you unlimited permission to link the
14compiled version of this file into combinations with other programs,
15and to distribute those combinations without any restriction coming
16from the use of this file. (The General Public License restrictions
17do apply in other respects; for example, they cover modification of
18the file, and distribution when not linked into a combine
19executable.)
20
21Libgfortran is distributed in the hope that it will be useful,
6de9cd9a
DN
22but WITHOUT ANY WARRANTY; without even the implied warranty of
23MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
57dea9f6 24GNU General Public License for more details.
6de9cd9a 25
57dea9f6
TM
26You should have received a copy of the GNU General Public
27License along with libgfortran; see the file COPYING. If not,
fe2ae685
KC
28write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29Boston, MA 02110-1301, USA. */
644cb69f
FXC
30
31#include "config.h"
6de9cd9a
DN
32#include <math.h>
33#include "libgfortran.h"'
34
35include(`mtype.m4')dnl
36
644cb69f
FXC
37`#if defined (HAVE_'real_type`) && defined (HAVE_SCALBN'Q`) && defined (HAVE_FREXP'Q`)'
38
7d7b8bfe
RH
39extern real_type set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i);
40export_proto(set_exponent_r`'kind);
41
6de9cd9a 42real_type
7d7b8bfe 43set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i)
6de9cd9a
DN
44{
45 int dummy_exp;
46 return scalbn`'q (frexp`'q (s, &dummy_exp), i);
47}
644cb69f
FXC
48
49#endif