[PATCH, fortran] Interoperability with C int128_t types
Sa Liu
SALIU@de.ibm.com
Tue Apr 15 10:42:00 GMT 2008
Sorry for the late response. How about this patch?
On platforms that do not support 128-bit integer, it will behave the same
as if -std=f2003 is given.
The patch has been regtested on spu-linux.
Thanks!
Sa
Index: gcc/gcc/ChangeLog
===================================================================
--- gcc.orig/gcc/ChangeLog
+++ gcc/gcc/ChangeLog
@@ -1,3 +1,22 @@
+2008-04-15 Sa Liu <saliu@de.ibm.com>
+ * fortran/iso-c-binding.def: Add standard parameter to macro
+ NAMED_INTCST. All existing NAMED_INTCST definitions has standard
+ GFC_STD_F2003, c_int128_t, c_int_least128_t and c_int_fast128_t
+ are added as GNU extensions.
+ * fortran/iso-fortran-evn.def: Add standard parameter
GFC_STD_F2003
+ to macro NAMED_INTCST.
+ * fortran/symbol.c (gnu_only_isocbinding): New helper funciton to
+ check types only supported as GNU extensions.
+ (generate_isocbinding_symbol): Do not generate GNU extension
symbols
+ if std=f2003. Add new parameter to NAMED_INTCST.
+ * fortran/module.c (use_iso_fortran_env_module): Add new parameter
+ to NAMED_INTCST.
+ * fortran/gfortran.h: Add new parameter to NAMED_INTCST.
+ * fortran/trans-types.c (init_c_interop_kinds): Add new parameter
+ to NAMED_INTCST.
+ * testsuite/gfortran.dg/c_kind_int128_test1.f03: New.
+ * testsuite/gfortran.dg/c_kind_int128_test2.f03: New.
+
2008-04-14 Ian Lance Taylor <iant@google.com>
* fold-const.c (fold_overflow_warning): Remove assertion.
Index: gcc/gcc/fortran/intrinsic.texi
===================================================================
--- gcc.orig/gcc/fortran/intrinsic.texi
+++ gcc/gcc/fortran/intrinsic.texi
@@ -11021,7 +11021,7 @@ Identifies the preconnected unit identif
@section @code{ISO_C_BINDING}
@table @asis
@item @emph{Standard}:
-Fortran 2003 and later
+Fortran 2003 and later, GNU extensions
@end table
The following intrinsic procedures are provided by the module; their
@@ -11042,6 +11042,8 @@ Fortran currently does not support the @
parameters (marked by an asterisk (@code{*}) in the list below).
The @code{C_INT_FAST...} parameters have therefore the value @math{-2}
and cannot be used as KIND type parameter of the @code{INTEGER} type.
+Note that the 128-bit integers @code{C_INT128_T, C_INT_LEAST128_T,
+C_INT_FAST128_T} are only GNU extensions and not supported by Fortran
2003.
@multitable @columnfractions .15 .35 .35
@item Fortran Type @tab Named constant @tab C type
@@ -11055,14 +11057,17 @@ and cannot be used as KIND type paramete
@item @code{INTEGER}@tab @code{C_INT16_T} @tab @code{int16_t}
@item @code{INTEGER}@tab @code{C_INT32_T} @tab @code{int32_t}
@item @code{INTEGER}@tab @code{C_INT64_T} @tab @code{int64_t}
+@item @code{INTEGER}@tab @code{C_INT128_T} @tab @code{int128_t}
@item @code{INTEGER}@tab @code{C_INT_LEAST8_T} @tab @code{int_least8_t}
@item @code{INTEGER}@tab @code{C_INT_LEAST16_T} @tab @code{int_least16_t}
@item @code{INTEGER}@tab @code{C_INT_LEAST32_T} @tab @code{int_least32_t}
@item @code{INTEGER}@tab @code{C_INT_LEAST64_T} @tab @code{int_least64_t}
+@item @code{INTEGER}@tab @code{C_INT_LEAST128_T} @tab
@code{int_least128_t}
@item @code{INTEGER}@tab @code{C_INT_FAST8_T}* @tab @code{int_fast8_t}
@item @code{INTEGER}@tab @code{C_INT_FAST16_T}* @tab @code{int_fast16_t}
@item @code{INTEGER}@tab @code{C_INT_FAST32_T}* @tab @code{int_fast32_t}
@item @code{INTEGER}@tab @code{C_INT_FAST64_T}* @tab @code{int_fast64_t}
+@item @code{INTEGER}@tab @code{C_INT_FAST128_T}* @tab
@code{int_fast128_t}
@item @code{INTEGER}@tab @code{C_INTMAX_T} @tab @code{intmax_t}
@item @code{INTEGER}@tab @code{C_INTPTR_T} @tab @code{intptr_t}
@item @code{REAL} @tab @code{C_FLOAT} @tab @code{float}
Index: gcc/gcc/fortran/gfortran.h
===================================================================
--- gcc.orig/gcc/fortran/gfortran.h
+++ gcc/gcc/fortran/gfortran.h
@@ -547,7 +547,7 @@ init_local_integer;
/* Used for keeping things in balanced binary trees. */
#define BBT_HEADER(self) int priority; struct self *left, *right
-#define NAMED_INTCST(a,b,c) a,
+#define NAMED_INTCST(a,b,c,d) a,
typedef enum
{
ISOFORTRANENV_INVALID = -1,
@@ -557,7 +557,7 @@ typedef enum
iso_fortran_env_symbol;
#undef NAMED_INTCST
-#define NAMED_INTCST(a,b,c) a,
+#define NAMED_INTCST(a,b,c,d) a,
#define NAMED_REALCST(a,b,c) a,
#define NAMED_CMPXCST(a,b,c) a,
#define NAMED_LOGCST(a,b,c) a,
Index: gcc/gcc/fortran/iso-c-binding.def
===================================================================
--- gcc.orig/gcc/fortran/iso-c-binding.def
+++ gcc/gcc/fortran/iso-c-binding.def
@@ -20,7 +20,7 @@ along with GCC; see the file COPYING3.
Fortran 2003 ISO_C_BINDING intrinsic module. */
#ifndef NAMED_INTCST
-# define NAMED_INTCST(a,b,c)
+# define NAMED_INTCST(a,b,c,d)
#endif
#ifndef NAMED_REALCST
@@ -42,44 +42,57 @@ along with GCC; see the file COPYING3.
/* The arguments to NAMED_*CST are:
-- an internal name
-- the symbol name in the module, as seen by Fortran code
- -- the value it has, for use in trans-types.c */
+ -- the value it has, for use in trans-types.c
+ -- the standard that support this type */
-NAMED_INTCST (ISOCBINDING_INT, "c_int", gfc_c_int_kind)
+NAMED_INTCST (ISOCBINDING_INT, "c_int", gfc_c_int_kind, GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_SHORT, "c_short", \
- get_int_kind_from_node (short_integer_type_node))
+ get_int_kind_from_node (short_integer_type_node),
GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_LONG, "c_long", \
- get_int_kind_from_node (long_integer_type_node))
+ get_int_kind_from_node (long_integer_type_node),
GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_LONG_LONG, "c_long_long", \
- get_int_kind_from_node (long_long_integer_type_node))
+ get_int_kind_from_node (long_long_integer_type_node),
GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_INTMAX_T, "c_intmax_t", \
- get_int_kind_from_node (intmax_type_node))
+ get_int_kind_from_node (intmax_type_node), GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_INTPTR_T, "c_intptr_t", \
- get_int_kind_from_node (ptr_type_node))
+ get_int_kind_from_node (ptr_type_node), GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_SIZE_T, "c_size_t", \
- gfc_index_integer_kind)
+ gfc_index_integer_kind, GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_SIGNED_CHAR, "c_signed_char", \
- get_int_kind_from_node (signed_char_type_node))
+ get_int_kind_from_node (signed_char_type_node),
GFC_STD_F2003)
-NAMED_INTCST (ISOCBINDING_INT8_T, "c_int8_t", get_int_kind_from_width
(8))
-NAMED_INTCST (ISOCBINDING_INT16_T, "c_int16_t", get_int_kind_from_width
(16))
-NAMED_INTCST (ISOCBINDING_INT32_T, "c_int32_t", get_int_kind_from_width
(32))
-NAMED_INTCST (ISOCBINDING_INT64_T, "c_int64_t", get_int_kind_from_width
(64))
+NAMED_INTCST (ISOCBINDING_INT8_T, "c_int8_t", get_int_kind_from_width
(8), \
+ GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT16_T, "c_int16_t", get_int_kind_from_width
(16), \
+ GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT32_T, "c_int32_t", get_int_kind_from_width
(32), \
+ GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT64_T, "c_int64_t", get_int_kind_from_width
(64), \
+ GFC_STD_F2003)
+/* GNU Extension. */
+NAMED_INTCST (ISOCBINDING_INT128_T, "c_int128_t", get_int_kind_from_width
(128), \
+ GFC_STD_GNU)
NAMED_INTCST (ISOCBINDING_INT_LEAST8_T, "c_int_least8_t", \
- get_int_kind_from_minimal_width (8))
+ get_int_kind_from_minimal_width (8), GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_INT_LEAST16_T, "c_int_least16_t", \
- get_int_kind_from_minimal_width (16))
+ get_int_kind_from_minimal_width (16), GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_INT_LEAST32_T, "c_int_least32_t", \
- get_int_kind_from_minimal_width (32))
+ get_int_kind_from_minimal_width (32), GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_INT_LEAST64_T, "c_int_least64_t", \
- get_int_kind_from_minimal_width (64))
+ get_int_kind_from_minimal_width (64), GFC_STD_F2003)
+/* GNU Extension. */
+NAMED_INTCST (ISOCBINDING_INT_LEAST128_T, "c_int_least128_t", \
+ get_int_kind_from_minimal_width (128), GFC_STD_GNU)
/* TODO: Implement c_int_fast*_t. Depends on PR 448. */
-NAMED_INTCST (ISOCBINDING_INT_FAST8_T, "c_int_fast8_t", -2)
-NAMED_INTCST (ISOCBINDING_INT_FAST16_T, "c_int_fast16_t", -2)
-NAMED_INTCST (ISOCBINDING_INT_FAST32_T, "c_int_fast32_t", -2)
-NAMED_INTCST (ISOCBINDING_INT_FAST64_T, "c_int_fast64_t", -2)
+NAMED_INTCST (ISOCBINDING_INT_FAST8_T, "c_int_fast8_t", -2,
GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_FAST16_T, "c_int_fast16_t", -2,
GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_FAST32_T, "c_int_fast32_t", -2,
GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_FAST64_T, "c_int_fast64_t", -2,
GFC_STD_F2003)
+/* GNU Extension. */
+NAMED_INTCST (ISOCBINDING_INT_FAST128_T, "c_int_fast128_t", -2,
GFC_STD_GNU)
NAMED_REALCST (ISOCBINDING_FLOAT, "c_float", \
get_real_kind_from_node (float_type_node))
Index: gcc/gcc/fortran/iso-fortran-env.def
===================================================================
--- gcc.orig/gcc/fortran/iso-fortran-env.def
+++ gcc/gcc/fortran/iso-fortran-env.def
@@ -22,15 +22,22 @@ along with GCC; see the file COPYING3.
/* The arguments to NAMED_INTCST are:
-- an internal name
-- the symbol name in the module, as seen by Fortran code
- -- the value it has */
+ -- the value it has
+ -- the standard that support this type */
NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE,
"character_storage_size", \
- gfc_character_storage_size)
-NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit",
GFC_STDERR_UNIT_NUMBER)
-NAMED_INTCST (ISOFORTRANENV_FILE_STORAGE_SIZE, "file_storage_size", 8)
-NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit",
GFC_STDIN_UNIT_NUMBER)
-NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", LIBERROR_END)
-NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR)
+ gfc_character_storage_size, GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit",
GFC_STDERR_UNIT_NUMBER, \
+ GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_FILE_STORAGE_SIZE, "file_storage_size", 8, \
+ GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit",
GFC_STDIN_UNIT_NUMBER, \
+ GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", LIBERROR_END, \
+ GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR, \
+ GFC_STD_F2003)
NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size",
\
- gfc_numeric_storage_size)
-NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit",
GFC_STDOUT_UNIT_NUMBER)
+ gfc_numeric_storage_size, GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit",
GFC_STDOUT_UNIT_NUMBER, \
+ GFC_STD_F2003)
Index: gcc/gcc/fortran/module.c
===================================================================
--- gcc.orig/gcc/fortran/module.c
+++ gcc/gcc/fortran/module.c
@@ -4630,13 +4630,13 @@ use_iso_fortran_env_module (void)
int i;
intmod_sym symbol[] = {
-#define NAMED_INTCST(a,b,c) { a, b, 0 },
+#define NAMED_INTCST(a,b,c,d) { a, b, 0, d },
#include "iso-fortran-env.def"
#undef NAMED_INTCST
{ ISOFORTRANENV_INVALID, NULL, -1234 } };
i = 0;
-#define NAMED_INTCST(a,b,c) symbol[i++].value = c;
+#define NAMED_INTCST(a,b,c,d) symbol[i++].value = c;
#include "iso-fortran-env.def"
#undef NAMED_INTCST
Index: gcc/gcc/fortran/symbol.c
===================================================================
--- gcc.orig/gcc/fortran/symbol.c
+++ gcc/gcc/fortran/symbol.c
@@ -3740,6 +3740,14 @@ build_formal_args (gfc_symbol *new_proc_
gfc_current_ns = parent_ns;
}
+static int
+gnu_only_isocbinding (const char *name)
+{
+#define NAMED_INTCST(a,b,c,d) \
+ if (!strcmp (b, name)) \
+ return (d == GFC_STD_GNU);
+#include "iso-c-binding.def"
+}
/* Generate the given set of C interoperable kind objects, or all
interoperable kinds. This function will only be given kind objects
@@ -3765,6 +3773,9 @@ generate_isocbinding_symbol (const char
char comp_name[(GFC_MAX_SYMBOL_LEN * 2) + 1];
int index;
+ if (gfc_notification_std (GFC_STD_GNU) == FAILURE
+ && gnu_only_isocbinding (name))
+ return;
tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
/* Already exists in this scope so don't re-add it.
@@ -3788,13 +3799,12 @@ generate_isocbinding_symbol (const char
switch (s)
{
-#define NAMED_INTCST(a,b,c) case a :
+#define NAMED_INTCST(a,b,c,d) case a :
#define NAMED_REALCST(a,b,c) case a :
#define NAMED_CMPXCST(a,b,c) case a :
#define NAMED_LOGCST(a,b,c) case a :
#define NAMED_CHARKNDCST(a,b,c) case a :
#include "iso-c-binding.def"
-
tmp_sym->value = gfc_int_expr (c_interop_kinds_table[s].value);
/* Initialize an integer constant expression node. */
Index: gcc/gcc/fortran/trans-types.c
===================================================================
--- gcc.orig/gcc/fortran/trans-types.c
+++ gcc/gcc/fortran/trans-types.c
@@ -219,7 +219,7 @@ void init_c_interop_kinds (void)
c_interop_kinds_table[i].f90_type = BT_UNKNOWN;
}
-#define NAMED_INTCST(a,b,c) \
+#define NAMED_INTCST(a,b,c,d) \
strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
c_interop_kinds_table[a].f90_type = BT_INTEGER; \
c_interop_kinds_table[a].value = c;
Index: gcc/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03
===================================================================
--- /dev/null
+++ gcc/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Note: int_fast*_t currently not supported.
+
+subroutine c_kind_int128_1
+ use, intrinsic :: iso_c_binding
+ implicit none
+
+ integer(c_int128_t) :: a ! { dg-error "has no IMPLICIT type" }
+ integer(c_int_least128_t) :: b ! { dg-error "has no IMPLICIT type" }
+! integer(c_int_fast128_t) :: c
+
+end subroutine c_kind_int128_1
+
+subroutine c_kind_int128_2
+ use, intrinsic :: iso_c_binding
+
+ integer(c_int128_t) :: a ! { dg-error "has not been declared or is a
variable" }
+ integer(c_int_least128_t) :: b ! { dg-error "has not been declared or
is a variable" }
+! integer(c_int_fast128_t) :: c
+
+end subroutine c_kind_int128_2
Index: gcc/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03
===================================================================
--- /dev/null
+++ gcc/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+!
+! Note: int_fast*_t currently not supported.
+
+program c_kind_int128
+ use, intrinsic :: iso_c_binding
+ integer(c_int128_t) :: a
+ integer(c_int_least128_t) :: b
+! integer(c_int_fast128_t) :: c
+
+ if (sizeof (a) /= 16) call abort
+ if (sizeof (b) /= 16) call abort
+! if (sizeof (c) /= 16) call abort
+end program c_kind_int128
More information about the Fortran
mailing list