Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
mpim-sw
libcdi
Commits
fae3592a
Commit
fae3592a
authored
May 11, 2018
by
Uwe Schulzweida
Browse files
Fortran interface update.
parent
13649648
Changes
3
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
def
ined (
HAVE_CONFIG_H
)
#ifdef
HAVE_CONFIG_H
# include "config.h"
#endif
#if
! defined (
CDI_H_
)
#if
ndef
CDI_H_
# include "cdi.h"
#endif
#if
def
ined (
HAVE_CF_INTERFACE
)
#ifdef
HAVE_CF_INTERFACE
#include
<limits.h>
#include
<assert.h>
#if
! defined (
__CFORTRAN_LOADED
)
#if
ndef
__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
def
ined
__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
def
ined (
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
,
"#if
ndef
%s
\n
"
"# include
\"
%s
\"\n
"
"#endif
\n
"
"
\n
"
,
cppHeaderSentinelMacro
,
fbasename
);
}
fputs
(
"#if
def
ined (
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
"
"#if
ndef
__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
def
ined
__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
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment