Skip to content

GitLab

Commit fae3592a authored by Uwe Schulzweida's avatar Uwe Schulzweida
Browse files

Fortran interface update.

parent 13649648
Hide whitespace changes
Inline Side-by-side
src/cdi.inc
View file @ fae3592a
......@@ -536,6 +536,19 @@
!
! time format: hhmmss
!
! cdiDecodeDate
! (INTEGER date,
! INTEGER year,
! INTEGER month,
! INTEGER day)
EXTERNAL cdiDecodeDate
INTEGER cdiEncodeDate
! (INTEGER year,
! INTEGER month,
! INTEGER day)
EXTERNAL cdiEncodeDate
! cdiDecodeTime
! (INTEGER time,
! INTEGER hour,
......
src/cdiFortran.c
View file @ fae3592a
/* Automatically generated by make_fint.c, don't edit! */
#if defined (HAVE_CONFIG_H)
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
#if ! defined (CDI_H_)
#ifndef CDI_H_
# include "cdi.h"
#endif
#if defined (HAVE_CF_INTERFACE)
#ifdef HAVE_CF_INTERFACE
#include <limits.h>
#include <assert.h>
#if ! defined (__CFORTRAN_LOADED)
#ifndef __CFORTRAN_LOADED
# if defined __clang__
# pragma GCC diagnostic push
# pragma GCC diagnostic ignored "-Wreserved-id-macro"
......@@ -25,10 +25,17 @@
#endif
/* These functions are meant to be called from Fortran and don't
* need an interface declaration in a C header. */
#if defined __clang__
#ifdef __clang__
# pragma GCC diagnostic ignored "-Wmissing-prototypes"
#endif
static inline
int int64_t_c2f(int64_t value_int64_t)
{
assert(value_int64_t < INT_MAX);
return (int) value_int64_t;
}
static inline
int size_t_c2f(size_t value_size_t)
{
......@@ -127,6 +134,18 @@ FCALLSCFUN3 (INT, cdiEncodeParam, CDIENCODEPARAM, cdiencodeparam, INT, INT, INT)
/* time format: hhmmss */
static void cdiDecodeDate_fwrap(int date, int *year, int *month, int *day)
{
cdiDecodeDate((int64_t)date, year, month, day);
}
FCALLSCSUB4 (cdiDecodeDate_fwrap, CDIDECODEDATE, cdidecodedate, INT, PINT, PINT, PINT)
static int cdiEncodeDate_fwrap(int year, int month, int day)
{
int64_t v;
v = cdiEncodeDate(year, month, day);
return int64_t_c2f(v);
}
FCALLSCFUN3 (INT, cdiEncodeDate_fwrap, CDIENCODEDATE, cdiencodedate, INT, INT, INT)
FCALLSCSUB4 (cdiDecodeTime, CDIDECODETIME, cdidecodetime, INT, PINT, PINT, PINT)
FCALLSCFUN3 (INT, cdiEncodeTime, CDIENCODETIME, cdiencodetime, INT, INT, INT)
......
src/make_fint.c
View file @ fae3592a
......@@ -86,7 +86,7 @@ static void doctotxt(FILE *fp, Docu *doc, size_t ndoc)
}
}
enum cftype {ISVOID, ISCONSTSTRING, ISINT, ISREAL, ISDOUBLE, ISSIZET, ISMPI_COMM,
enum cftype {ISVOID, ISCONSTSTRING, ISINT, ISREAL, ISDOUBLE, ISINT64T, ISSIZET, ISMPI_COMM,
ISXT_IDXLIST, ISCHOICE, ISINTP, ISSIZETP, ISFLOATV, ISFLOATVV,
ISDOUBLEV, ISDOUBLEVV, ISINTV, ISINTVV, ISINTVVV, ISREALP,
ISDOUBLEP, ISCBUF, ISUUID, ISUCHAR, ISSTRING, ISSTRINGP,
......@@ -107,6 +107,9 @@ typedef int (*cfPrologueEmitter)(FILE *outfp, size_t argNum);
static int cfMPICommConvert(FILE *outfp, const char *argName,
size_t argNameLen, enum conversionType part);
static int cfInt64tConvert(FILE *outfp, const char *argName,
size_t argNameLen, enum conversionType part);
static int cfSizetConvert(FILE *outfp, const char *argName,
size_t argNameLen, enum conversionType part);
......@@ -162,6 +165,9 @@ static struct symbol funArgSym[]
"^"WS"*(const"WS"+)?float"WS"+"SYMRE"?"WS"*[,\\)]", 2, 0, 0 },
{ "DOUBLEPRECISION", "DOUBLE", "%sdouble %.*s",
"^"WS"*(const"WS"+)?double"WS"+"SYMRE"?"WS"*[,\\)]", 2, 0, 0 },
{ "INTEGER", "INT", "%sint64_t %.*s",
"^"WS"*(const"WS"+)?int64_t("WS"+"SYMRE")?"WS"*[,\\)]", 3, 1, 0,
cfInt64tConvert, "%sint %.*s" },
{ "INTEGER", "INT", "%ssize_t %.*s",
"^"WS"*(const"WS"+)?size_t("WS"+"SYMRE")?"WS"*[,\\)]", 3, 1, 0,
cfSizetConvert, "%sint %.*s" },
......@@ -233,6 +239,8 @@ static struct symbol funRet[] = {
"(const"WS"+)?double"WS"+"SYMRE WS"*\\(", 2, 0, 0 },
{ "INTEGER", "INT", "%sMPI_Comm %.*s",
"MPI_Comm"WS"+"SYMRE WS"*\\(", 1, 0, 0, cfMPICommConvert, "%sint %.*s" },
{ "INTEGER", "INT", "%sint64_t %.*s",
"(const"WS"+)?int64_t"WS"+"SYMRE WS"*\\(", 2, 1, 0, cfInt64tConvert, "%sint %.*s" },
{ "INTEGER", "INT", "%ssize_t %.*s",
"(const"WS"+)?size_t"WS"+"SYMRE WS"*\\(", 2, 1, 0, cfSizetConvert, "%sint %.*s" },
};
......@@ -398,7 +406,7 @@ static void fortran_interface(char *fname, char *fnameinc, char *fnameint,
fprintf(fpint, "/* Automatically generated by make_fint.c, don't edit! */\n");
fprintf(fpint, "\n");
fprintf(fpint, "#if defined (HAVE_CONFIG_H)\n");
fprintf(fpint, "#ifdef HAVE_CONFIG_H\n");
fprintf(fpint, "# include \"config.h\"\n");
fprintf(fpint, "#endif\n");
fprintf(fpint, "\n");
......@@ -411,17 +419,17 @@ static void fortran_interface(char *fname, char *fnameinc, char *fnameint,
cppHeaderSentinelMacroLen = fbasenameLen + 1;
cppHeaderSentinelMacro = (char *)malloc(fbasenameLen + 2);
build_header_name(fbasenameLen, fbasename, cppHeaderSentinelMacro);
fprintf(fpint, "#if ! defined (%s)\n"
fprintf(fpint, "#ifndef %s\n"
"# include \"%s\"\n"
"#endif\n"
"\n", cppHeaderSentinelMacro, fbasename);
}
fputs("#if defined (HAVE_CF_INTERFACE)\n"
fputs("#ifdef HAVE_CF_INTERFACE\n"
"\n"
"#include <limits.h>\n"
"#include <assert.h>\n"
"\n"
"#if ! defined (__CFORTRAN_LOADED)\n"
"#ifndef __CFORTRAN_LOADED\n"
"# if defined __clang__\n"
"# pragma GCC diagnostic push\n"
"# pragma GCC diagnostic ignored \"-Wreserved-id-macro\"\n"
......@@ -433,11 +441,19 @@ static void fortran_interface(char *fname, char *fnameinc, char *fnameint,
"#endif\n"
"/* These functions are meant to be called from Fortran and don't\n"
" * need an interface declaration in a C header. */\n"
"#if defined __clang__\n"
"#ifdef __clang__\n"
"# pragma GCC diagnostic ignored \"-Wmissing-prototypes\"\n"
"#endif\n"
"\n", fpint);
fputs("static inline\n"
"int int64_t_c2f(int64_t value_int64_t)\n"
"{\n"
" assert(value_int64_t < INT_MAX);\n"
" return (int) value_int64_t;\n"
"}\n"
"\n", fpint);
fputs("static inline\n"
"int size_t_c2f(size_t value_size_t)\n"
"{\n"
......@@ -1240,9 +1256,26 @@ reCompile(regex_t *restrict RE, const char *restrict REstring,
return errcode;
}
/* emit conversion code for int64_t argument */
static int cfInt64tConvert(FILE *outfp, const char *argName,
size_t argNameLen, enum conversionType part)
{
int retval = 0;
switch (part)
{
case CONV_ARG:
retval = fprintf(outfp, "(int64_t)%.*s", (int)argNameLen, argName);
break;
case CONV_RET:
retval = fprintf(outfp, "int64_t_c2f(%.*s)", (int)argNameLen, argName);
break;
}
return retval;
}
/* emit conversion code for size_t argument */
static int cfSizetConvert(FILE *outfp, const char *argName,
size_t argNameLen, enum conversionType part)
size_t argNameLen, enum conversionType part)
{
int retval = 0;
switch (part)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment