bindGen.rb 18.7 KB
Newer Older
1
#!/usr/bin/env ruby
2
require 'optparse'
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
################################################################
# CONFIGURATION:
CFTypeInfo             = {
  'int'                  => {:namedConst       => 'c_int'                , :ftype => 'integer'},
  'short int'            => {:namedConst       => 'c_short'              , :ftype => 'integer'},
  'long int'             => {:namedConst       => 'c_long'               , :ftype => 'integer'},
  'long long int'        => {:namedConst       => 'c_long_long'          , :ftype => 'integer'},
  'signed char'          => {:namedConst       => 'c_signed_char'        , :ftype => 'integer'},
  'unsigned char'        => {:namedConst       => 'c_signed_char'        , :ftype => 'integer'},
  'size_t'               => {:namedConst       => 'c_size_t'             , :ftype => 'integer'},
  'int8_t'               => {:namedConst       => 'c_int8_t'             , :ftype => 'integer'},
  'int16_t'              => {:namedConst       => 'c_int16_t'            , :ftype => 'integer'},
  'int32_t'              => {:namedConst       => 'c_int32_t'            , :ftype => 'integer'},
  'int64_t'              => {:namedConst       => 'c_int64_t'            , :ftype => 'integer'},
  'int_fast8_t'          => {:namedConst       => 'c_int_fast8_t'        , :ftype => 'integer'},
  'int_fast16_t'         => {:namedConst       => 'c_int_fast16_t'       , :ftype => 'integer'},
  'int_fast32_t'         => {:namedConst       => 'c_int_fast32_t'       , :ftype => 'integer'},
  'int_fast64_t'         => {:namedConst       => 'c_int_fast64_t'       , :ftype => 'integer'},
  'int_least8_t'         => {:namedConst       => 'c_int_least8_t'       , :ftype => 'integer'},
  'int_least16_t'        => {:namedConst       => 'c_int_least16_t'      , :ftype => 'integer'},
  'int_least32_t'        => {:namedConst       => 'c_int_least32_t'      , :ftype => 'integer'},
  'int_least64_t'        => {:namedConst       => 'c_int_least64_t'      , :ftype => 'integer'},
  'intmax_t'             => {:namedConst       => 'c_intmax_t'           , :ftype => 'integer'},
  'intptr_t'             => {:namedConst       => 'c_intptr_t'           , :ftype => 'integer'},

  'float'                => {:namedConst       => 'c_float'              , :ftype => 'real'},
  'double'               => {:namedConst       => 'c_double'             , :ftype => 'real'},
  'long double'          => {:namedConst       => 'c_long_double'        , :ftype => 'real'},

  'float _Complex'       => {:namedConst       => 'c_float_complex'      , :ftype => 'complex'},
  'double _Complex'      => {:namedConst       => 'c_double_complex'     , :ftype => 'complex'},
  'long double _Complex' => {:namedConst       => 'c_long_double_complex', :ftype => 'complex'},
  '_Bool'                => {:namedConst       => 'c_bool'               , :ftype => 'logical'},
  'char'                 => {:namedConst       => 'c_char'               , :ftype => 'character'}
}
# how the module should be invoked from fortran
ModuleName    = 'mo_cdi'
# which conversion is to use generating the fortran routine names, this could
# be any ruby String method.
FNameMethod   = :noop
# FNameMethod = :downcase
# FNameMethod = :noop
# FNameMethod = :upcase
class String;def noop;self;end;end
# fortran subroutines are not allowed to have a parameters with the same name,
# so in case of a match, these parameters have to get an new name
FParamExtension = 'v'
# Naming convention from above: 
# all non scalar variables should have the postfix '_vec' in there name
Vectors = /_vec$/i
################################################################################
FortranMaxLineLength = 132
# read the c header file and grep out name, return type and paramterlist of
# each function
def getFuncInfo(filename)
  typelist = %w[char int float double void]
59
60
  cppflags = ENV['CPPFLAGS'].nil? ? '' : ENV['CPPFLAGS']
  funclist = IO.popen("cpp #{cppflags} #{filename} | cpp -fpreprocessed").readlines.delete_if {|line| line.include?('#')}.collect {|line| line.chomp}
61
  # delete everything, that do not look like a function prototype
