Arjen Markus (6 april 2021) My two favourite programming languages are Tcl and Fortran. Jim, as an implementation of Tcl that has a smaller footprint, has attracted my attention from time to time and recently I was inspired to create an interface between Fortran and Jimtcl, based on the interfacing facilities offered by the Fortran 2003 standard.
The technique consists of providing formal interfaces on the Fortran side to the C API. The result is that almost the entire interface can be defined in Fortran. As an illustration find below the complete source for a rather limited set of Jim functions. It is enough to create a Jim interpreter and register new commands, thus providing scripting facilities.
Note: the code below can and should be improved. Right now there is too much "C" visible, such as the kind parameters c_int etc. Also, it would be better to have specific types for the interpreter pointer (interp) and the pointers to JimObj objects. Some C code is needed to make the various macros accessible, notably Jim_IncrRefCount and the like. And some generic interfaces, because Jim_GetLong resembles Jim_GetDouble a lot.
! fjim.f90 --
! Interface to the Jim library
!
module fjim
use iso_c_binding
implicit none
integer, parameter :: jim_ok = 0
integer, parameter :: jim_err = 1
integer, parameter :: jim_return = 2
integer, parameter :: jim_break = 3
interface
function Jim_CreateInterp() bind(C, name = 'Jim_CreateInterp')
import :: c_ptr
type(c_ptr) :: Jim_CreateInterp
end function Jim_CreateInterp
end interface
interface
subroutine Jim_FreeInterp( interp ) bind(C, name = 'Jim_FreeInterp')
import :: c_ptr
type(c_ptr), value :: interp
end subroutine Jim_FreeInterp
end interface
interface
subroutine Jim_RegisterCoreCommands( interp ) bind(C, name = 'Jim_RegisterCoreCommands')
import :: c_ptr
type(c_ptr), value :: interp
end subroutine Jim_RegisterCoreCommands
end interface
interface
subroutine Jim_InitStaticExtensions( interp ) bind(C, name = 'Jim_InitStaticExtensions')
import :: c_ptr
type(c_ptr), value :: interp
end subroutine Jim_InitStaticExtensions
end interface
interface
subroutine Jim_Eval_c( interp, string ) bind(C, name = 'Jim_Eval')
import :: c_ptr
type(c_ptr), value :: interp
character(len=1), dimension(*) :: string
end subroutine Jim_Eval_c
end interface
interface
subroutine Jim_CreateCommand_c( interp, string, funcptr, privdata, delptr ) bind(C, name = 'Jim_CreateCommand')
import :: c_ptr, c_funptr
type(c_ptr), value :: interp
character(len=1), dimension(*) :: string
type(c_funptr), value :: funcptr
type(c_ptr), value :: privdata
type(c_funptr), value :: delptr
end subroutine Jim_CreateCommand_c
end interface
interface
integer function Jim_GetLong( interp, objptr, value ) bind(C, name = 'Jim_GetLong')
import :: c_ptr, c_long
type(c_ptr), value :: interp
type(c_ptr), value :: objptr
integer(kind=c_long), intent(inout) :: value
end function Jim_GetLong
end interface
interface
integer function Jim_GetDouble( interp, objptr, value ) bind(C, name = 'Jim_GetDouble')
import :: c_ptr, c_double
type(c_ptr), value :: interp
type(c_ptr), value :: objptr
real(kind=c_double), intent(inout) :: value
end function Jim_GetDouble
end interface
interface
function Jim_GetString_c( objptr, length ) bind(C, name = 'Jim_GetString')
import :: c_ptr, c_int
type(c_ptr), value :: objptr
integer(kind=c_int), intent(out) :: length
type(c_ptr) :: Jim_GetString_c
end function Jim_GetString_c
end interface
contains
! jim_newinterp --
! Create a new Jim interpreter
!
! Arguments:
! interp Pointer to the interpreter structure
!
subroutine jim_newinterp( interp )
type(c_ptr), intent(out) :: interp
interp = Jim_CreateInterp()
call Jim_RegisterCoreCommands( interp )
call Jim_InitStaticExtensions( interp )
end subroutine jim_newinterp
subroutine jim_deleteinterp( interp )
type(c_ptr), intent(in) :: interp
call Jim_FreeInterp( interp )
end subroutine jim_deleteinterp
subroutine jim_eval( interp, string )
type(c_ptr), intent(in) :: interp
character(len=*), intent(in) :: string
call Jim_Eval_c( interp, string // c_null_char )
end subroutine jim_eval
! jim_createcommand --
! Create a new command
!
! Arguments:
! interp Jim interpreter
! cmdname Name of the command
! cmdptr Function that implements the command
!
! Note:
! Other arguments suppressed for the moment
!
subroutine jim_createcommand( interp, cmdname, cmdptr ) !!, privdata, delptr )
type(c_ptr), intent(in) :: interp
character(len=*), intent(in) :: cmdname
interface
integer function cmdptr( interp, argc, argv )
import :: c_ptr
type(c_ptr), value :: interp
integer, value :: argc
type(c_ptr), dimension(*) :: argv
end function cmdptr
end interface
call Jim_CreateCommand_c( interp, trim(cmdname) // c_null_char, c_funloc(cmdptr), c_null_ptr, c_null_funptr )
end subroutine jim_createcommand
! jim_getstring --
! Get the string represntation from a JimObj object
!
! Arguments:
! interp Pointer to the interpreter structure
! objptr Pointer to the JimObj object in question
!
! Return value:
! Pointer to the string
!
function jim_getstring( objptr )
type(c_ptr), intent(in) :: objptr
character(kind=c_char,len=:), pointer :: jim_getstring
type(c_ptr) :: c_string
integer(kind=c_int) :: length
c_string = jim_getstring_c( objptr, length )
block
character(kind=c_char, len=length), pointer :: t_string
call c_f_pointer( c_string, t_string )
jim_getstring => t_string
t_string => null()
end block
end function jim_getstring
end module fjim
module mycommands
use fjim
implicit none
contains
integer function myputs( interp, argc, argv )
type(c_ptr), value :: interp
integer, value :: argc
type(c_ptr), dimension(*) :: argv
integer :: i
integer(kind=c_long_long) :: ivalue
real(kind=c_double) :: dvalue
write(*,*) 'Number of arguments: ', argc
do i = 1,argc
if ( jim_getlong( interp, argv(i), ivalue ) == jim_ok ) then
write(*,*) i, ': ', ivalue
elseif ( jim_getdouble( interp, argv(i), dvalue ) == jim_ok ) then
write(*,*) i, ': ', dvalue
else
write(*,*) i, ': ', jim_getstring( argv(i) )
endif
enddo
end function myputs
end module mycommands
! test --
! Simple test, copy of the "jim_hello.c" program
!
program test_fjim
use fjim
use mycommands
implicit none
type(c_ptr) :: interp
call jim_newinterp( interp )
call jim_createcommand( interp, "printargs", myputs )
call jim_eval( interp, 'puts "Hello, world!"' )
call jim_eval( interp, 'printargs 2 "Hello, world!" 3.1415926' )
call jim_deleteinterp( interp )
end program test_fjimI built it using Cygwim on Windows, using:
gfortran -o demo fjim.f90 libjim.a
and the output of the program is:
Hello, world!
Number of arguments: 4
1 : printargs
2 : 2
3 : Hello, world!
4 : 3.1415926000000001arjen - 2021-09-28 06:26:12
I am currently extending this proof-of-concept to make it actually useable in applications.