This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]