62
  typeRegexp = /^.*(#{typelist.join('|')}) \**\w+\s*\(.*\)/
63
64
65
66
  funclist.delete_if {|line|
    not typeRegexp.match(line.lstrip)
  }
  funclist.collect! {|line|
67
    md = /(\w+)+ +(\**)(\w+)\s*\((.*)\)/.match(line)
68
69
    returnType, returnPointer, funcName, paramList = md[1,4]
    paramList = paramList.split(',').collect {|p| p.split(' ').each {|_p| _p.strip}}
70
    [funcName, returnType, returnPointer, paramList]
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
  }
  funclist
end

# grep the #define C-Constants, which should be available within the fortran CDI API
def getDefines(filename)
  defines = File.open(filename,'r').readlines.grep(/^#define/).collect {|line|
    md = / +(\w+) +(-*\d+)/.match(line)
  }.select {|item| not item.nil?}.collect {|match| match[1..2]}
end

# create continuation for lines longer that 132 sign, which would create an
# error with some fortran compilers
def genContinuation(iline)
  # leave the input untouched
  line = iline
  # try to create readable line breaks, i.e. do not split name, labels or keywords
  regexp = /,[^,]*$/

  matchIndex = line[0,FortranMaxLineLength] =~ regexp

  if matchIndex.nil?
    line[FortranMaxLineLength-2] = "&\n"+line[FortranMaxLineLength-2,1]+"&"
  else
    line[matchIndex] = ",&\n" + ' '*7
  end
  line
end


# create fortran module variables
102
def genModParams(vars)
103
  vars.collect {|var, value|
104
    "      integer, parameter :: #{var} = #{value}"
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
  }.join("\n")
end

# return the fortran version of the c parameters (name, named constant within
# iso-c-bindig, fortran type)
def fortranParamsWithTypes(paramList)
  paramList.collect {|paramInfo|
    ctype, param = paramInfo[-2,2]
    ftype, nc    = CFTypeInfo[ctype][:ftype], CFTypeInfo[ctype][:namedConst]
    # fortran parameters can be configured out of the c parameters
    [param.send(FNameMethod),nc,ftype, paramInfo.include?('const')]
  }
end
def startMod(name)
  "
module #{name}
      use, intrinsic :: iso_c_binding

      implicit none

      private
  "
end
def endMod(name)
Thomas Jahns's avatar
Thomas Jahns committed
129
  "\nend module #{name}\n"
130
131
132
133
134
135
136
137
138
139
end
def isBadFunction(returnType, returnPointer, paramList)
  return true if (
    # external return type
    (returnType != 'void' and not CFTypeInfo.keys.include?(returnType)) or
    # pointer2pointer return type
    returnPointer.length > 1
  )
  paramList.each {|paramInfo|
    next if paramInfo == ['void']
Thomas Jahns's avatar
Thomas Jahns committed
140
    next if paramInfo[0] == 'void' and /^\*\w+$/.match(paramInfo[1])
141
    ctype, param = paramInfo[-2,2]
142
143
    # TJ: unnamed arguments shouldn't be matched at all but because
    # pointer * is parsed as part of the name those need to be rejected here
144
    return true if (
Thomas Jahns's avatar
Thomas Jahns committed
145
      CFTypeInfo[ctype].nil? or                        # derived data type
146
      param == '*' or                                  # unnamed pointer
147
      param[0,2] == '**' or                            # pointer2pointer
148
      (param[0,1] == '*' and /\w\[\w*\]/.match(param)) # array of pointers
149
    )
Thomas Jahns's avatar
Thomas Jahns committed
150
  }
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
  return false
end

def hasDimension(paramName, paramFType)
  return true if paramFType == 'character'
  return true if ( %w[integer real].include?(paramFType) and Vectors.match(paramName) )
  return false
end

# collect further information about the original c type of the params and
# in case of a match between param name and function name, the parameter name
# is changed
def setFortranParams(paramswithtypes,fFuncname)
  # special treatment of empty parameter list
  return [[],[]] if paramswithtypes == [[]]

  originalParameters = paramswithtypes.transpose[0]
  paramswithtypes.collect {|param, paramCType, fType, isConstant|
    # test for pointers/arrays
    isPointer, isArray, arraySize = false, false, nil
    if param[0,1] == '*'
      isPointer = true
      # remove '*' from funcnames and paramnames
      param.sub!('*','')
    end
176
    if ( md = /\w\[(\w*)\]/.match(param); not md.nil? )
177
178
      isArray   = true
      arraySize = md[1] == '' ? '*' : md[1]
179
      param[md.begin(1)-1,md.end(1)-1] = ''
180
181
182
183
    end

    # change param name if it equals the funcname
    if param == fFuncname or param.downcase == fFuncname.downcase
Thomas Jahns's avatar
Thomas Jahns committed
184
      param += FParamExtension
185
186
187
      # but maybe the result is the name of another parameter. -> play it again sam...
      param += FParamExtension while ( originalParameters.include?(param) )
    end
188
189
190
    if param[0,1] == '_'
      param = 'p' + param
    end
191
192
193
194
195

    [param,paramCType,fType,isPointer,isArray,arraySize,isConstant]
  }
end

Thomas Jahns's avatar
Thomas Jahns committed
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
def printParams(fParams, indent)
  out = ''
  fParams.each {|param,paramType,ftype,ispointer,isarray,arraysize,isconstant|
    dimension     = isarray ? "dimension(#{arraysize})" : ( (ispointer and hasDimension(param, ftype) ) ? 'dimension(*)' : nil)
    intent, value = nil, nil
    if (ispointer or isarray)
      if not isconstant
        intent = 'intent(out)'
      else
        intent = 'intent(in)'
      end unless paramType == 'c_char'
    else
      #intent = 'intent(in)'
      value  = 'value'
    end

212
    typeinfo = [value,intent,dimension].select {|s| ! s.nil?}.join(', ')
Thomas Jahns's avatar
Thomas Jahns committed
213
214
215
216
217
218
219
    out << "  #{indent}#{ftype}"
    out << (paramType == 'c_ptr' ? '' : "(kind=#{paramType})")
    out << ", #{typeinfo} :: #{param}\n"
  }
  return out
end

220
221
# creates the actual binding within the module for the given c function
# unsupported types of function a ignored, see RESTRICTIONS (top) for details
222
def genInterface(cFuncname, returnType, returnPointer, paramList, debug)
223

224
  # do not create interfaces for unsupported functions
225
226
  if isBadFunction( returnType, returnPointer, paramList)
    warn "parameterlist of '#{cFuncname}' is not supported -> function ignored."
Thomas Jahns's avatar
Thomas Jahns committed
227
    return ['','']
228
  end
229
  return ['', ''] if (cFuncname[0,1] == '_')
230
  # the void argument type can be left out: if 'void' occurs in the
231
232
  # parameterlist (which is only the case, if it is the only parameter
  # information), it is simply removed and a empty paramter list is left.
Thomas Jahns's avatar
Thomas Jahns committed
233
  paramList = [[],[]] if paramList.flatten == [ 'void' ] or paramList.flatten.empty?
234
235

  out = ''
Thomas Jahns's avatar
Thomas Jahns committed
236
  isWrapper = false
237
238
239
240
241
242
243
244
245
246
247
248

  # create new names for the fortran routines, see CONFIGURATION (top)
  fFuncname = cFuncname.send(FNameMethod)

  paramsWithTypes = []
  # divide between empty and non empty parameter lists
  if paramList == [[],[]]
    fParams, fParams4Import, fTypes4Import = [], [],[]
  else
    # collect information for setting the correct fortran type for each parameter
    paramsWithTypes = paramList.collect {|paramInfo|
      ctype, param = paramInfo[-2,2]
249
250
251
252
253
254
255
256
257
      integral_type = /^(:?char|int|long|short)$/.match(ctype);
      if (integral_type)
        while (/^(:?un)?signed/.match(paramInfo[-3]))
          ctype = paramInfo[-3] << ' ' << ctype
          paramInfo.delete_at(-3)
          paramInfo[-2] = ctype
          pp [paramInfo] if debug
        end
      end
Thomas Jahns's avatar
Thomas Jahns committed
258
259
260
261
262
263
264
265
      ptr_match = /^\*(\w+)$/.match(param)
      if (/^(:?const)? *void$/.match(ctype) and ptr_match)
        param = ptr_match[1]
        ftype = 'type(c_ptr)'
        nc = 'c_ptr'
      else
        ftype, nc    = CFTypeInfo[ctype][:ftype], CFTypeInfo[ctype][:namedConst]
      end
266
267
268
269
270
271
272
273
274
275
276
      # fortran parameters can be configured out of the c parameters
      [param.send(FNameMethod),nc,ftype, paramInfo.include?('const')]
    }

    # get deeper information about parameterlists and filter out functions with
    # non supported parameters
    fParams = setFortranParams(paramsWithTypes,fFuncname)
    fParams4Import, fTypes4Import, = fParams.transpose
  end

  fReturnInfo                    = CFTypeInfo[returnType]
Thomas Jahns's avatar
Thomas Jahns committed
277
  indent = '      '
278
  if not fReturnInfo.nil?
279
    fReturnString = "function"
Thomas Jahns's avatar
Thomas Jahns committed
280
    fEnd    = ["#{fReturnInfo[:ftype]}(kind=#{fReturnInfo[:namedConst]}) :: #{fFuncname}\n", "end function" ]
281
282
283
    fTypes4Import << fReturnInfo[:namedConst]
  elsif returnType == 'void'
    fReturnString = "subroutine"
Thomas Jahns's avatar
Thomas Jahns committed
284
    fEnd    = ["end subroutine"]
285
  end
Thomas Jahns's avatar
Thomas Jahns committed
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
  fFuncname_suffix = ''

  if (returnType == 'char' and returnPointer == '*')
    out << "#{indent}function #{fFuncname}(#{fParams4Import.join(',')})\n"
    out << printParams(fParams, indent)
    fTypes4Import.unshift('c_ptr') unless fTypes4Import.include?('c_ptr')
    isWrapper = true
    fwEnd = [ "end function" ]
    fFuncname_suffix = '_c'
    indent = '        '
    fEnd = [ "type(c_ptr) :: #{fFuncname}#{fFuncname_suffix}\n",
             "end function" ]
  end
  out << "#{indent}interface
#{indent}  #{fReturnString} #{fFuncname}#{fFuncname_suffix}(#{fParams4Import.join(',')}) bind(c,name='#{cFuncname}')\n"
  out << "#{indent}    import :: #{fTypes4Import.uniq.join(',')}\n" unless fTypes4Import.empty?
302

Thomas Jahns's avatar
Thomas Jahns committed
303
  out << printParams(fParams, indent + '  ')
304

Thomas Jahns's avatar
Thomas Jahns committed
305
306
307
308
  fEnd.each_with_index do |line, i|
    extra_indent = '    '
    if i == fEnd.length - 1
      extra_indent = '  '
309
    end
Thomas Jahns's avatar
Thomas Jahns committed
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
    out << indent + extra_indent + line
  end
  out << " #{fFuncname}#{fFuncname_suffix}\n#{indent}end interface\n"
  if (returnType == 'char' and returnPointer == '*')
    indent = '      '
    out << "#{indent}  character(len=1, kind=c_char), pointer :: #{fFuncname}(:)
#{indent}  type(c_ptr) :: cptr
#{indent}  integer :: slen(1)

#{indent}  cptr = #{fFuncname}#{fFuncname_suffix}("
    out << fParams4Import.join(",&
#{indent}    ") << ")\n"
    out << "#{indent}  #{fFuncname} => null()\n"
    out << "#{indent}  slen(1) = int(strlen(cptr))\n"
    out << "#{indent}  call c_f_pointer(cptr, #{fFuncname}, slen)\n"
    fwEnd.each_with_index do |line,i|
      extra_indent = '  '
      if i == fwEnd.length - 1
        extra_indent = ''
      end
      out << indent + extra_indent + line
    end
    out << " #{fFuncname}\n"
  end
  [out, makePublic(fFuncname), isWrapper]
335
336
337
338
339
340
341
342
343
end
def makePublic(*fFuncnameList)
  fFuncnameList.collect {|fname| 
    "      public :: #{fname.tr('*','')}"
  }.join("\n") << "\n"
end
def ctrim
  "
    subroutine ctrim(str)
344
    character(kind=c_char), intent(inout) :: str(:)
Thomas Jahns's avatar
Thomas Jahns committed
345
    character(kind=c_char) :: c
346
    integer :: i
347

Thomas Jahns's avatar
Thomas Jahns committed
348
349
    do i=1,size(str)
      c = str(i)
350
      if (c == c_null_char) then
Thomas Jahns's avatar
Thomas Jahns committed
351
352
        str(i:size(str)) = ' '
        exit
353
354
355
      end if
    end do

Thomas Jahns's avatar
Thomas Jahns committed
356
357
358
359
    end subroutine ctrim\n"
end

def clen
360
  "
Thomas Jahns's avatar
Thomas Jahns committed
361
362
363
364
365
366
367
368
369
370
    function c_len(s) result(i)
      character(kind=c_char), intent(in) :: s(:)
      integer :: i
      do i = 1, size(s)
        if (s(i) == c_null_char) then
          exit
        end if
      end do
      i = i - 1
    end function\n"
371
end
Thomas Jahns's avatar
Thomas Jahns committed
372

373
374
375
376
377
################################################################################
if __FILE__ == $0
require 'optparse'
require 'pp'

378
379
debug = false
OptionParser.new do |opts|
380
  opts.on("-d","--debug") {debug = true}
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
  opts.on_tail("--help","-h","-H","Display this help message.") do
    puts <<-'END'
#== Synopsis
# Create Fortran iso-c-bindings form a given c header file
# 
#== Usage
#   binGen.rb <headerFile> <fortranLibraryFile> [<modName>] [--help|--debug]  
#
# headerFile:
#   A general c header file: function prototypes and '#defines' with numerical
#   value will be taken for the fortran module construction. Furthermore there
#   are some restrictions to what is provided in fortran: Currently internal
#   datatypes and (arrays|pointers) to internal datatypes are supported, i.e.
#   no arrays of pointers, no pointer to pointers, no typedefs
#
# fortranLibraryFile:
#   file name for generated bindings
#
# modName:
#   This will be the name of the Fortran module, so it has to obey the fortran 
#   restriction for module names. default: mo_cdi
#  
#== Author
# Ralf Mueller, ralf.mueller@zmaw.de
#
#== RESTRICTIONS:
# ONLY SUPPORT FOR INTERNAL DATATYPES AND (ARRAYS|POINTERS) TO INTERNAL
# DATATYPES, I.E. NO ARRAYS OF POINTERS, NO POINTER TO POINTERS, NO TYPEDEFS
#
#=== Special: naming convention
# Pointers can have different sizes, which cannot be detetermined by parsing a
# function prototype. Therefor a convention according the parameter names can
# be used to take this decision precisely:
# * Pointers to numbers are expected to be scalars unless the name of the
#   parameter end with '_vec'
# * Pointers to char are allways referenced as vectors
#
#== LICENSE: 
# BSD License
#
Ralf Mueller's avatar
Ralf Mueller committed
421
#  Copyright (c) 2009-2012, Ralf Mueller (ralf.mueller@zmaw.de)
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
#  All rights reserved.
#  
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions are met:
#  
#      * Redistributions of source code must retain the above copyright notice,
#        this list of conditions and the following disclaimer.
#  
#      * Redistributions in binary form must reproduce the above copyright
#        notice, this list of conditions and the following disclaimer in the
#        documentation and/or other materials provided with the distribution.
#  
#      * The names of its contributors may not be used to endorse or promote
#        products derived from this software without specific prior written
#        permission.
#  
#  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
#  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
#  DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
#  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
#  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
#  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
#  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
END
  exit
  end
end.parse!
453
454
455
456
457
458
459
460
461
462
463
464
465

  if ARGV[1] == nil
    warn 'no outputile given'
    exit
  end

  outputString      = ''
  modname           = ARGV[2].nil? ? ModuleName : ARGV[2]

  cDefines          = getDefines(ARGV[0])
  pp cDefines if debug
  unless cDefines.empty?
    makeModVarsPublic = makePublic(*cDefines.transpose[0]) 
466
    moduleVariables   = genModParams(cDefines)
467
468
  end

Thomas Jahns's avatar
Thomas Jahns committed
469
470
  interfaces, makepublics, subroutines = '', '', "contains\n"
  indent = '    '
471

Thomas Jahns's avatar
Thomas Jahns committed
472
473
474
475
  funcdecls = [ [ 'strlen', 'size_t', '', [ [ 'void', '*s' ] ] ] ]
  funcdecls.concat(getFuncInfo(ARGV[0]))

  funcdecls.each {| funcName, returnType, returnPointer, paramList|
476
    pp [funcName, returnType, returnPointer, paramList] if debug
477
    interface, makepublic, isWrapper = genInterface(funcName,returnType, returnPointer, paramList, debug)
Thomas Jahns's avatar
Thomas Jahns committed
478
479
480
481
482
    if isWrapper
      subroutines << interface
    else
      interfaces  << interface
    end
483
484
485
486
    makepublics << makepublic
  }

  # add a specialized trim for wierd c strings
Thomas Jahns's avatar
Thomas Jahns committed
487
488
  makepublics << makePublic('ctrim') << makePublic('c_len')
  subroutines << ctrim << clen
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508

  File.open(ARGV[1],"w") {|f|
    [ startMod(modname),
      moduleVariables ||= '',
      interfaces,
      makepublics,
      makeModVarsPublic ||= '',
      subroutines,
      endMod(modname)
    ].join("\n").split("\n").each {|line| 
      # check the length of each line before writing to file
      if line.length > FortranMaxLineLength
        f << genContinuation(line) << "\n"
      else
        f << line << "\n"
      end
    }
  }

end