Arjen Markus 2005-01-03: In december 2004 Gustav Ivanovic posted the code below in the Fortran and Tcl newsgroups:
Still, it makes clear that access to functions and routines in other languages than C is really easy.
Gustav Ivanovic: I add "c" type argument and a test with Win32 APIs.
namespace eval Fortran {
##############################################################
# Provide simplified declarations to call fortran routines in
# a DLL built using Compaq Visual Fortran
# Please use as you wish, but there is no guarantee whatsoever.
#
# Please report bugs. Thank you.
# [email protected]
###############################################################
catch {package require Ffidl}
proc Binarize {varType args} {
foreach var $args {
upvar $var x
if [regexp {[ac]} $varType] {
set x [binary format a* $x]
} else {
set x [binary format $varType[llength $x] $x]
}
}
};#End proc Binarize
proc deBinarize {varType args} {
foreach var $args {
upvar $var x
switch $varType {
i {binary scan $x i[expr {[string length $x]/4}] x}
f {binary scan $x f[expr {[string length $x]/4}] x}
d {binary scan $x d[expr {[string length $x]/8}] x}
default {binary scan $x a* x}
}
}
};#End proc deBinarize
proc declareRoutine {DLLname routineName argDef {tclName {}} {returnType {}}} {
####################
# usage:
# Fortran::declareRoutine dllName routineName argDef tclName returnType
# e.g Fortran::declareRoutine FtnTcl.dll scalarproduct {f f i} SCAPROD f
##########################
# argument definition is
# a or A string of charaters (add hidden length argument)
# c or C string of charaters (without the hidden length argument)
# I or i integer or array of integers
# F or f or R or r real or array of reals
# D or d double precision or array of double precision reals
#
# if no tclName specified, a command routineName is created.
# However, I recommend to specify a tclName
# Example
# a. Fortran::declareRoutine FtnTcl.dll doublevectorsum {D D D i}
# a new command named doublevectorsum is created
# b. Fortran::declareRoutine FtnTcl.dll doublevectorsum {D D D i} doublSum
# a new command named doublSum is created
##########################
if {$tclName == {}} {
set tclName $routineName
}
set ffidlDecl {}
set argTypeList {}
set argList {}
set argCount 0
# store argument type as a list
foreach i $argDef {
lappend argList arg$argCount
lappend ffidlDecl pointer-var
set varType [string index $i 0]
switch -regexp $varType {
[iI] {lappend argTypeList i}
[rRfF] {lappend argTypeList f}
[dD] {lappend argTypeList d}
[cC] {lappend argTypeList c}
default { ;# if it is not integer or a real then it is a string
# append hidden length argument
lappend ffidlDecl int
lappend argTypeList a
}
}
incr argCount
}
# define return value type. Only void, integer, real and double
set retType [string index $returnType 0]
switch -regexp $retType {
[iI] {set retType int}
[rRfF] {set retType float}
[dD] {set retType double}
default {set retType void}
}
# DEBUG
# puts [subst {ffidl::callout ::Fortran::ffidl-$routineName {$ffidlDecl} $retType [ffidl::symbol $DLLname $routineName]}]
eval [subst {ffidl::callout ::Fortran::ffidl-$routineName {$ffidlDecl} $retType [ffidl::symbol $DLLname $routineName]}]
# Define a procedure that Binarizes, call the entry in the DLL and deBinarizes (stored in cmd and to be eval'ed)
set cmd {}
append cmd {proc ::} $tclName " \{$argList\} \{"
for {set i 0} {$i < $argCount} {incr i} {
append cmd "\n upvar \$[lindex $argList $i] x$i"
}
for {set i 0} {$i < $argCount} {incr i} {
append cmd "\n ::Fortran::Binarize [lindex $argTypeList $i] x$i"
}
set ffidlArgs {}
for {set i 0} {$i < $argCount} {incr i} {
append ffidlArgs " x$i"
if {[lindex $argTypeList $i] == "a"} {
append ffidlArgs { [string length $} "x$i" {]}
}
}
append cmd "\n set retval \[ ::Fortran::ffidl-$routineName $ffidlArgs \]"
for {set i 0} {$i < $argCount} {incr i} {
append cmd "\n ::Fortran::deBinarize [lindex $argTypeList $i] x$i"
}
append cmd "\n return \$retval\n" \}
# DEBUG
# puts $cmd
# make that new command
eval $cmd
};#End proc declareRoutine
};#End namespace Fortran
proc test {} {
load ffidl05
# Declare all routines
####################
# usage
# Fortran::declareRoutine dllName routineName argDef tclName returnType
# e.g Fortran::declareRoutine FtnTcl.dll scalarproduct {f f i} SCAPROD f
####################
Fortran::declareRoutine FtnTcl.dll string a STRING
# in the above example
# if no tclName is specified, then it creates confusion with "string"
Fortran::declareRoutine FtnTcl.dll realvector f
Fortran::declareRoutine FtnTcl.dll integervector i
Fortran::declareRoutine FtnTcl.dll scalarproduct {f f i} SCAPROD f
# we defined a new name and the return value type as a real
Fortran::declareRoutine FtnTcl.dll doublevectorsum {d d d i}
# Use of the declared functions starts here
puts "Test 1"
set a {1 2 3}
puts "a was $a"
integervector a
puts "a is now "
puts $a
puts "\n\nTest 2"
set a {1 2 3}
set b {10 20 30}
set c {0 0 0}
set l 3
puts "a is $a"
puts "b is $b"
puts "c is $c"
doublevectorsum a b c l
puts "after"
puts "a is now $a"
puts "b is now $b"
puts "c is now $c"
puts "\n\nTest 3 scalar product <a,b>"
puts [SCAPROD a b l]
puts "a is +$a+"
STRING a
puts "a is now +$a+"
set l 32
# Testing Windows API
Fortran::declareRoutine advapi32.dll GetUserNameA {c i} GetUserNameA-TCL
Fortran::declareRoutine kernel32.dll GetComputerNameA {c i} GetComputerNameA-TCL
set a [string repeat + 64]
GetUserNameA-TCL a l
puts " User Name is $a"
GetComputerNameA-TCL a l
puts " Computer Name is $a"
}
# Run the test
testThis is the corresponding fortran code (to be compiled with Compaq Visual Fortran)
MODULE tcl
CONTAINS
SUBROUTINE doublevector(vector)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'doublevector' ::doublevector
DOUBLE PRECISION , DIMENSION(*) :: vector
vector(3)=3333.
END SUBROUTINE doublevector
SUBROUTINE realvector(vector)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'realvector' ::realvector
REAL , DIMENSION(*) :: vector
vector(2)=2222.
END SUBROUTINE realvector
SUBROUTINE integervector(vector)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'integervector' ::integervector
INTEGER , DIMENSION(*) :: vector
vector(1)=1111
END SUBROUTINE integervector
SUBROUTINE string(line)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'string'::string
CHARACTER(LEN=*) :: line
line='QWERTY'
END SUBROUTINE string
FUNCTION scalarproduct(x,y,n) RESULT (z)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'scalarproduct'::scalarproduct
INTEGER ::n
REAL, DIMENSION(n) :: x, y
REAL :: z
z=sum(x*y)
END FUNCTION scalarproduct
SUBROUTINE doublevectorsum(x,y,z,n)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'doublevectorsum'::doublevectorsum
INTEGER ::n
DOUBLE PRECISION, DIMENSION(n) :: x, y, z
z=x+y
END SUBROUTINE doublevectorsum
END MODULE tclNF - 2014-11-06 22:09:05
Gustav Ivanovic's code can work with the GNU Fortran compiler (gfortran), on both Windows and Linux, with some minor modifications on the Fortran side and in Gustav's code.
Part of the problem with is that gfortran doesn't support the ALIAS attribute in the compiler directives, such that you can't set a name that you want for the function in the DLL. By default, it has extra underscores added, and if the procedure is in a module, there are additional things like "mod" and the module name. These problems can be overcome by compiling with flags to remove the underscores, not having the functions in a module, and using a GCC compiler directive that includes STDCALL.
The resulting tcl.f90 file should thus look as follows:
SUBROUTINE doublevector(vector) !GCC$ ATTRIBUTES STDCALL :: doublevector DOUBLE PRECISION , DIMENSION(*) :: vector vector(3)=3333. END SUBROUTINE doublevector SUBROUTINE realvector(vector) !GCC$ ATTRIBUTES STDCALL :: realvector REAL , DIMENSION(*) :: vector vector(2)=2222. END SUBROUTINE realvector SUBROUTINE integervector(vector) !GCC$ ATTRIBUTES STDCALL :: integervector INTEGER , DIMENSION(*) :: vector vector(1)=1111 END SUBROUTINE integervector SUBROUTINE string(line) !GCC$ ATTRIBUTES STDCALL :: string CHARACTER(LEN=*) :: line line='QWERTY' END SUBROUTINE string FUNCTION scalarproduct(x,y,n) RESULT (z) !GCC$ ATTRIBUTES STDCALL :: scalarproduct INTEGER ::n REAL, DIMENSION(n) :: x, y REAL :: z z=sum(x*y) END FUNCTION scalarproduct SUBROUTINE doublevectorsum(x,y,z,n) !GCC$ ATTRIBUTES STDCALL :: doublevectorsum INTEGER ::n DOUBLE PRECISION, DIMENSION(n) :: x, y, z z=x+y END SUBROUTINE doublevectorsum
And then compile as follows:
gfortran -c -fno-underscoring tcl.f90 -o tcl.o gfortran -shared -mrtd -fno-underscoring -"Wl,--kill-at" -static-libgfortran -static-libgcc tcl.o -o FtnTcl.dll
The "static" flags are to make the DLL work on systems where gfortran hasn't been installed separately. Other flags (e.g. optimisation options) should also be added, as required.
Then, in order to run this (with tclkit, anyway), place the Tcl file containing Gustav's code and example (I've called it gustavscode.tcl) in the same directory as the tclkit executable, along with Ffidl06.dll. (Or whichever version of Ffidl you are using. Make sure that the "load Ffidl05" in Gustav's code is changed to the name corresponding to the Ffidl DLL you have, so, in my case, "load Ffidl06".) So with the tclkit executable, your Tcl file, FtnTcl.dll, and Ffidl06.dll in the same folder, run "tclkit gustavscode.tcl" in a Command Prompt or similar.
To get this working in Linux, first build the Ffidl shared library from source (unless you can find a Linux binary on the net; I couldn't). The only "tricky" bit about this is that you need the Tcl source code as well. First, navigate to "/path/to/tcl/source/code/unix" (note the unix bit), and run "./configure". This will generate tclConfig.sh. Now navigate back to "/path/to/ffidl/source/code" and run "./configure --with-tcl=/path/to/tcl/source/code/unix", then run "make". This will generate libFfidl0.6.so. (Make sure that the path to the Ffidl source doesn't have any spaces in it, or else the "make" will fail.)
Compile the Fortran code as follows (note the subtle difference in making the shared library compared to the Windows DLL):
gfortran -c -fno-underscoring tcl.f90 -o tcl.o gfortran -shared -fPIC -fno-underscoring -static-libgfortran -static-libgcc tcl.o -o FtnTcl.so
Modify Gustav's Tcl code to say "load ./libFfidl0.6.so" instead of "load Ffidl05" (ensuring that load corresponds to whatever your Ffidl shared library is called). Finally, put the tclkit binary, FtnTcl.so, Gustav's Tcl file, and libFfidl0.6.so in the same directory, and run "./tclkit gustavscode.tcl".