diff options
| -rw-r--r-- | Examples/Makefile.in | 29 | ||||
| -rw-r--r-- | Examples/fortran/array/Makefile | 29 | ||||
| -rw-r--r-- | Examples/fortran/array/example.c | 23 | ||||
| -rw-r--r-- | Examples/fortran/array/example.i | 8 | ||||
| -rw-r--r-- | Examples/fortran/array/runme.f | 34 | ||||
| -rw-r--r-- | Examples/fortran/simple/Makefile | 29 | ||||
| -rw-r--r-- | Examples/fortran/simple/example.c | 17 | ||||
| -rw-r--r-- | Examples/fortran/simple/example.i | 7 | ||||
| -rw-r--r-- | Examples/fortran/simple/runme.f | 27 | ||||
| -rw-r--r-- | Examples/fortran/string/Makefile | 29 | ||||
| -rw-r--r-- | Examples/fortran/string/example.c | 9 | ||||
| -rw-r--r-- | Examples/fortran/string/example.i | 6 | ||||
| -rw-r--r-- | Examples/fortran/string/runme.f | 23 | ||||
| -rw-r--r-- | Lib/fortran/fortran.swg | 86 | ||||
| -rw-r--r-- | Makefile.in | 2 | ||||
| -rw-r--r-- | Source/DOH/doh.h | 3 | ||||
| -rw-r--r-- | Source/DOH/string.c | 5 | ||||
| -rw-r--r-- | Source/Makefile.am | 1 | ||||
| -rw-r--r-- | Source/Modules/emit.cxx | 181 | ||||
| -rw-r--r-- | Source/Modules/fortran.cxx | 255 | ||||
| -rw-r--r-- | Source/Modules/swigmain.cxx | 2 | ||||
| -rw-r--r-- | Source/Modules/swigmod.h | 2 | ||||
| -rw-r--r-- | Source/Swig/parms.c | 19 | ||||
| -rw-r--r-- | Source/Swig/swigparm.h | 3 | ||||
| -rw-r--r-- | configure.in | 23 |
25 files changed, 850 insertions, 2 deletions
diff --git a/Examples/Makefile.in b/Examples/Makefile.in index 32eaeccd9..9641103c4 100644 --- a/Examples/Makefile.in +++ b/Examples/Makefile.in @@ -1142,6 +1142,35 @@ r_clean: rm -f $(RRSRC) runme.Rout .RData ################################################################## +##### FORTRAN ###### +################################################################## + +F77=@F77@ +CLIBPREFIX = lib +#C_SO = @C_SO@ +#C_LDSHARED = @C_LDSHARED@ +#CXX_LDSHARED = @CXX_LDSHARED@ + + +fortran: $(SRCS) + $(SWIG) -fortran $(SWIGOPT) $(INTERFACEPATH) + $(CC) -c $(CCSHARED) $(CFLAGS) $(ISRCS) $(INCLUDES) $(SRCS) + $(LDSHARED) $(CFLAGS) $(OBJS) $(IOBJS) $(LIBS) -o $(CLIBPREFIX)$(TARGET)$(SO) + +fortran_cpp: $(SRCS) + $(SWIG) -c++ -fortran $(SWIGOPT) $(INTERFACEPATH) + $(CXX) -c $(CCSHARED) $(CFLAGS) $(ICXXSRCS) $(SRCS) $(CXXSRCS) $(INCLUDES) + $(CXXSHARED) $(CFLAGS) $(OBJS) $(IOBJS) $(LIBS) $(CPP_DLLIBS) -o $(CLIBPREFIX)$(TARGET)$(SO) + +fortran_compile: $(RUNME) $(PROXY) + $(F77) $(RUNME) $(PROXY) -L. -l$(TARGET) -o $(RUNME:.f=) + +fortran_clean: + rm -f *_wrap* *~ .~* + rm -f core @EXTRA_CLEAN@ + rm -f *.@OBJEXT@ *@SO@ + +################################################################## ##### Go ###### ################################################################## diff --git a/Examples/fortran/array/Makefile b/Examples/fortran/array/Makefile new file mode 100644 index 000000000..3643921d8 --- /dev/null +++ b/Examples/fortran/array/Makefile @@ -0,0 +1,29 @@ +TOP = ../.. +SWIG = $(TOP)/../preinst-swig -debug-module 4 > tree.txt +SRCS = example.c +TARGET = example +INTERFACE = example.i +RUNME = runme.f +PROXY = +MEMTOOL = valgrind --leak-check=full + +all:: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' fortran + $(MAKE) -f $(TOP)/Makefile RUNME='$(RUNME)' PROXY='$(PROXY)' \ + TARGET='$(TARGET)' fortran_compile + +run: + env LD_LIBRARY_PATH=. ./runme + +memchk: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' CFLAGS='-g' fortran + $(MAKE) -f $(TOP)/Makefile RUNME='$(RUNME)' PROXY='$(PROXY)' \ + TARGET='$(TARGET)' CFLAGS='-g' fortran_compile + env LD_LIBRARY_PATH=. $(MEMTOOL) ./runme + +clean: + rm -f *.o *.so *.out *.a *.exe *.dll *.dylib *_wrap* *_proxy* *~ runme + +check: all diff --git a/Examples/fortran/array/example.c b/Examples/fortran/array/example.c new file mode 100644 index 000000000..d720509f2 --- /dev/null +++ b/Examples/fortran/array/example.c @@ -0,0 +1,23 @@ +/* File : example.c */ +#include <stdio.h> + +/* A global variable */ +double Foo = 3.0; + +/* Compute the greatest common divisor of positive integers */ +int* incrArrayInt(int *x, int nmemb) { + g = y; + while (x > 0) { + g = x; + x = y % x; + y = g; + } + return g; +} + +void sayhi(char *str, int y, char *ret) { + if (ret != NULL) { + sprintf(ret, "hello %s", str); + } + return; +} diff --git a/Examples/fortran/array/example.i b/Examples/fortran/array/example.i new file mode 100644 index 000000000..bf55fab52 --- /dev/null +++ b/Examples/fortran/array/example.i @@ -0,0 +1,8 @@ +/* File : example.i */ +%module example + +%inline %{ +extern int gcd(int x, int y); +extern void sayhi(char *x, int y, char *ret); +//extern double Foo; +%} diff --git a/Examples/fortran/array/runme.f b/Examples/fortran/array/runme.f new file mode 100644 index 000000000..5b89105b1 --- /dev/null +++ b/Examples/fortran/array/runme.f @@ -0,0 +1,34 @@ +! ---------------------------------------------------------------------- +! EXAMPLE: Calling a C function from fortran using swig. +! +! This simple example shows how to call a c funtion from Fortran +! +! ====================================================================== +! AUTHOR: Derrick Kearney, Purdue University +! Copyright (c) 2005-2010 Purdue Research Foundation +! +! See the file "license.terms" for information on usage and +! redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +! ====================================================================== + + program runme + IMPLICIT NONE + + integer gcd, a, b , g + + character*5 str + character*20 ret + + a = 45 + b = 105 + g = 0 + + g = gcd(a, b) + write(*,*) "The gcd of ", a," and ", b, " is ", g + + call sayhi(str, a, ret) + write(*,*) "The result of sayhi is ", ret + + +! Swig_exit(0) + end program runme diff --git a/Examples/fortran/simple/Makefile b/Examples/fortran/simple/Makefile new file mode 100644 index 000000000..159300edb --- /dev/null +++ b/Examples/fortran/simple/Makefile @@ -0,0 +1,29 @@ +TOP = ../.. +SWIG = $(TOP)/../preinst-swig -debug-typemap -debug-module 4 > tree.txt +SRCS = example.c +TARGET = example +INTERFACE = example.i +RUNME = runme.f +PROXY = +MEMTOOL = valgrind --leak-check=full + +all:: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' fortran + $(MAKE) -f $(TOP)/Makefile RUNME='$(RUNME)' PROXY='$(PROXY)' \ + TARGET='$(TARGET)' fortran_compile + +run: + env LD_LIBRARY_PATH=. ./runme + +memchk: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' CFLAGS='-g' fortran + $(MAKE) -f $(TOP)/Makefile RUNME='$(RUNME)' PROXY='$(PROXY)' \ + TARGET='$(TARGET)' CFLAGS='-g' fortran_compile + env LD_LIBRARY_PATH=. $(MEMTOOL) ./runme + +clean: + rm -f *.o *.so *.out *.a *.exe *.dll *.dylib *_wrap* *_proxy* *~ runme + +check: all diff --git a/Examples/fortran/simple/example.c b/Examples/fortran/simple/example.c new file mode 100644 index 000000000..d81afc269 --- /dev/null +++ b/Examples/fortran/simple/example.c @@ -0,0 +1,17 @@ +/* File : example.c */ +#include <stdio.h> + +/* A global variable */ +double Foo = 3.0; + +/* Compute the greatest common divisor of positive integers */ +int gcd(int x, int y) { + int g; + g = y; + while (x > 0) { + g = x; + x = y % x; + y = g; + } + return g; +} diff --git a/Examples/fortran/simple/example.i b/Examples/fortran/simple/example.i new file mode 100644 index 000000000..52b4dde83 --- /dev/null +++ b/Examples/fortran/simple/example.i @@ -0,0 +1,7 @@ +/* File : example.i */ +%module example + +%inline %{ +extern int gcd(int x, int y); +//extern double Foo; +%} diff --git a/Examples/fortran/simple/runme.f b/Examples/fortran/simple/runme.f new file mode 100644 index 000000000..fa25dcccb --- /dev/null +++ b/Examples/fortran/simple/runme.f @@ -0,0 +1,27 @@ +! ---------------------------------------------------------------------- +! EXAMPLE: Calling a C function from fortran using swig. +! +! This simple example shows how to call a c funtion from Fortran +! +! ====================================================================== +! AUTHOR: Derrick Kearney, Purdue University +! Copyright (c) 2005-2010 Purdue Research Foundation +! +! See the file "license.terms" for information on usage and +! redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +! ====================================================================== + + program runme + IMPLICIT NONE + + integer gcd, a, b , g + + a = 45 + b = 105 + g = 0 + + g = gcd(a, b) + write(*,*) "The gcd of ", a," and ", b, " is ", g + +! Swig_exit(0) + end program runme diff --git a/Examples/fortran/string/Makefile b/Examples/fortran/string/Makefile new file mode 100644 index 000000000..159300edb --- /dev/null +++ b/Examples/fortran/string/Makefile @@ -0,0 +1,29 @@ +TOP = ../.. +SWIG = $(TOP)/../preinst-swig -debug-typemap -debug-module 4 > tree.txt +SRCS = example.c +TARGET = example +INTERFACE = example.i +RUNME = runme.f +PROXY = +MEMTOOL = valgrind --leak-check=full + +all:: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' fortran + $(MAKE) -f $(TOP)/Makefile RUNME='$(RUNME)' PROXY='$(PROXY)' \ + TARGET='$(TARGET)' fortran_compile + +run: + env LD_LIBRARY_PATH=. ./runme + +memchk: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' CFLAGS='-g' fortran + $(MAKE) -f $(TOP)/Makefile RUNME='$(RUNME)' PROXY='$(PROXY)' \ + TARGET='$(TARGET)' CFLAGS='-g' fortran_compile + env LD_LIBRARY_PATH=. $(MEMTOOL) ./runme + +clean: + rm -f *.o *.so *.out *.a *.exe *.dll *.dylib *_wrap* *_proxy* *~ runme + +check: all diff --git a/Examples/fortran/string/example.c b/Examples/fortran/string/example.c new file mode 100644 index 000000000..85d00b612 --- /dev/null +++ b/Examples/fortran/string/example.c @@ -0,0 +1,9 @@ +/* File : example.c */ +#include <stdio.h> + +void sayhi(char *str, char *ret) { + if (ret != NULL) { + sprintf(ret, "hello %s", str); + } + return; +} diff --git a/Examples/fortran/string/example.i b/Examples/fortran/string/example.i new file mode 100644 index 000000000..f9a57c7be --- /dev/null +++ b/Examples/fortran/string/example.i @@ -0,0 +1,6 @@ +/* File : example.i */ +%module example + +%inline %{ +extern void sayhi(char *x, char *ret); +%} diff --git a/Examples/fortran/string/runme.f b/Examples/fortran/string/runme.f new file mode 100644 index 000000000..db73d78fe --- /dev/null +++ b/Examples/fortran/string/runme.f @@ -0,0 +1,23 @@ +! ---------------------------------------------------------------------- +! EXAMPLE: Calling a C function from fortran using swig. +! +! The string example shows how to call a c funtion from Fortran +! +! ====================================================================== + + program runme + IMPLICIT NONE + + character (LEN=7) :: name="derrick" + character*20 ret + + call sayhi(name, ret) + write(*,*) "The result of sayhi is: ", ret + +! This case does not work +! call sayhi("derrick", ret) +! write(*,*) "The result of sayhi is: ", ret + + +! Swig_exit(0) + end program runme diff --git a/Lib/fortran/fortran.swg b/Lib/fortran/fortran.swg new file mode 100644 index 000000000..b42daed0c --- /dev/null +++ b/Lib/fortran/fortran.swg @@ -0,0 +1,86 @@ +/* ----------------------------------------------------------------------------- + * See the LICENSE file for information on copyright, usage and redistribution + * of SWIG, and the README file for authors - http://www.swig.org/release.html. + * + * fortran.swg + * ----------------------------------------------------------------------------- */ + +%insert("runtime") %{ +#include <stdlib.h> +#include <string.h> +#include <ctype.h> +%} + +%typemap(in, replaceparm="$type *$input", noblock=1) int, float, double { + $1 = *$input; +} +%typemap(in) char "$1 = $input;" +%typemap(in) int *, float *, double * "$1 = $input;" +%typemap(in, extraparm="size_t $1_len", noblock=1) char * { + $1 = Swig_null_terminate($input, $1_len); +} + +// %typemap(argout) int, float, double "*$output = $input;" +%typemap(argout, noblock=1) char * { + Swig_fortranify($1, $input, $1_len); + free($1); +} + +%insert(runtime) %{ +char* Swig_null_terminate(char* inStr, int len) { + int retVal = 0; + char* newStr = NULL; + char* current = NULL; + + if (inStr && (len > 0) ) { + + current = inStr+len-1; + + while ((len > 0) && (isspace(*(current)))) { + // dont strip off newlines + + if ( (*(current) == '\f') + || (*(current) == '\n') + || (*(current) == '\r') + || (*(current) == '\t') + || (*(current) == '\v') ) + { + break; + } + + if (--len) { + current--; + } + } + + newStr = (char*) calloc(len+1,(sizeof(char))); + strncpy(newStr,inStr,len); + *(newStr+len) = '\0'; + + retVal++; + } + + return newStr; +} +%} + +%insert(runtime) %{ +void Swig_fortranify(const char* inBuff, char* retText, int retTextLen) { + + int inBuffLen = 0; + int i = 0; + + if (inBuff && retText && (retTextLen > 0)) { + inBuffLen = strlen(inBuff); + + strncpy(retText, inBuff, retTextLen); + + // fortran-ify the string + if (inBuffLen < retTextLen) { + for (i = inBuffLen; i < retTextLen; i++) { + retText[i] = ' '; + } + } + } +} +%} diff --git a/Makefile.in b/Makefile.in index a12366e12..475e3b218 100644 --- a/Makefile.in +++ b/Makefile.in @@ -417,7 +417,7 @@ install-main: @$(INSTALL_PROGRAM) $(TARGET) $(DESTDIR)$(BIN_DIR)/`echo $(TARGET_NOEXE) | sed '$(transform)'`@EXEEXT@ lib-languages = gcj typemaps tcl perl5 python guile java mzscheme ruby php ocaml octave \ - pike chicken csharp modula3 allegrocl clisp lua cffi uffi r go d + pike chicken csharp modula3 allegrocl clisp lua cffi uffi r go d fortran lib-modules = std diff --git a/Source/DOH/doh.h b/Source/DOH/doh.h index bca5f0f0f..cfa6d79b2 100644 --- a/Source/DOH/doh.h +++ b/Source/DOH/doh.h @@ -99,6 +99,7 @@ #define DohStrncmp DOH_NAMESPACE(Strncmp) #define DohStrstr DOH_NAMESPACE(Strstr) #define DohStrchr DOH_NAMESPACE(Strchr) +#define DohStrrchr DOH_NAMESPACE(Strrchr) #define DohNewFile DOH_NAMESPACE(NewFile) #define DohNewFileFromFile DOH_NAMESPACE(NewFileFromFile) #define DohNewFileFromFd DOH_NAMESPACE(NewFileFromFd) @@ -285,6 +286,7 @@ extern int DohStrcmp(const DOHString_or_char *s1, const DOHString_or_char *s2); extern int DohStrncmp(const DOHString_or_char *s1, const DOHString_or_char *s2, int n); extern char *DohStrstr(const DOHString_or_char *s1, const DOHString_or_char *s2); extern char *DohStrchr(const DOHString_or_char *s1, int ch); +extern char *DohStrrchr(const DOHString_or_char *s1, int ch); /* String replacement flags */ @@ -421,6 +423,7 @@ extern void DohMemoryDebug(void); #define Strncmp DohStrncmp #define Strstr DohStrstr #define Strchr DohStrchr +#define Strrchr DohStrrchr #define Copyto DohCopyto #define Split DohSplit #define SplitLines DohSplitLines diff --git a/Source/DOH/string.c b/Source/DOH/string.c index c326e9f40..ac770cea2 100644 --- a/Source/DOH/string.c +++ b/Source/DOH/string.c @@ -1131,6 +1131,7 @@ DOHString *DohNewStringf(const DOHString_or_char *fmt, ...) { * Strncmp() * Strstr() * Strchr() + * Strrchr() * * Some utility functions. * ----------------------------------------------------------------------------- */ @@ -1158,3 +1159,7 @@ char *DohStrstr(const DOHString_or_char *s1, const DOHString_or_char *s2) { char *DohStrchr(const DOHString_or_char *s1, int ch) { return strchr(Char(s1), ch); } + +char *DohStrrchr(const DOHString_or_char *s1, int ch) { + return strrchr(Char(s1), ch); +} diff --git a/Source/Makefile.am b/Source/Makefile.am index 984b9c268..0313dcade 100644 --- a/Source/Makefile.am +++ b/Source/Makefile.am @@ -45,6 +45,7 @@ eswig_SOURCES = CParse/cscanner.c \ Modules/d.cxx \ Modules/directors.cxx \ Modules/emit.cxx \ + Modules/fortran.cxx \ Modules/go.cxx \ Modules/guile.cxx \ Modules/java.cxx \ diff --git a/Source/Modules/emit.cxx b/Source/Modules/emit.cxx index 0c6c6515f..2a91ce2d6 100644 --- a/Source/Modules/emit.cxx +++ b/Source/Modules/emit.cxx @@ -14,6 +14,7 @@ char cvsroot_emit_cxx[] = "$Id$"; #include "swigmod.h" +#include <ctype.h> /* ----------------------------------------------------------------------------- * emit_return_variable() @@ -98,6 +99,186 @@ void emit_parameter_variables(ParmList *l, Wrapper *f) { } /* ----------------------------------------------------------------------------- + * apply_extraparm_attribute() + * + * returns tmap:in:extraparm attribute with variable replacements. + * ----------------------------------------------------------------------------- */ + +String *apply_extraparm_attribute(Parm *p) { + + String *s = Getattr(p,"tmap:in:extraparm"); + if (s != NULL) { + Replaceall(s,"$1",Getattr(p, "lname")); + } + return s; +} + +/* ----------------------------------------------------------------------------- + * apply_replaceparm_attribute() + * + * returns tmap:in:replaceparm attribute variable replacements. + * ----------------------------------------------------------------------------- */ + +String *apply_replaceparm_attribute(Parm *p) { + + String *s = Getattr(p,"tmap:in:replaceparm"); + if (s != NULL) { + Replaceall(s,"$type",Getattr(p, "type")); + Replaceall(s,"$input",Getattr(p, "name")); + } + return s; +} + + +/* ----------------------------------------------------------------------------- + * emit_parm_str() + * + * Returns a string of function parameter prototypes with extraparm attached. + * ----------------------------------------------------------------------------- */ + +String *emit_parm_str(ParmList *p) { + + String *s; + String *parmStr = NewStringEmpty(); + String *extraParmStr = NewStringEmpty(); + int pLen = 0; + int epLen = 0; + + while (p) { + // check for extraparm attribute + s = apply_extraparm_attribute(p); + + if (s != NULL) { + if (epLen > 0) { + Append(extraParmStr, ","); + } + Append(extraParmStr, s); + epLen++; + } + + // check for replaceparm attribute + s = apply_replaceparm_attribute(p); + if (pLen > 0) { + Append(parmStr, ","); + } + String *o = NULL; + if (s == NULL) { + // if there was no parm replacement, use the original parm. + String *type = Getattr(p, "type"); + o = SwigType_str(type ? type : NewStringEmpty(), Getattr(p, "name")); + s = o; + } + Append(parmStr, s); + if (o != NULL) { + Delete(o); + } + o = NULL; + pLen++; + + p = nextSibling(p); + } + + // add extra parameters at the end as necessary + if (epLen > 0) { + if (pLen > 0) { + Append(parmStr,","); + } + Append(parmStr,extraParmStr); + } + + return parmStr; +} + +/* ----------------------------------------------------------------------------- + * parse_name_from_arg() + * + * given a string like "size_t s_len", return the variable name s_len. + * this function is used to parse strings from a typemaps with the + * extraparms="size_t $1_len" attribute + * ----------------------------------------------------------------------------- */ + +char *parse_name_from_arg(String *arg) { + //FIXME: this is a bad way of parsing parameters from their types + // wish the text could be sent through the parser for correct parsing + char *s = NULL; + + if (arg == NULL) { + return NULL; + } + + s = Strrchr(arg,' '); + if (s != NULL) { + s++; + // lazy way of finding valid variable names + // valid variable names are a sequence of one or + // more letters, digits or underscore characters (_) + while (!isalnum(*s) && (*s != '_')) { + s++; + } + } else { + s = Char(arg); + } + + return s; +} + +/* ----------------------------------------------------------------------------- + * emit_args_str() + * + * Returns a string of function arguments with extraparm attached. + * ----------------------------------------------------------------------------- */ + +String *emit_args_str(ParmList *p) { + + String *s; + String *parmStr = NewStringEmpty(); + String *extraParmStr = NewStringEmpty(); + int pLen = 0; + int epLen = 0; + char *name = NULL; + + while (p) { + // check for extraparm attribute + s = apply_extraparm_attribute(p); + if (s != NULL) { + if (epLen > 0) { + Append(extraParmStr, ","); + } + name = parse_name_from_arg(s); + Append(extraParmStr, name); + epLen++; + } + + // check for replaceparm attribute + s = apply_replaceparm_attribute(p); + if (pLen > 0) { + Append(parmStr, ","); + } + if (s != NULL) { + name = parse_name_from_arg(s); + Append(parmStr, name); + } else { + // if there was no parm replacement, use the original parm. + s = Getattr(p, "name"); + Append(parmStr, s); + } + pLen++; + + p = nextSibling(p); + } + + // add extra parameters at the end as necessary + if (epLen > 0) { + if (pLen > 0) { + Append(parmStr,","); + } + Append(parmStr,extraParmStr); + } + + return parmStr; +} + +/* ----------------------------------------------------------------------------- * emit_attach_parmmaps() * * Attach the standard parameter related typemaps. diff --git a/Source/Modules/fortran.cxx b/Source/Modules/fortran.cxx new file mode 100644 index 000000000..ae43b6d56 --- /dev/null +++ b/Source/Modules/fortran.cxx @@ -0,0 +1,255 @@ +/* ----------------------------------------------------------------------------- + * This file is part of SWIG, which is licensed as a whole under version 3- + * (or any later version) of the GNU General Public License. Some additional + * terms also apply to certain portions of SWIG. The full details of the SWIG + * license and copyrights can be found in the LICENSE and COPYRIGHT files + * included with the SWIG source code as distributed by the SWIG developers + * and at http://www.swig.org/legal.html. + * + * fortran.cxx + * + * Fortran language module for SWIG. + * ----------------------------------------------------------------------------- */ + +char cvsroot_fortran_cxx[] = "$Id:$"; + + +#include "swigmod.h" + +class FORTRAN:public Language { +protected: + static const char *usage; + + /* General DOH objects used for holding the strings */ + File *f_begin; + File *f_runtime; + File *f_header; + File *f_wrappers; + File *f_proxyfxns; + File *f_init; + + +public: + + virtual void main(int argc, char *argv[]); + + virtual int top(Node *n); + virtual int functionWrapper(Node *n); +// virtual int variableWrapper(Node *n); + +}; + +void FORTRAN::main(int argc, char *argv[]) { + printf("I'm the Fortran module.\n"); + /* parse command line options + */ + for (int i = 1; i < argc; i++) { + if (argv[i]) { + if (strcmp(argv[i], "-help") == 0) { + fputs(usage, stderr); + } + } + } + + /* Set language-specific subdirectory in SWIG library */ + SWIG_library_directory("fortran"); + + /* Set language-specific preprocessing symbol */ + Preprocessor_define("SWIGFORTRAN 1", 0); + + /* Set language-specific configuration file */ + SWIG_config_file("fortran.swg"); + + /* Set typemap language (historical) */ + SWIG_typemap_lang("fortran"); + +} + +int FORTRAN::top(Node *n) { + + printf("Generating code.\n"); + + /* Get the module name */ + // String *module = Getattr(n,"name"); + + /* Get the output file name */ + String *outfile = Getattr(n, "outfile"); + + /* Initialize I/O */ + f_begin = NewFile(outfile, "w", SWIG_output_files()); + if (!f_begin) { + FileErrorDisplay(outfile); + SWIG_exit(EXIT_FAILURE); + } + f_runtime = NewString(""); + f_init = NewString(""); + f_header = NewString(""); + f_wrappers = NewString(""); + f_proxyfxns = NewString(""); + + /* Register file targets with the SWIG file handler */ + Swig_register_filebyname("begin", f_begin); + Swig_register_filebyname("header", f_header); + Swig_register_filebyname("wrapper", f_wrappers); + Swig_register_filebyname("proxyfxns", f_proxyfxns); + Swig_register_filebyname("runtime", f_runtime); + Swig_register_filebyname("init", f_init); + + /* Output module initialization code */ + Swig_banner(f_begin); + + /* Emit code for children */ + Language::top(n); + + /* Write all to the file */ + Dump(f_runtime, f_begin); + Dump(f_header, f_begin); + Dump(f_wrappers, f_begin); + Dump(f_proxyfxns, f_begin); + Wrapper_pretty_print(f_init, f_begin); + + /* Cleanup files */ + Delete(f_runtime); + Delete(f_header); + Delete(f_wrappers); + Delete(f_proxyfxns); + Delete(f_init); + Close(f_begin); + Delete(f_begin); + + return SWIG_OK; +} + +int FORTRAN::functionWrapper(Node *n) { + Printf(stdout, "creating function wrapper\n"); + String *symname = Getattr(n, "sym:name"); + String *type = Getattr(n, "type"); + + Wrapper *f = NewWrapper(); + Wrapper *fproxy = NewWrapper(); + + ParmList *parms = Getattr(n, "parms"); + + // create new wrapper name + String *wname = Swig_name_wrapper(symname); + Setattr(n, "wrap:name", wname); + + // create the function definition + String *return_type = SwigType_str(type, 0); + + /* Attach standard typemaps */ + emit_attach_parmmaps(parms, f); + Setattr(n, "wrap:parms", parms); + + /* Generate prototype and parameter strings + with extra parameters attached. extra parameters + are not sent through the typemap system. */ + String *parmStr = emit_parm_str(parms); + String *argsStr = emit_args_str(parms); + + Printv(f->def, return_type, " ", wname, "(", parmStr, ") {\n", NIL); + + // create alternative call functions (proxyfxns) + // create proxy function with single underscore + Printv(fproxy->def, return_type, " ", symname, "_", "(", parmStr, ") {\n", NIL); + + bool is_void_return = (SwigType_type(type) == T_VOID); + if (!is_void_return) { + Printf(fproxy->code, "return "); + } + + Printv(fproxy->code, wname, "(", argsStr, ")", ";\n}", NIL); + Wrapper_print(fproxy, f_proxyfxns); + + // create proxy function with double underscore + // create proxy function in all caps + + // Emit all of the local variables for holding arguments. + emit_parameter_variables(parms, f); + + + // Emit variable holding return value. + emit_return_variable(n, return_type, f); + + String *tm; + Parm *p; + + /* Insert input typemap code */ + String *inarg = NewString(""); + p = parms; + while (p) { + if ((tm = Getattr(p, "tmap:in"))) { + Replaceall(tm, "$1", Getattr(p, "lname")); + Replaceall(tm, "$input", Getattr(p, "name")); + Printv(inarg, tm, "\n", NIL); + p = Getattr(p, "tmap:in:next"); + } else { + p = nextSibling(p); + } + } + + /* Insert argument output code */ + String *outarg = NewString(""); + p = parms; + while (p) { + if ((tm = Getattr(p, "tmap:argout"))) { + Replaceall(tm, "$1", Getattr(p, "lname")); + Replaceall(tm, "$input", Getattr(p, "name")); + Printv(outarg, tm, "\n", NIL); + p = Getattr(p, "tmap:argout:next"); + } else { + p = nextSibling(p); + } + } + + // attach local variables to parameters + + // print input typemap conversions to wrapper. + Printv(f->code, inarg, "\n", NIL); + Delete(inarg); + + if (!is_void_return) { + Printf(f->code, "result = "); + } + + // create function call + // get function definition arguments + String *empty_string = NewString(""); + String *arg_names = Swig_cfunction_call(empty_string, parms); + Printv(f->code, symname, arg_names, ";\n", NIL); + Delete(empty_string); + Delete(arg_names); + + // attach output arguments + Printv(f->code, "\n", outarg, "\n", NIL); + Delete(outarg); + + if (!is_void_return) { + Printf(f->code, "return result;\n"); + } + Printf(f->code, "}"); + // write out the wrapper file + Wrapper_print(f, f_wrappers); + +#if 0 + Delete(symname); + Delete(type); + Delete(wname); + Delete(return_type); + Delete(parmStr); + Delete(argsStr); +#endif + + return SWIG_OK; +} + +extern "C" Language *swig_fortran(void) { + return new FORTRAN(); +} + +/* ----------------------------------------------------------------------------- + * Static member variables + * ----------------------------------------------------------------------------- */ + +const char *FORTRAN::usage = (char *) "\ +\n"; diff --git a/Source/Modules/swigmain.cxx b/Source/Modules/swigmain.cxx index 01ab1b79f..bcccf7a1b 100644 --- a/Source/Modules/swigmain.cxx +++ b/Source/Modules/swigmain.cxx @@ -32,6 +32,7 @@ extern "C" { Language *swig_python(void); Language *swig_perl5(void); Language *swig_ruby(void); + Language *swig_fortran(void); Language *swig_guile(void); Language *swig_modula3(void); Language *swig_mzscheme(void); @@ -72,6 +73,7 @@ static swig_module modules[] = { {"-cffi", swig_cffi, "CFFI"}, {"-csharp", swig_csharp, "C#"}, {"-d", swig_d, "D"}, + {"-fortran", swig_fortran, "FORTRAN"}, {"-go", swig_go, "Go"}, {"-guile", swig_guile, "Guile"}, {"-java", swig_java, "Java"}, diff --git a/Source/Modules/swigmod.h b/Source/Modules/swigmod.h index 208a7b026..142130628 100644 --- a/Source/Modules/swigmod.h +++ b/Source/Modules/swigmod.h @@ -336,6 +336,8 @@ void SWIG_library_directory(const char *); int emit_num_arguments(ParmList *); int emit_num_required(ParmList *); int emit_isvarargs(ParmList *); +String *emit_parm_str(ParmList *p); +String *emit_args_str(ParmList *p); void emit_attach_parmmaps(ParmList *, Wrapper *f); void emit_mark_varargs(ParmList *l); String *emit_action(Node *n); diff --git a/Source/Swig/parms.c b/Source/Swig/parms.c index 283a2f5c2..4e0a0554a 100644 --- a/Source/Swig/parms.c +++ b/Source/Swig/parms.c @@ -227,6 +227,25 @@ String *ParmList_protostr(ParmList *p) { } /* --------------------------------------------------------------------- + * ParmList_argsstr() + * + * Generate a arguments string. + * ---------------------------------------------------------------------- */ + +String *ParmList_argsstr(ParmList *p) { + String *out = NewStringEmpty(); + while (p) { + String *name = Getattr(p, "name"); + Append(out, name); + p = nextSibling(p); + if (p) { + Append(out, ","); + } + } + return out; +} + +/* --------------------------------------------------------------------- * ParmList_has_defaultargs() * * Returns 1 if the parameter list passed in is has one or more default diff --git a/Source/Swig/swigparm.h b/Source/Swig/swigparm.h index 70a39390e..51a3dacfa 100644 --- a/Source/Swig/swigparm.h +++ b/Source/Swig/swigparm.h @@ -9,7 +9,7 @@ * swigparm.h * * Functions related to the handling of function/method parameters and - * parameter lists. + * parameter lists. * ----------------------------------------------------------------------------- */ /* Individual parameters */ @@ -29,5 +29,6 @@ extern String *ParmList_str(ParmList *); extern String *ParmList_str_defaultargs(ParmList *); extern String *ParmList_str_multibrackets(ParmList *); extern String *ParmList_protostr(ParmList *); +extern String *ParmList_argsstr(ParmList *); diff --git a/configure.in b/configure.in index 052bf07c1..d84919861 100644 --- a/configure.in +++ b/configure.in @@ -1992,6 +1992,29 @@ fi AC_SUBST(RBIN) #---------------------------------------------------------------- +# Look for Fortran 77 +#---------------------------------------------------------------- + +F77= + +AC_ARG_WITH(f77, AS_HELP_STRING([--without-f77], [Disable Fortran 77]) +AS_HELP_STRING([--with-f77=path], [Set location of Fortran 77 Compiler (f77)]),[ F77="$withval"], [F77=yes]) + +# First, check for "--without-f77" or "--with-f77=no". +if test x"${F77}" = xno -o x"${with_alllang}" = xno ; then +AC_MSG_NOTICE([Disabling Fortran 77]) +F77= +else + +# can we find F77? +if test "x$F77" = xyes; then + AC_PATH_PROGS(F77, gfortran g77 f77) +fi +fi + +AC_SUBST(F77) + +#---------------------------------------------------------------- # Look for Go compilers #---------------------------------------------------------------- |