api/f77api.c

   1 /* Copyright (c) 2007-2010 Massachusetts Institute of Technology
   2  *
   3  * Permission is hereby granted, free of charge, to any person obtaining
   4  * a copy of this software and associated documentation files (the
   5  * "Software"), to deal in the Software without restriction, including
   6  * without limitation the rights to use, copy, modify, merge, publish,
   7  * distribute, sublicense, and/or sell copies of the Software, and to
   8  * permit persons to whom the Software is furnished to do so, subject to
   9  * the following conditions:
  10  *
  11  * The above copyright notice and this permission notice shall be
  12  * included in all copies or substantial portions of the Software.
  13  *
  14  * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  15  * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  16  * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  17  * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
  18  * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
  19  * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
  20  * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  21  */
  22
  23 #include <stdlib.h>
  24
  25 #include "nlopt.h"
  26 #include "nlopt-util.h"
  27
  28 /*-----------------------------------------------------------------------*/
  29 /* wrappers around f77 procedures */
  30
  31 typedef void (*nlopt_f77_func)(double *val, const int *n, const double *x,
  32                                double *gradient, const int *need_gradient,
  33                                void *func_data);
  34
  35 typedef struct {
  36      nlopt_f77_func f;
  37      void *f_data;
  38 } f77_func_data;
  39
  40 static double f77_func_wrap(int n, const double *x, double *grad, void *data)
  41 {
  42      f77_func_data *d = (f77_func_data *) data;
  43      double val;
  44      int need_gradient = grad != 0;
  45      d->f(&val, &n, x, grad, &need_gradient, d->f_data);
  46      return val;
  47 }
  48
  49 /*-----------------------------------------------------------------------*/
  50 /* rather than trying to detect the Fortran name-mangling scheme with
  51    autoconf, we just include wrappers with all common name-mangling
  52    schemes ... this avoids problems and also allows us to work with
  53    multiple Fortran compilers on the same machine .
  54
  55    Note that our Fortran function names do not contain underscores;
  56    otherwise, we would need to deal with the additional headache that
  57    g77 appends two underscores in that case. */
  58
  59 #ifndef WINDOWS_F77_MANGLING
  60
  61 /* name + underscore is by far the most common (gfortran, g77, Intel, ...) */
  62 #  define F77(a, A) a ## _
  63 #  include "f77funcs.h"
  64
  65 /* AIX and HPUX use just the lower-case name */
  66 #  undef F77
  67 #  define F77(a, A) a
  68 #  include "f77funcs.h"
  69
  70 /* old Cray UNICOS used just the upper-case name */
  71 #  undef F77
  72 #  define F77(a, A) A
  73 #  include "f77funcs.h"
  74
  75 #else /* WINDOWS_F77_MANGLING */
  76
  77 /* Various mangling conventions common (?) under Windows. */
  78
  79 /* name + underscore for gfortran, g77, ...? */
  80 #  define F77(a, A) a ## _
  81 #  include "f77funcs.h"
  82
  83 /* Digital/Compaq/HP Visual Fortran, Intel Fortran.  stdcall attribute
  84    is apparently required to adjust for calling conventions (callee
  85    pops stack in stdcall).  See also:
  86        http://msdn.microsoft.com/library/en-us/vccore98/html/_core_mixed.2d.language_programming.3a_.overview.asp
  87 */
  88 #  undef F77
  89 #  if defined(__GNUC__)
  90 #    define F77(a, A) __attribute__((stdcall)) A
  91 #  elif defined(_MSC_VER) || defined(_ICC) || defined(_STDCALL_SUPPORTED)
  92 #    define F77(a, A) __stdcall A
  93 #  else
  94 #    define F77(a, A) A /* oh well */
  95 #  endif
  96 #  include "f77funcs.h"
  97
  98 #endif /* WINDOWS_F77_MANGLING */