This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[libgfortran] generate tables of kinds
- From: Richard Henderson <rth at redhat dot com>
- To: fortran at gcc dot gnu dot org
- Date: Mon, 30 Aug 2004 14:36:03 -0700
- Subject: [libgfortran] generate tables of kinds
Split out from a previous patch, and updated for integers.
Tested on i686-linux, and committed.
r~
* Makefile.am (gfor_helper_src): Split selected_kind.f90.
(gfor_built_src): Add selected_int_kind.inc selected_real_kind.inc.
(selected_int_kind.inc selected_real_kind.inc): New rules.
* Makefile.in: Regenerate.
* mk-sik-inc.sh, mk-srk-inc.sh: New files.
* intrinsics/selected_int_kind.f90: Split from selected_kind.f90,
include table of detected kinds.
* intrinsics/selected_real_kind.f90: Similarly.
Index: Makefile.am
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.16
diff -c -p -d -r1.16 Makefile.am
*** Makefile.am 29 Aug 2004 15:58:15 -0000 1.16
--- Makefile.am 30 Aug 2004 21:30:22 -0000
*************** intrinsics/rand.c \
*** 59,65 ****
intrinsics/random.c \
intrinsics/reshape_generic.c \
intrinsics/reshape_packed.c \
! intrinsics/selected_kind.f90 \
intrinsics/system_clock.c \
intrinsics/transpose_generic.c \
intrinsics/unpack_generic.c \
--- 59,66 ----
intrinsics/random.c \
intrinsics/reshape_generic.c \
intrinsics/reshape_packed.c \
! intrinsics/selected_int_kind.f90 \
! intrinsics/selected_real_kind.f90 \
intrinsics/system_clock.c \
intrinsics/transpose_generic.c \
intrinsics/unpack_generic.c \
*************** gfor_built_src= $(i_all_c) $(i_any_c) $(
*** 264,270 ****
$(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
! $(i_pow_c)
# We only use these if libm doesn't contain complex math functions.
--- 265,272 ----
$(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
! $(i_pow_c) \
! selected_int_kind.inc selected_real_kind.inc
# We only use these if libm doesn't contain complex math functions.
*************** I_M4_DEPS=m4/iparm.m4
*** 383,388 ****
--- 385,396 ----
I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4
I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4
+ selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh
+ $(SHELL) $(srcdir)/mk-sik-inc.sh '$(F77COMPILE)' > $@
+
+ selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh
+ $(SHELL) $(srcdir)/mk-srk-inc.sh '$(F77COMPILE)' > $@
+
## A 'normal' build shouldn't need to regenerate these
## so we only include them in maintainer mode
Index: mk-sik-inc.sh
===================================================================
RCS file: mk-sik-inc.sh
diff -N mk-sik-inc.sh
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- mk-sik-inc.sh 30 Aug 2004 21:30:23 -0000
***************
*** 0 ****
--- 1,32 ----
+ #!/bin/sh
+
+ compile="$1"
+ kinds=""
+ possible_kinds="1 2 4 8 16"
+ c=0
+
+ for k in $possible_kinds; do
+ echo " integer (kind=$k) :: x" > tmp$$.f90
+ echo " end" >> tmp$$.f90
+ if $compile -c tmp$$.f90 > /dev/null 2>&1; then
+ kinds="$kinds $k"
+ c=`expr $c + 1`
+ fi
+ rm -f tmp$$.*
+ done
+
+ echo " integer, parameter :: c = $c"
+ echo " type (int_info), parameter :: int_infos(c) = (/ &"
+
+ i=0
+ for k in $kinds; do
+ echo -n " int_info ($k, range(0_$k))"
+ i=`expr $i + 1`
+ if [ $i -lt $c ]; then
+ echo ", &"
+ else
+ echo " /)"
+ fi
+ done
+
+ exit 0
Index: mk-srk-inc.sh
===================================================================
RCS file: mk-srk-inc.sh
diff -N mk-srk-inc.sh
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- mk-srk-inc.sh 30 Aug 2004 21:30:23 -0000
***************
*** 0 ****
--- 1,32 ----
+ #!/bin/sh
+
+ compile="$1"
+ kinds=""
+ possible_kinds="4 8 10 16"
+ c=0
+
+ for k in $possible_kinds; do
+ echo " real (kind=$k) :: x" > tmp$$.f90
+ echo " end" >> tmp$$.f90
+ if $compile -c tmp$$.f90 > /dev/null 2>&1; then
+ kinds="$kinds $k"
+ c=`expr $c + 1`
+ fi
+ rm -f tmp$$.*
+ done
+
+ echo " integer, parameter :: c = $c"
+ echo " type (real_info), parameter :: real_infos(c) = (/ &"
+
+ i=0
+ for k in $kinds; do
+ echo -n " real_info ($k, precision(0.0_$k), range(0.0_$k))"
+ i=`expr $i + 1`
+ if [ $i -lt $c ]; then
+ echo ", &"
+ else
+ echo " /)"
+ fi
+ done
+
+ exit 0
Index: intrinsics/selected_int_kind.f90
===================================================================
RCS file: intrinsics/selected_int_kind.f90
diff -N intrinsics/selected_int_kind.f90
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- intrinsics/selected_int_kind.f90 30 Aug 2004 21:30:23 -0000
***************
*** 0 ****
--- 1,43 ----
+ ! Copyright 2003, 2004 Free Software Foundation, Inc.
+ ! Contributed by Kejia Zhao <kejia_zh@yahoo.com.cn>
+ !
+ !This file is part of the GNU Fortran 95 runtime library (libgfor).
+ !
+ !GNU libgfor is free software; you can redistribute it and/or
+ !modify it under the terms of the GNU Lesser General Public
+ !License as published by the Free Software Foundation; either
+ !version 2.1 of the License, or (at your option) any later version.
+ !
+ !GNU libgfor is distributed in the hope that it will be useful,
+ !but WITHOUT ANY WARRANTY; without even the implied warranty of
+ !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ !GNU Lesser General Public License for more details.
+ !
+ !You should have received a copy of the GNU Lesser General Public
+ !License along with libgfor; see the file COPYING. If not,
+ !write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ !Boston, MA 02111-1307, USA.
+ !
+
+ function selected_int_kind (r)
+ implicit none
+ integer, intent (in) :: r
+ integer :: selected_int_kind
+ integer :: i
+ ! Integer kind_range table
+ type :: int_info
+ integer :: kind
+ integer :: range
+ end type int_info
+
+ include "selected_int_kind.inc"
+
+ do i = 1, c
+ if (r <= int_infos (i) % range) then
+ selected_int_kind = int_infos (i) % kind
+ return
+ end if
+ end do
+ selected_int_kind = -1
+ return
+ end function
Index: intrinsics/selected_kind.f90
===================================================================
RCS file: intrinsics/selected_kind.f90
diff -N intrinsics/selected_kind.f90
*** intrinsics/selected_kind.f90 13 May 2004 06:41:02 -0000 1.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
***************
*** 1,90 ****
- ! Copyright 2003 Free Software Foundation, Inc.
- ! Contributed by Kejia Zhao <kejia_zh@yahoo.com.cn>
- !
- !This file is part of the GNU Fortran 95 runtime library (libgfor).
- !
- !GNU libgfor is free software; you can redistribute it and/or
- !modify it under the terms of the GNU Lesser General Public
- !License as published by the Free Software Foundation; either
- !version 2.1 of the License, or (at your option) any later version.
- !
- !GNU libgfor is distributed in the hope that it will be useful,
- !but WITHOUT ANY WARRANTY; without even the implied warranty of
- !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- !GNU Lesser General Public License for more details.
- !
- !You should have received a copy of the GNU Lesser General Public
- !License along with libgfor; see the file COPYING. If not,
- !write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
- !Boston, MA 02111-1307, USA.
- !
-
- function selected_int_kind (r)
- implicit none
- integer, intent (in) :: r
- integer :: selected_int_kind
- integer :: i
- ! Integer kind_range table
- integer, parameter :: c = 4
- type :: int_info
- integer :: kind
- integer :: range
- end type int_info
- type (int_info), parameter :: int_infos (c) = &
- (/int_info (1, range (0_1)), &
- int_info (2, range (0_2)), &
- int_info (4, range (0_4)), &
- int_info (8, range (0_8))/)
-
- do i = 1, c
- if (r <= int_infos (i) % range) then
- selected_int_kind = int_infos (i) % kind
- return
- end if
- end do
- selected_int_kind = -1
- return
- end function
-
- function selected_real_kind (p, r)
- implicit none
- integer, optional, intent (in) :: p, r
- integer :: selected_real_kind
- integer :: i, p2, r2
- logical :: found_p, found_r
- ! Real kind_precision_range table
- integer, parameter :: c = 2
- type :: real_info
- integer :: kind
- integer :: precision
- integer :: range
- end type real_info
- type (real_info) :: real_infos (c) = &
- (/real_info (4, precision (0.0_4), range (0.0_4)), &
- real_info (8, precision (0.0_8), range (0.0_8))/)
-
- selected_real_kind = 0
- p2 = 0
- r2 = 0
- found_p = .false.
- found_r = .false.
-
- if (present (p)) p2 = p
- if (present (r)) r2 = r
-
- ! Assumes each type has a greater precision and range than previous one.
-
- do i = 1, c
- if (p2 <= real_infos (i) % precision) found_p = .true.
- if (r2 <= real_infos (i) % range) found_r = .true.
- if (found_p .and. found_r) then
- selected_real_kind = real_infos (i) % kind
- return
- end if
- end do
-
- if (.not. (found_p)) selected_real_kind = selected_real_kind - 1
- if (.not. (found_r)) selected_real_kind = selected_real_kind - 2
-
- return
- end function
--- 0 ----
Index: intrinsics/selected_real_kind.f90
===================================================================
RCS file: intrinsics/selected_real_kind.f90
diff -N intrinsics/selected_real_kind.f90
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- intrinsics/selected_real_kind.f90 30 Aug 2004 21:30:24 -0000
***************
*** 0 ****
--- 1,61 ----
+ ! Copyright 2003, 2004 Free Software Foundation, Inc.
+ ! Contributed by Kejia Zhao <kejia_zh@yahoo.com.cn>
+ !
+ !This file is part of the GNU Fortran 95 runtime library (libgfor).
+ !
+ !GNU libgfor is free software; you can redistribute it and/or
+ !modify it under the terms of the GNU Lesser General Public
+ !License as published by the Free Software Foundation; either
+ !version 2.1 of the License, or (at your option) any later version.
+ !
+ !GNU libgfor is distributed in the hope that it will be useful,
+ !but WITHOUT ANY WARRANTY; without even the implied warranty of
+ !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ !GNU Lesser General Public License for more details.
+ !
+ !You should have received a copy of the GNU Lesser General Public
+ !License along with libgfor; see the file COPYING. If not,
+ !write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ !Boston, MA 02111-1307, USA.
+ !
+
+ function selected_real_kind (p, r)
+ implicit none
+ integer, optional, intent (in) :: p, r
+ integer :: selected_real_kind
+ integer :: i, p2, r2
+ logical :: found_p, found_r
+ ! Real kind_precision_range table
+ type :: real_info
+ integer :: kind
+ integer :: precision
+ integer :: range
+ end type real_info
+
+ include "selected_real_kind.inc"
+
+ selected_real_kind = 0
+ p2 = 0
+ r2 = 0
+ found_p = .false.
+ found_r = .false.
+
+ if (present (p)) p2 = p
+ if (present (r)) r2 = r
+
+ ! Assumes each type has a greater precision and range than previous one.
+
+ do i = 1, c
+ if (p2 <= real_infos (i) % precision) found_p = .true.
+ if (r2 <= real_infos (i) % range) found_r = .true.
+ if (found_p .and. found_r) then
+ selected_real_kind = real_infos (i) % kind
+ return
+ end if
+ end do
+
+ if (.not. (found_p)) selected_real_kind = selected_real_kind - 1
+ if (.not. (found_r)) selected_real_kind = selected_real_kind - 2
+
+ return
+ end function