diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 18 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/dump-parse-tree.c | 250 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/invoke.texi | 34 | ||||
| -rw-r--r-- | gcc/fortran/lang.opt | 4 | ||||
| -rw-r--r-- | gcc/fortran/parse.c | 3 |
7 files changed, 313 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 799ae4f..bd9ecc3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,21 @@ +2017-08-01 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/45435 + * lang.opt (fc-prototypes): Add option. + * gfortran.h (gfc_typespec): Add interop_kind to struct. + (gfc_dump_c_prototypes): Add prototype. + * decl.c (gfc_match_kind_spec): Copy symbol used for kind to typespec. + * parse.c (gfc_parse_file): Call gfc_dump_prototypes. + * dump-parse-tree.c (gfc_dump_c_prototypes): New function. + (type_return): New enum. + (get_c_type_name): New function. + (write_decl): New function. + (write_type): New function. + (write_variable): New function. + (write_proc): New function. + (write_interop_decl): New function. + * invoke.texi: Document -fc-prototypes. + 2017-08-01 Dominique d'Humieres <dominiq@lps.ens.fr> PR fortran/53542 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index bd31070..54ee5d3 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2631,6 +2631,8 @@ kind_expr: of the named constants from iso_c_binding. */ ts->is_c_interop = e->ts.is_iso_c; ts->f90_type = e->ts.f90_type; + if (e->symtree) + ts->interop_kind = e->symtree->n.sym; } gfc_free_expr (e); diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 46b3705..da9c541 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -2891,3 +2891,253 @@ gfc_dump_parse_tree (gfc_namespace *ns, FILE *file) show_namespace (ns); } +/* This part writes BIND(C) definition for use in external C programs. */ + +static void write_interop_decl (gfc_symbol *); + +void +gfc_dump_c_prototypes (gfc_namespace *ns, FILE *file) +{ + int error_count; + gfc_get_errors (NULL, &error_count); + if (error_count != 0) + return; + dumpfile = file; + gfc_traverse_ns (ns, write_interop_decl); +} + +enum type_return { T_OK=0, T_WARN, T_ERROR }; + +/* Return the name of the type for later output. Both function pointers and + void pointers will be mapped to void *. */ + +static enum type_return +get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre, + const char **type_name, bool *asterisk, const char **post, + bool func_ret) +{ + static char post_buffer[40]; + enum type_return ret; + ret = T_ERROR; + + *pre = " "; + *asterisk = false; + *post = ""; + *type_name = "<error>"; + if (ts->type == BT_REAL || ts->type == BT_INTEGER) + { + + if (ts->is_c_interop && ts->interop_kind) + { + *type_name = ts->interop_kind->name + 2; + if (strcmp (*type_name, "signed_char") == 0) + *type_name = "signed char"; + else if (strcmp (*type_name, "size_t") == 0) + *type_name = "ssize_t"; + + ret = T_OK; + } + else + { + /* The user did not specify a C interop type. Let's look through + the available table and use the first one, but warn. */ + int i; + for (i=0; i<ISOCBINDING_NUMBER; i++) + { + if (c_interop_kinds_table[i].f90_type == ts->type + && c_interop_kinds_table[i].value == ts->kind) + { + *type_name = c_interop_kinds_table[i].name + 2; + if (strcmp (*type_name, "signed_char") == 0) + *type_name = "signed char"; + else if (strcmp (*type_name, "size_t") == 0) + *type_name = "ssize_t"; + + ret = T_WARN; + break; + } + } + } + } + else if (ts->type == BT_DERIVED) + { + if (ts->u.derived->from_intmod == INTMOD_ISO_C_BINDING) + { + if (strcmp (ts->u.derived->name, "c_ptr") == 0) + *type_name = "void"; + else if (strcmp (ts->u.derived->name, "c_funptr") == 0) + { + *type_name = "int "; + if (func_ret) + { + *pre = "("; + *post = "())"; + } + else + { + *pre = "("; + *post = ")()"; + } + } + *asterisk = true; + } + else + *type_name = ts->u.derived->name; + + ret = T_OK; + } + if (ret != T_ERROR && as) + { + mpz_t sz; + bool size_ok; + size_ok = spec_size (as, &sz); + gcc_assert (size_ok == true); + gmp_snprintf (post_buffer, sizeof(post_buffer), "[%Zd]", sz); + *post = post_buffer; + mpz_clear (sz); + } + return ret; +} + +/* Write out a declaration. */ +static void +write_decl (gfc_typespec *ts, gfc_array_spec *as, const char *sym_name, + bool func_ret) +{ + const char *pre, *type_name, *post; + bool asterisk; + enum type_return rok; + + rok = get_c_type_name (ts, as, &pre, &type_name, &asterisk, &post, func_ret); + gcc_assert (rok != T_ERROR); + fputs (type_name, dumpfile); + fputs (pre, dumpfile); + if (asterisk) + fputs ("*", dumpfile); + + fputs (sym_name, dumpfile); + fputs (post, dumpfile); + + if (rok == T_WARN) + fputs(" /* WARNING: non-interoperable KIND */", dumpfile); +} + +/* Write out an interoperable type. It will be written as a typedef + for a struct. */ + +static void +write_type (gfc_symbol *sym) +{ + gfc_component *c; + + fprintf (dumpfile, "typedef struct %s {\n", sym->name); + for (c = sym->components; c; c = c->next) + { + fputs (" ", dumpfile); + write_decl (&(c->ts), c->as, c->name, false); + fputs (";\n", dumpfile); + } + + fprintf (dumpfile, "} %s;\n", sym->name); +} + +/* Write out a variable. */ + +static void +write_variable (gfc_symbol *sym) +{ + const char *sym_name; + + gcc_assert (sym->attr.flavor == FL_VARIABLE); + + if (sym->binding_label) + sym_name = sym->binding_label; + else + sym_name = sym->name; + + fputs ("extern ", dumpfile); + write_decl (&(sym->ts), sym->as, sym_name, false); + fputs (";\n", dumpfile); +} + + +/* Write out a procedure, including its arguments. */ +static void +write_proc (gfc_symbol *sym) +{ + const char *pre, *type_name, *post; + bool asterisk; + enum type_return rok; + gfc_formal_arglist *f; + const char *sym_name; + const char *intent_in; + + if (sym->binding_label) + sym_name = sym->binding_label; + else + sym_name = sym->name; + + if (sym->ts.type == BT_UNKNOWN) + { + fprintf (dumpfile, "void "); + fputs (sym_name, dumpfile); + } + else + write_decl (&(sym->ts), sym->as, sym->name, true); + + fputs (" (", dumpfile); + + for (f = sym->formal; f; f = f->next) + { + gfc_symbol *s; + s = f->sym; + rok = get_c_type_name (&(s->ts), NULL, &pre, &type_name, &asterisk, + &post, false); + gcc_assert (rok != T_ERROR); + + if (!s->attr.value) + asterisk = true; + + if (s->attr.intent == INTENT_IN && !s->attr.value) + intent_in = "const "; + else + intent_in = ""; + + fputs (intent_in, dumpfile); + fputs (type_name, dumpfile); + fputs (pre, dumpfile); + if (asterisk) + fputs ("*", dumpfile); + + fputs (s->name, dumpfile); + fputs (post, dumpfile); + if (rok == T_WARN) + fputs(" /* WARNING: non-interoperable KIND */ ", dumpfile); + + fputs (f->next ? ", " : ")", dumpfile); + } + fputs (";\n", dumpfile); +} + + +/* Write a C-interoperable declaration as a C prototype or extern + declaration. */ + +static void +write_interop_decl (gfc_symbol *sym) +{ + /* Only dump bind(c) entities. */ + if (!sym->attr.is_bind_c) + return; + + /* Don't dump our iso c module. */ + if (sym->from_intmod == INTMOD_ISO_C_BINDING) + return; + + if (sym->attr.flavor == FL_VARIABLE) + write_variable (sym); + else if (sym->attr.flavor == FL_DERIVED) + write_type (sym); + else if (sym->attr.flavor == FL_PROCEDURE) + write_proc (sym); +} diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 26b89be..4d51d14 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1012,6 +1012,7 @@ typedef struct int is_iso_c; bt f90_type; bool deferred; + gfc_symbol *interop_kind; } gfc_typespec; @@ -3311,6 +3312,7 @@ void gfc_delete_bbt (void *, void *, compare_fn); /* dump-parse-tree.c */ void gfc_dump_parse_tree (gfc_namespace *, FILE *); +void gfc_dump_c_prototypes (gfc_namespace *, FILE *); /* parse.c */ bool gfc_parse_file (void); diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 8a1d09d..15fdc16 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -100,6 +100,8 @@ one is not the default. * Runtime Options:: Influencing runtime behavior * Code Gen Options:: Specifying conventions for function calls, data layout and register usage. +* Interoperability Options:: Options for interoperability with other + languages. * Environment Variables:: Environment variables that affect @command{gfortran}. @end menu @@ -171,6 +173,10 @@ and warnings}. -frecord-marker=@var{length} -fsign-zero } +@item Interoperability Options +@xref{Interoperability Options,,Options for interoperability}. +@gccoptlist{-fc-prototypes} + @item Code Generation Options @xref{Code Gen Options,,Options for code generation conventions}. @gccoptlist{-faggressive-function-elimination -fblas-matmul-limit=@var{n} @gol @@ -1746,6 +1752,34 @@ shared by @command{gfortran}, @command{gcc}, and other GNU compilers. @c man end +@node Interoperability Options +@section Options for interoperability with other languages + +@table @asis + +@item -fc-prototypes +@opindex @code{c-prototypes} +@cindex Generating C prototypes from Fortran source code +This option will generate C prototypes from @code{BIND(C)} variable +declarations, types and procedure interfaces and writes them to +standard output. @code{ENUM} is not yet supported. + +The generated prototypes may need inclusion of an appropriate header, +such as @code{<stdint.h>} or @code{<stdlib.h>}. For types which are +not specified using the appropriate kind from the @code{iso_c_binding} +module, a warning is added as a comment to the code. + +For function pointers, a pointer to a function returning @code{int} +without an explicit argument list is generated. + +Example of use: +@smallexample +$ gfortran -fc-prototypes -fsyntax-only foo.f90 > foo.h +@end smallexample +where the C code intended for interoperating with the Fortran code +then uses @code{#include "foo.h"}. +@end table + @node Environment Variables @section Environment variables affecting @command{gfortran} @cindex environment variable diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 4421ce4..94185da 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -416,6 +416,10 @@ fcray-pointer Fortran Var(flag_cray_pointer) Use the Cray Pointer extension. +fc-prototypes +Fortran Var(flag_c_prototypes) +Generate C prototypes from BIND(C) declarations. + fd-lines-as-code Fortran RejectNegative Ignore 'D' in column one in fixed form. diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 305a036..9ac50f0 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -6218,6 +6218,9 @@ loop: if (flag_dump_fortran_original) gfc_dump_parse_tree (gfc_current_ns, stdout); + if (flag_c_prototypes) + gfc_dump_c_prototypes (gfc_current_ns, stdout); + gfc_get_errors (NULL, &errors); if (s.state == COMP_MODULE || s.state == COMP_SUBMODULE) { |