AIM integration 220621

SynthesisTransform/include/f03api.sh

+#! /bin/sh
+
+# Script to generate Fortran 2003 interface declarations for FFTW from
+# the fftw3.h header file.
+
+# This is designed so that the Fortran caller can do:
+#   use, intrinsic :: iso_c_binding
+#   implicit none
+#   include 'fftw3.f03'
+# and then call the C FFTW functions directly, with type checking.
+
+echo "! Generated automatically.  DO NOT EDIT!"
+echo
+
+# C_FFTW_R2R_KIND is determined by configure and inserted by the Makefile
+# echo "  integer, parameter :: C_FFTW_R2R_KIND = @C_FFTW_R2R_KIND@"
+
+# Extract constants
+perl -pe 's/([A-Z0-9_]+)=([+-]?[0-9]+)/\n  integer\(C_INT\), parameter :: \1 = \2\n/g' < fftw3.h | grep 'integer(C_INT)'
+perl -pe 's/#define +([A-Z0-9_]+) +\(([+-]?[0-9]+)U?\)/\n  integer\(C_INT\), parameter :: \1 = \2\n/g' < fftw3.h | grep 'integer(C_INT)'
+perl -pe 'if (/#define +([A-Z0-9_]+) +\(([0-9]+)U? *<< *([0-9]+)\)/) { print "\n  integer\(C_INT\), parameter :: $1 = ",$2 << $3,"\n"; }' < fftw3.h | grep 'integer(C_INT)'
+
+# Extract function declarations
+for p in $*; do
+    if test "$p" = "d"; then p=""; fi
+
+    echo
+    cat <<EOF
+  type, bind(C) :: fftw${p}_iodim
+     integer(C_INT) n, is, os
+  end type fftw${p}_iodim
+  type, bind(C) :: fftw${p}_iodim64
+     integer(C_INTPTR_T) n, is, os
+  end type fftw${p}_iodim64
+EOF
+
+    echo
+    echo "  interface"
+    gcc -D__GNUC__=5 -D__i386__ -E fftw3.h |grep "fftw${p}_plan_dft" |tr ';' '\n' | grep -v "fftw${p}_execute(" | perl genf03.pl
+    echo "  end interface"
+
+done

SynthesisTransform/include/f77api.c

+/*
+ * Copyright (c) 2003, 2007-14 Matteo Frigo
+ * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *
+ */
+
+#include "api/api.h"
+#include "dft/dft.h"
+#include "rdft/rdft.h"
+
+#include "api/x77.h"
+
+/* if F77_FUNC is not defined, then we don't know how to mangle identifiers
+   for the Fortran linker, and we must omit the f77 API. */
+#if defined(F77_FUNC) || defined(WINDOWS_F77_MANGLING)
+
+/*-----------------------------------------------------------------------*/
+/* some internal functions used by the f77 api */
+
+/* in fortran, the natural array ordering is column-major, which
+   corresponds to reversing the dimensions relative to C's row-major */
+static int *reverse_n(int rnk, const int *n)
+{
+     int *nrev;
+     int i;
+     A(FINITE_RNK(rnk));
+     nrev = (int *) MALLOC(sizeof(int) * (unsigned)rnk, PROBLEMS);
+     for (i = 0; i < rnk; ++i)
+          nrev[rnk - i - 1] = n[i];
+     return nrev;
+}
+
+/* f77 doesn't have data structures, so we have to pass iodims as
+   parallel arrays */
+static X(iodim) *make_dims(int rnk, const int *n,
+			   const int *is, const int *os)
+{
+     X(iodim) *dims;
+     int i;
+     A(FINITE_RNK(rnk));
+     dims = (X(iodim) *) MALLOC(sizeof(X(iodim)) * (unsigned)rnk, PROBLEMS);
+     for (i = 0; i < rnk; ++i) {
+          dims[i].n = n[i];
+          dims[i].is = is[i];
+          dims[i].os = os[i];
+     }
+     return dims;
+}
+
+typedef struct {
+     void (*f77_write_char)(char *, void *);
+     void *data;
+} write_char_data;
+
+static void write_char(char c, void *d)
+{
+     write_char_data *ad = (write_char_data *) d;
+     ad->f77_write_char(&c, ad->data);
+}
+
+typedef struct {
+     void (*f77_read_char)(int *, void *);
+     void *data;
+} read_char_data;
+
+static int read_char(void *d)
+{
+     read_char_data *ed = (read_char_data *) d;
+     int c;
+     ed->f77_read_char(&c, ed->data);
+     return (c < 0 ? EOF : c);
+}
+
+static X(r2r_kind) *ints2kinds(int rnk, const int *ik)
+{
+     if (!FINITE_RNK(rnk) || rnk == 0)
+	  return 0;
+     else {
+	  int i;
+	  X(r2r_kind) *k;
+
+	  k = (X(r2r_kind) *) MALLOC(sizeof(X(r2r_kind)) * (unsigned)rnk, PROBLEMS);
+	  /* reverse order for Fortran -> C */
+	  for (i = 0; i < rnk; ++i)
+	       k[i] = (X(r2r_kind)) ik[rnk - 1 - i];
+	  return k;
+     }
+}
+
+/*-----------------------------------------------------------------------*/
+
+#define F77(a, A) F77x(x77(a), X77(A))
+
+#ifndef WINDOWS_F77_MANGLING
+
+#if defined(F77_FUNC)
+#  define F77x(a, A) F77_FUNC(a, A)
+#  include "f77funcs.h"
+#endif
+
+/* If identifiers with underscores are mangled differently than those
+   without underscores, then we include *both* mangling versions.  The
+   reason is that the only Fortran compiler that does such differing
+   mangling is currently g77 (which adds an extra underscore to names
+   with underscores), whereas other compilers running on the same
+   machine are likely to use non-underscored mangling.  (I'm sick
+   of users complaining that FFTW works with g77 but not with e.g.
+   pgf77 or ifc on the same machine.)  Note that all FFTW identifiers
+   contain underscores, and configure picks g77 by default. */
+#if defined(F77_FUNC_) && !defined(F77_FUNC_EQUIV)
+#  undef F77x
+#  define F77x(a, A) F77_FUNC_(a, A)
+#  include "f77funcs.h"
+#endif
+
+#else /* WINDOWS_F77_MANGLING */
+
+/* Various mangling conventions common (?) under Windows. */
+
+/* g77 */
+#  define WINDOWS_F77_FUNC(a, A) a ## __
+#  define F77x(a, A) WINDOWS_F77_FUNC(a, A)
+#  include "f77funcs.h"
+
+/* Intel, etc. */
+#  undef WINDOWS_F77_FUNC
+#  define WINDOWS_F77_FUNC(a, A) a ## _
+#  include "f77funcs.h"
+
+/* Digital/Compaq/HP Visual Fortran, Intel Fortran.  stdcall attribute
+   is apparently required to adjust for calling conventions (callee
+   pops stack in stdcall).  See also:
+       http://msdn.microsoft.com/library/en-us/vccore98/html/_core_mixed.2d.language_programming.3a_.overview.asp
+*/
+#  undef WINDOWS_F77_FUNC
+#  if defined(__GNUC__)
+#    define WINDOWS_F77_FUNC(a, A) __attribute__((stdcall)) A
+#  elif defined(_MSC_VER) || defined(_ICC) || defined(_STDCALL_SUPPORTED)
+#    define WINDOWS_F77_FUNC(a, A) __stdcall A
+#  else
+#    define WINDOWS_F77_FUNC(a, A) A /* oh well */
+#  endif
+#  include "f77funcs.h"
+
+#endif /* WINDOWS_F77_MANGLING */
+
+#endif				/* F77_FUNC */

SynthesisTransform/include/f77funcs.h

+/*
+ * Copyright (c) 2003, 2007-14 Matteo Frigo
+ * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *
+ */
+
+/* Functions in the FFTW Fortran API, mangled according to the
+   F77(...) macro.  This file is designed to be #included by
+   f77api.c, possibly multiple times in order to support multiple
+   compiler manglings (via redefinition of F77). */
+
+FFTW_VOIDFUNC F77(execute, EXECUTE)(X(plan) * const p)
+{
+     plan *pln = (*p)->pln;
+     pln->adt->solve(pln, (*p)->prb);
+}
+
+FFTW_VOIDFUNC F77(destroy_plan, DESTROY_PLAN)(X(plan) *p)
+{
+     X(destroy_plan)(*p);
+}
+
+FFTW_VOIDFUNC F77(cleanup, CLEANUP)(void)
+{
+     X(cleanup)();
+}
+
+FFTW_VOIDFUNC F77(forget_wisdom, FORGET_WISDOM)(void)
+{
+     X(forget_wisdom)();
+}
+
+FFTW_VOIDFUNC F77(export_wisdom, EXPORT_WISDOM)(void (*f77_write_char)(char *, void *),
+				       void *data)
+{
+     write_char_data ad;
+     ad.f77_write_char = f77_write_char;
+     ad.data = data;
+     X(export_wisdom)(write_char, (void *) &ad);
+}
+
+FFTW_VOIDFUNC F77(import_wisdom, IMPORT_WISDOM)(int *isuccess,
+				       void (*f77_read_char)(int *, void *),
+				       void *data)
+{
+     read_char_data ed;
+     ed.f77_read_char = f77_read_char;
+     ed.data = data;
+     *isuccess = X(import_wisdom)(read_char, (void *) &ed);
+}
+
+FFTW_VOIDFUNC F77(import_system_wisdom, IMPORT_SYSTEM_WISDOM)(int *isuccess)
+{
+     *isuccess = X(import_system_wisdom)();
+}
+
+FFTW_VOIDFUNC F77(print_plan, PRINT_PLAN)(X(plan) * const p)
+{
+     X(print_plan)(*p);
+     fflush(stdout);
+}
+
+FFTW_VOIDFUNC F77(flops,FLOPS)(X(plan) *p, double *add, double *mul, double *fma)
+{
+     X(flops)(*p, add, mul, fma);
+}
+
+FFTW_VOIDFUNC F77(estimate_cost,ESTIMATE_COST)(double *cost, X(plan) * const p)
+{
+     *cost = X(estimate_cost)(*p);
+}
+
+FFTW_VOIDFUNC F77(cost,COST)(double *cost, X(plan) * const p)
+{
+     *cost = X(cost)(*p);
+}
+
+FFTW_VOIDFUNC F77(set_timelimit,SET_TIMELIMIT)(double *t)
+{
+     X(set_timelimit)(*t);
+}
+
+/******************************** DFT ***********************************/
+
+FFTW_VOIDFUNC F77(plan_dft, PLAN_DFT)(X(plan) *p, int *rank, const int *n,
+			     C *in, C *out, int *sign, int *flags)
+{
+     int *nrev = reverse_n(*rank, n);
+     *p = X(plan_dft)(*rank, nrev, in, out, *sign, *flags);
+     X(ifree0)(nrev);
+}
+
+FFTW_VOIDFUNC F77(plan_dft_1d, PLAN_DFT_1D)(X(plan) *p, int *n, C *in, C *out,
+				   int *sign, int *flags)
+{
+     *p = X(plan_dft_1d)(*n, in, out, *sign, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_dft_2d, PLAN_DFT_2D)(X(plan) *p, int *nx, int *ny,
+				   C *in, C *out, int *sign, int *flags)
+{
+     *p = X(plan_dft_2d)(*ny, *nx, in, out, *sign, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_dft_3d, PLAN_DFT_3D)(X(plan) *p, int *nx, int *ny, int *nz,
+				   C *in, C *out,
+				   int *sign, int *flags)
+{
+     *p = X(plan_dft_3d)(*nz, *ny, *nx, in, out, *sign, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_many_dft, PLAN_MANY_DFT)(X(plan) *p, int *rank, const int *n,
+				       int *howmany,
+				       C *in, const int *inembed,
+				       int *istride, int *idist,
+				       C *out, const int *onembed,
+				       int *ostride, int *odist,
+				       int *sign, int *flags)
+{
+     int *nrev = reverse_n(*rank, n);
+     int *inembedrev = reverse_n(*rank, inembed);
+     int *onembedrev = reverse_n(*rank, onembed);
+     *p = X(plan_many_dft)(*rank, nrev, *howmany,
+			   in, inembedrev, *istride, *idist,
+			   out, onembedrev, *ostride, *odist,
+			   *sign, *flags);
+     X(ifree0)(onembedrev);
+     X(ifree0)(inembedrev);
+     X(ifree0)(nrev);
+}
+
+FFTW_VOIDFUNC F77(plan_guru_dft, PLAN_GURU_DFT)(X(plan) *p, int *rank, const int *n,
+				       const int *is, const int *os,
+				       int *howmany_rank, const int *h_n,
+				       const int *h_is, const int *h_os,
+				       C *in, C *out, int *sign, int *flags)
+{
+     X(iodim) *dims = make_dims(*rank, n, is, os);
+     X(iodim) *howmany_dims = make_dims(*howmany_rank, h_n, h_is, h_os);
+     *p = X(plan_guru_dft)(*rank, dims, *howmany_rank, howmany_dims,
+			   in, out, *sign, *flags);
+     X(ifree0)(howmany_dims);
+     X(ifree0)(dims);
+}
+
+FFTW_VOIDFUNC F77(plan_guru_split_dft, PLAN_GURU_SPLIT_DFT)(X(plan) *p, int *rank, const int *n,
+				       const int *is, const int *os,
+				       int *howmany_rank, const int *h_n,
+				       const int *h_is, const int *h_os,
+				       R *ri, R *ii, R *ro, R *io, int *flags)
+{
+     X(iodim) *dims = make_dims(*rank, n, is, os);
+     X(iodim) *howmany_dims = make_dims(*howmany_rank, h_n, h_is, h_os);
+     *p = X(plan_guru_split_dft)(*rank, dims, *howmany_rank, howmany_dims,
+			   ri, ii, ro, io, *flags);
+     X(ifree0)(howmany_dims);
+     X(ifree0)(dims);
+}
+
+FFTW_VOIDFUNC F77(execute_dft, EXECUTE_DFT)(X(plan) * const p, C *in, C *out)
+{
+     plan_dft *pln = (plan_dft *) (*p)->pln;
+     if ((*p)->sign == FFT_SIGN)
+          pln->apply((plan *) pln, in[0], in[0]+1, out[0], out[0]+1);
+     else
+          pln->apply((plan *) pln, in[0]+1, in[0], out[0]+1, out[0]);
+}
+
+FFTW_VOIDFUNC F77(execute_split_dft, EXECUTE_SPLIT_DFT)(X(plan) * const p,
+					       R *ri, R *ii, R *ro, R *io)
+{
+     plan_dft *pln = (plan_dft *) (*p)->pln;
+     pln->apply((plan *) pln, ri, ii, ro, io);
+}
+
+/****************************** DFT r2c *********************************/
+
+FFTW_VOIDFUNC F77(plan_dft_r2c, PLAN_DFT_R2C)(X(plan) *p, int *rank, const int *n,
+				     R *in, C *out, int *flags)
+{
+     int *nrev = reverse_n(*rank, n);
+     *p = X(plan_dft_r2c)(*rank, nrev, in, out, *flags);
+     X(ifree0)(nrev);
+}
+
+FFTW_VOIDFUNC F77(plan_dft_r2c_1d, PLAN_DFT_R2C_1D)(X(plan) *p, int *n, R *in, C *out,
+					   int *flags)
+{
+     *p = X(plan_dft_r2c_1d)(*n, in, out, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_dft_r2c_2d, PLAN_DFT_R2C_2D)(X(plan) *p, int *nx, int *ny,
+					   R *in, C *out, int *flags)
+{
+     *p = X(plan_dft_r2c_2d)(*ny, *nx, in, out, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_dft_r2c_3d, PLAN_DFT_R2C_3D)(X(plan) *p,
+					   int *nx, int *ny, int *nz,
+					   R *in, C *out,
+					   int *flags)
+{
+     *p = X(plan_dft_r2c_3d)(*nz, *ny, *nx, in, out, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_many_dft_r2c, PLAN_MANY_DFT_R2C)(
+     X(plan) *p, int *rank, const int *n,
+     int *howmany,
+     R *in, const int *inembed, int *istride, int *idist,
+     C *out, const int *onembed, int *ostride, int *odist,
+     int *flags)
+{
+     int *nrev = reverse_n(*rank, n);
+     int *inembedrev = reverse_n(*rank, inembed);
+     int *onembedrev = reverse_n(*rank, onembed);
+     *p = X(plan_many_dft_r2c)(*rank, nrev, *howmany,
+			       in, inembedrev, *istride, *idist,
+			       out, onembedrev, *ostride, *odist,
+			       *flags);
+     X(ifree0)(onembedrev);
+     X(ifree0)(inembedrev);
+     X(ifree0)(nrev);
+}
+
+FFTW_VOIDFUNC F77(plan_guru_dft_r2c, PLAN_GURU_DFT_R2C)(
+     X(plan) *p, int *rank, const int *n,
+     const int *is, const int *os,
+     int *howmany_rank, const int *h_n,
+     const int *h_is, const int *h_os,
+     R *in, C *out, int *flags)
+{
+     X(iodim) *dims = make_dims(*rank, n, is, os);
+     X(iodim) *howmany_dims = make_dims(*howmany_rank, h_n, h_is, h_os);
+     *p = X(plan_guru_dft_r2c)(*rank, dims, *howmany_rank, howmany_dims,
+			       in, out, *flags);
+     X(ifree0)(howmany_dims);
+     X(ifree0)(dims);
+}
+
+FFTW_VOIDFUNC F77(plan_guru_split_dft_r2c, PLAN_GURU_SPLIT_DFT_R2C)(
+     X(plan) *p, int *rank, const int *n,
+     const int *is, const int *os,
+     int *howmany_rank, const int *h_n,
+     const int *h_is, const int *h_os,
+     R *in, R *ro, R *io, int *flags)
+{
+     X(iodim) *dims = make_dims(*rank, n, is, os);
+     X(iodim) *howmany_dims = make_dims(*howmany_rank, h_n, h_is, h_os);
+     *p = X(plan_guru_split_dft_r2c)(*rank, dims, *howmany_rank, howmany_dims,
+			       in, ro, io, *flags);
+     X(ifree0)(howmany_dims);
+     X(ifree0)(dims);
+}
+
+FFTW_VOIDFUNC F77(execute_dft_r2c, EXECUTE_DFT_R2C)(X(plan) * const p, R *in, C *out)
+{
+     plan_rdft2 *pln = (plan_rdft2 *) (*p)->pln;
+     problem_rdft2 *prb = (problem_rdft2 *) (*p)->prb;
+     pln->apply((plan *) pln, in, in + (prb->r1 - prb->r0), out[0], out[0]+1);
+}
+
+FFTW_VOIDFUNC F77(execute_split_dft_r2c, EXECUTE_SPLIT_DFT_R2C)(X(plan) * const p,
+						       R *in, R *ro, R *io)
+{
+     plan_rdft2 *pln = (plan_rdft2 *) (*p)->pln;
+     problem_rdft2 *prb = (problem_rdft2 *) (*p)->prb;
+     pln->apply((plan *) pln, in, in + (prb->r1 - prb->r0), ro, io);
+}
+
+/****************************** DFT c2r *********************************/
+
+FFTW_VOIDFUNC F77(plan_dft_c2r, PLAN_DFT_C2R)(X(plan) *p, int *rank, const int *n,
+				     C *in, R *out, int *flags)
+{
+     int *nrev = reverse_n(*rank, n);
+     *p = X(plan_dft_c2r)(*rank, nrev, in, out, *flags);
+     X(ifree0)(nrev);
+}
+
+FFTW_VOIDFUNC F77(plan_dft_c2r_1d, PLAN_DFT_C2R_1D)(X(plan) *p, int *n, C *in, R *out,
+					   int *flags)
+{
+     *p = X(plan_dft_c2r_1d)(*n, in, out, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_dft_c2r_2d, PLAN_DFT_C2R_2D)(X(plan) *p, int *nx, int *ny,
+					   C *in, R *out, int *flags)
+{
+     *p = X(plan_dft_c2r_2d)(*ny, *nx, in, out, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_dft_c2r_3d, PLAN_DFT_C2R_3D)(X(plan) *p,
+					   int *nx, int *ny, int *nz,
+					   C *in, R *out,
+					   int *flags)
+{
+     *p = X(plan_dft_c2r_3d)(*nz, *ny, *nx, in, out, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_many_dft_c2r, PLAN_MANY_DFT_C2R)(
+     X(plan) *p, int *rank, const int *n,
+     int *howmany,
+     C *in, const int *inembed, int *istride, int *idist,
+     R *out, const int *onembed, int *ostride, int *odist,
+     int *flags)
+{
+     int *nrev = reverse_n(*rank, n);
+     int *inembedrev = reverse_n(*rank, inembed);
+     int *onembedrev = reverse_n(*rank, onembed);
+     *p = X(plan_many_dft_c2r)(*rank, nrev, *howmany,
+			       in, inembedrev, *istride, *idist,
+			       out, onembedrev, *ostride, *odist,
+			       *flags);
+     X(ifree0)(onembedrev);
+     X(ifree0)(inembedrev);
+     X(ifree0)(nrev);
+}
+
+FFTW_VOIDFUNC F77(plan_guru_dft_c2r, PLAN_GURU_DFT_C2R)(
+     X(plan) *p, int *rank, const int *n,
+     const int *is, const int *os,
+     int *howmany_rank, const int *h_n,
+     const int *h_is, const int *h_os,
+     C *in, R *out, int *flags)
+{
+     X(iodim) *dims = make_dims(*rank, n, is, os);
+     X(iodim) *howmany_dims = make_dims(*howmany_rank, h_n, h_is, h_os);
+     *p = X(plan_guru_dft_c2r)(*rank, dims, *howmany_rank, howmany_dims,
+			       in, out, *flags);
+     X(ifree0)(howmany_dims);
+     X(ifree0)(dims);
+}
+
+FFTW_VOIDFUNC F77(plan_guru_split_dft_c2r, PLAN_GURU_SPLIT_DFT_C2R)(
+     X(plan) *p, int *rank, const int *n,
+     const int *is, const int *os,
+     int *howmany_rank, const int *h_n,
+     const int *h_is, const int *h_os,
+     R *ri, R *ii, R *out, int *flags)
+{
+     X(iodim) *dims = make_dims(*rank, n, is, os);
+     X(iodim) *howmany_dims = make_dims(*howmany_rank, h_n, h_is, h_os);
+     *p = X(plan_guru_split_dft_c2r)(*rank, dims, *howmany_rank, howmany_dims,
+			       ri, ii, out, *flags);
+     X(ifree0)(howmany_dims);
+     X(ifree0)(dims);
+}
+
+FFTW_VOIDFUNC F77(execute_dft_c2r, EXECUTE_DFT_C2R)(X(plan) * const p, C *in, R *out)
+{
+     plan_rdft2 *pln = (plan_rdft2 *) (*p)->pln;
+     problem_rdft2 *prb = (problem_rdft2 *) (*p)->prb;
+     pln->apply((plan *) pln, out, out + (prb->r1 - prb->r0), in[0], in[0]+1);
+}
+
+FFTW_VOIDFUNC F77(execute_split_dft_c2r, EXECUTE_SPLIT_DFT_C2R)(X(plan) * const p,
+					   R *ri, R *ii, R *out)
+{
+     plan_rdft2 *pln = (plan_rdft2 *) (*p)->pln;
+     problem_rdft2 *prb = (problem_rdft2 *) (*p)->prb;
+     pln->apply((plan *) pln, out, out + (prb->r1 - prb->r0), ri, ii);
+}
+
+/****************************** r2r *********************************/
+
+FFTW_VOIDFUNC F77(plan_r2r, PLAN_R2R)(X(plan) *p, int *rank, const int *n,
+			     R *in, R *out,
+			     int *kind, int *flags)
+{
+     int *nrev = reverse_n(*rank, n);
+     X(r2r_kind) *k = ints2kinds(*rank, kind);
+     *p = X(plan_r2r)(*rank, nrev, in, out, k, *flags);
+     X(ifree0)(k);
+     X(ifree0)(nrev);
+}
+
+FFTW_VOIDFUNC F77(plan_r2r_1d, PLAN_R2R_1D)(X(plan) *p, int *n, R *in, R *out,
+				   int *kind, int *flags)
+{
+     *p = X(plan_r2r_1d)(*n, in, out, (X(r2r_kind)) *kind, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_r2r_2d, PLAN_R2R_2D)(X(plan) *p, int *nx, int *ny,
+				   R *in, R *out, 
+				   int *kindx, int *kindy, int *flags)
+{
+     *p = X(plan_r2r_2d)(*ny, *nx, in, out,
+			 (X(r2r_kind)) *kindy, (X(r2r_kind)) *kindx, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_r2r_3d, PLAN_R2R_3D)(X(plan) *p,
+				   int *nx, int *ny, int *nz,
+				   R *in, R *out,
+				   int *kindx, int *kindy, int *kindz,
+				   int *flags)
+{
+     *p = X(plan_r2r_3d)(*nz, *ny, *nx, in, out,
+			 (X(r2r_kind)) *kindz, (X(r2r_kind)) *kindy, 
+			 (X(r2r_kind)) *kindx, *flags);
+}
+
+FFTW_VOIDFUNC F77(plan_many_r2r, PLAN_MANY_R2R)(
+     X(plan) *p, int *rank, const int *n,
+     int *howmany,
+     R *in, const int *inembed, int *istride, int *idist,
+     R *out, const int *onembed, int *ostride, int *odist,
+     int *kind, int *flags)
+{
+     int *nrev = reverse_n(*rank, n);
+     int *inembedrev = reverse_n(*rank, inembed);
+     int *onembedrev = reverse_n(*rank, onembed);
+     X(r2r_kind) *k = ints2kinds(*rank, kind);
+     *p = X(plan_many_r2r)(*rank, nrev, *howmany,
+			       in, inembedrev, *istride, *idist,
+			       out, onembedrev, *ostride, *odist,
+			       k, *flags);
+     X(ifree0)(k);
+     X(ifree0)(onembedrev);
+     X(ifree0)(inembedrev);
+     X(ifree0)(nrev);
+}
+
+FFTW_VOIDFUNC F77(plan_guru_r2r, PLAN_GURU_R2R)(
+     X(plan) *p, int *rank, const int *n,
+     const int *is, const int *os,
+     int *howmany_rank, const int *h_n,
+     const int *h_is, const int *h_os,
+     R *in, R *out, int *kind, int *flags)
+{
+     X(iodim) *dims = make_dims(*rank, n, is, os);
+     X(iodim) *howmany_dims = make_dims(*howmany_rank, h_n, h_is, h_os);
+     X(r2r_kind) *k = ints2kinds(*rank, kind);
+     *p = X(plan_guru_r2r)(*rank, dims, *howmany_rank, howmany_dims,
+			       in, out, k, *flags);
+     X(ifree0)(k);
+     X(ifree0)(howmany_dims);
+     X(ifree0)(dims);
+}
+
+FFTW_VOIDFUNC F77(execute_r2r, EXECUTE_R2R)(X(plan) * const p, R *in, R *out)
+{
+     plan_rdft *pln = (plan_rdft *) (*p)->pln;
+     pln->apply((plan *) pln, in, out);
+}

SynthesisTransform/include/fftw3.f

+      INTEGER FFTW_R2HC
+      PARAMETER (FFTW_R2HC=0)
+      INTEGER FFTW_HC2R
+      PARAMETER (FFTW_HC2R=1)
+      INTEGER FFTW_DHT
+      PARAMETER (FFTW_DHT=2)
+      INTEGER FFTW_REDFT00
+      PARAMETER (FFTW_REDFT00=3)
+      INTEGER FFTW_REDFT01
+      PARAMETER (FFTW_REDFT01=4)
+      INTEGER FFTW_REDFT10
+      PARAMETER (FFTW_REDFT10=5)
+      INTEGER FFTW_REDFT11
+      PARAMETER (FFTW_REDFT11=6)
+      INTEGER FFTW_RODFT00
+      PARAMETER (FFTW_RODFT00=7)
+      INTEGER FFTW_RODFT01
+      PARAMETER (FFTW_RODFT01=8)
+      INTEGER FFTW_RODFT10
+      PARAMETER (FFTW_RODFT10=9)
+      INTEGER FFTW_RODFT11
+      PARAMETER (FFTW_RODFT11=10)
+      INTEGER FFTW_FORWARD
+      PARAMETER (FFTW_FORWARD=-1)
+      INTEGER FFTW_BACKWARD
+      PARAMETER (FFTW_BACKWARD=+1)
+      INTEGER FFTW_MEASURE
+      PARAMETER (FFTW_MEASURE=0)
+      INTEGER FFTW_DESTROY_INPUT
+      PARAMETER (FFTW_DESTROY_INPUT=1)
+      INTEGER FFTW_UNALIGNED
+      PARAMETER (FFTW_UNALIGNED=2)
+      INTEGER FFTW_CONSERVE_MEMORY
+      PARAMETER (FFTW_CONSERVE_MEMORY=4)
+      INTEGER FFTW_EXHAUSTIVE
+      PARAMETER (FFTW_EXHAUSTIVE=8)
+      INTEGER FFTW_PRESERVE_INPUT
+      PARAMETER (FFTW_PRESERVE_INPUT=16)
+      INTEGER FFTW_PATIENT
+      PARAMETER (FFTW_PATIENT=32)
+      INTEGER FFTW_ESTIMATE
+      PARAMETER (FFTW_ESTIMATE=64)
+      INTEGER FFTW_WISDOM_ONLY
+      PARAMETER (FFTW_WISDOM_ONLY=2097152)
+      INTEGER FFTW_ESTIMATE_PATIENT
+      PARAMETER (FFTW_ESTIMATE_PATIENT=128)
+      INTEGER FFTW_BELIEVE_PCOST
+      PARAMETER (FFTW_BELIEVE_PCOST=256)
+      INTEGER FFTW_NO_DFT_R2HC
+      PARAMETER (FFTW_NO_DFT_R2HC=512)
+      INTEGER FFTW_NO_NONTHREADED
+      PARAMETER (FFTW_NO_NONTHREADED=1024)
+      INTEGER FFTW_NO_BUFFERING
+      PARAMETER (FFTW_NO_BUFFERING=2048)
+      INTEGER FFTW_NO_INDIRECT_OP
+      PARAMETER (FFTW_NO_INDIRECT_OP=4096)
+      INTEGER FFTW_ALLOW_LARGE_GENERIC
+      PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
+      INTEGER FFTW_NO_RANK_SPLITS
+      PARAMETER (FFTW_NO_RANK_SPLITS=16384)
+      INTEGER FFTW_NO_VRANK_SPLITS
+      PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
+      INTEGER FFTW_NO_VRECURSE
+      PARAMETER (FFTW_NO_VRECURSE=65536)
+      INTEGER FFTW_NO_SIMD
+      PARAMETER (FFTW_NO_SIMD=131072)
+      INTEGER FFTW_NO_SLOW
+      PARAMETER (FFTW_NO_SLOW=262144)
+      INTEGER FFTW_NO_FIXED_RADIX_LARGE_N
+      PARAMETER (FFTW_NO_FIXED_RADIX_LARGE_N=524288)
+      INTEGER FFTW_ALLOW_PRUNING
+      PARAMETER (FFTW_ALLOW_PRUNING=1048576)

SynthesisTransform/include/flops.c

+/*
+ * Copyright (c) 2003, 2007-14 Matteo Frigo
+ * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *
+ */
+
+#include "api/api.h"
+
+void X(flops)(const X(plan) p, double *add, double *mul, double *fma)
+{
+     planner *plnr = X(the_planner)();
+     opcnt *o = &p->pln->ops;
+     *add = o->add; *mul = o->mul; *fma = o->fma;
+     if (plnr->cost_hook) {
+	  *add = plnr->cost_hook(p->prb, *add, COST_SUM);
+	  *mul = plnr->cost_hook(p->prb, *mul, COST_SUM);
+	  *fma = plnr->cost_hook(p->prb, *fma, COST_SUM);
+     }
+}
+
+double X(estimate_cost)(const X(plan) p)
+{
+     return X(iestimate_cost)(X(the_planner)(), p->pln, p->prb);
+}
+
+double X(cost)(const X(plan) p)
+{
+     return p->pln->pcost;
+}

SynthesisTransform/include/forget-wisdom.c

+/*
+ * Copyright (c) 2003, 2007-14 Matteo Frigo
+ * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *
+ */
+
+#include "api/api.h"
+
+void X(forget_wisdom)(void)
+{
+     planner *plnr = X(the_planner)();
+     plnr->adt->forget(plnr, FORGET_EVERYTHING);
+}

SynthesisTransform/include/genf03.pl

+#!/usr/bin/perl -w
+# Generate Fortran 2003 interfaces from a sequence of C function declarations
+# of the form (one per line):
+#     extern <type> <name>(...args...)
+#     extern <type> <name>(...args...)
+#     ...
+# with no line breaks within a given function.  (It's too much work to
+# write a general parser, since we just have to handle FFTW's header files.)
+
+sub canonicalize_type {
+    my($type);
+    ($type) = @_;
+    $type =~ s/ +/ /g;
+    $type =~ s/^ //;
+    $type =~ s/ $//;
+    $type =~ s/([^\* ])\*/$1 \*/g;
+    return $type;
+}
+
+# C->Fortran map of supported return types
+%return_types = (
+    "int" => "integer(C_INT)",
+    "ptrdiff_t" => "integer(C_INTPTR_T)",
+    "size_t" => "integer(C_SIZE_T)",
+    "double" => "real(C_DOUBLE)",
+    "float" => "real(C_FLOAT)",
+    "long double" => "real(C_LONG_DOUBLE)",
+    "__float128" => "real(16)",
+    "fftw_plan" => "type(C_PTR)",
+    "fftwf_plan" => "type(C_PTR)",
+    "fftwl_plan" => "type(C_PTR)",
+    "fftwq_plan" => "type(C_PTR)",
+    "void *" => "type(C_PTR)",
+    "char *" => "type(C_PTR)",
+    "double *" => "type(C_PTR)",
+    "float *" => "type(C_PTR)",
+    "long double *" => "type(C_PTR)",
+    "__float128 *" => "type(C_PTR)",
+    "fftw_complex *" => "type(C_PTR)",
+    "fftwf_complex *" => "type(C_PTR)",
+    "fftwl_complex *" => "type(C_PTR)",
+    "fftwq_complex *" => "type(C_PTR)",
+    );
+
+# C->Fortran map of supported argument types
+%arg_types = (
+    "int" => "integer(C_INT), value",
+    "unsigned" => "integer(C_INT), value",
+    "size_t" => "integer(C_SIZE_T), value",
+    "ptrdiff_t" => "integer(C_INTPTR_T), value",
+
+    "fftw_r2r_kind" => "integer(C_FFTW_R2R_KIND), value",
+    "fftwf_r2r_kind" => "integer(C_FFTW_R2R_KIND), value",
+    "fftwl_r2r_kind" => "integer(C_FFTW_R2R_KIND), value",
+    "fftwq_r2r_kind" => "integer(C_FFTW_R2R_KIND), value",
+
+    "double" => "real(C_DOUBLE), value",
+    "float" => "real(C_FLOAT), value",
+    "long double" => "real(C_LONG_DOUBLE), value",
+    "__float128" => "real(16), value",
+
+    "fftw_complex" => "complex(C_DOUBLE_COMPLEX), value",
+    "fftwf_complex" => "complex(C_DOUBLE_COMPLEX), value",
+    "fftwl_complex" => "complex(C_LONG_DOUBLE), value",
+    "fftwq_complex" => "complex(16), value",
+
+    "fftw_plan" => "type(C_PTR), value",
+    "fftwf_plan" => "type(C_PTR), value",
+    "fftwl_plan" => "type(C_PTR), value",
+    "fftwq_plan" => "type(C_PTR), value",
+    "const fftw_plan" => "type(C_PTR), value",
+    "const fftwf_plan" => "type(C_PTR), value",
+    "const fftwl_plan" => "type(C_PTR), value",
+    "const fftwq_plan" => "type(C_PTR), value",
+
+    "const int *" => "integer(C_INT), dimension(*), intent(in)",
+    "ptrdiff_t *" => "integer(C_INTPTR_T), intent(out)",
+    "const ptrdiff_t *" => "integer(C_INTPTR_T), dimension(*), intent(in)",
+
+    "const fftw_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)",
+    "const fftwf_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)",
+    "const fftwl_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)",
+    "const fftwq_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)",
+
+    "double *" => "real(C_DOUBLE), dimension(*), intent(out)",
+    "float *" => "real(C_FLOAT), dimension(*), intent(out)",
+    "long double *" => "real(C_LONG_DOUBLE), dimension(*), intent(out)",
+    "__float128 *" => "real(16), dimension(*), intent(out)",
+
+    "fftw_complex *" => "complex(C_DOUBLE_COMPLEX), dimension(*), intent(out)",
+    "fftwf_complex *" => "complex(C_FLOAT_COMPLEX), dimension(*), intent(out)",
+    "fftwl_complex *" => "complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out)",
+    "fftwq_complex *" => "complex(16), dimension(*), intent(out)",
+
+    "const fftw_iodim *" => "type(fftw_iodim), dimension(*), intent(in)",
+    "const fftwf_iodim *" => "type(fftwf_iodim), dimension(*), intent(in)",
+    "const fftwl_iodim *" => "type(fftwl_iodim), dimension(*), intent(in)",
+    "const fftwq_iodim *" => "type(fftwq_iodim), dimension(*), intent(in)",
+
+    "const fftw_iodim64 *" => "type(fftw_iodim64), dimension(*), intent(in)",
+    "const fftwf_iodim64 *" => "type(fftwf_iodim64), dimension(*), intent(in)",
+    "const fftwl_iodim64 *" => "type(fftwl_iodim64), dimension(*), intent(in)",
+    "const fftwq_iodim64 *" => "type(fftwq_iodim64), dimension(*), intent(in)",
+
+    "void *" => "type(C_PTR), value",
+    "FILE *" => "type(C_PTR), value",
+
+    "const char *" => "character(C_CHAR), dimension(*), intent(in)",
+
+    "fftw_write_char_func" => "type(C_FUNPTR), value",
+    "fftwf_write_char_func" => "type(C_FUNPTR), value",
+    "fftwl_write_char_func" => "type(C_FUNPTR), value",
+    "fftwq_write_char_func" => "type(C_FUNPTR), value",
+    "fftw_read_char_func" => "type(C_FUNPTR), value",
+    "fftwf_read_char_func" => "type(C_FUNPTR), value",
+    "fftwl_read_char_func" => "type(C_FUNPTR), value",
+    "fftwq_read_char_func" => "type(C_FUNPTR), value",
+
+    # Although the MPI standard defines this type as simply "integer",
+    # if we use integer without a 'C_' kind in a bind(C) interface then
+    # gfortran complains.  Instead, since MPI also requires the C type
+    # MPI_Fint to match Fortran integers, we use the size of this type
+    # (extracted by configure and substituted by the Makefile).
+    "MPI_Comm" => "integer(C_MPI_FINT), value"
+    );
+
+while (<>) {
+    next if /^ *$/;
+    if (/^ *extern +([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *\((.*)\) *$/) {
+	$ret = &canonicalize_type($1);
+	$name = $2;
+
+	$args = $3;
+	$args =~ s/^ *void *$//;
+
+	$bad = ($ret ne "void") && !exists($return_types{$ret});	
+	foreach $arg (split(/ *, */, $args)) {
+	    $arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/;
+	    $argtype = &canonicalize_type($1);
+	    $bad = 1 if !exists($arg_types{$argtype});
+	}
+	if ($bad) {
+	    print "! Unable to generate Fortran interface for $name\n";
+	    next;
+	}
+
+	# any function taking an MPI_Comm arg needs a C wrapper (grr).
+	if ($args =~ /MPI_Comm/) {
+	    $cname = $name . "_f03";
+	}
+	else {
+	    $cname = $name;
+	}
+
+	# Fortran has a 132-character line-length limit by default (grr)
+	$len = 0;
+
+	print "    "; $len = $len + length("    ");
+	if ($ret eq "void") {
+	    $kind = "subroutine"
+	}
+	else {
+	    print "$return_types{$ret} ";
+	    $len = $len + length("$return_types{$ret} ");
+	    $kind = "function"
+	}
+	print "$kind $name("; $len = $len + length("$kind $name(");
+	$len0 = $len;
+	
+	$argnames = $args;
+	$argnames =~ s/([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) */$2/g;
+	$comma = "";
+	foreach $argname (split(/ *, */, $argnames)) {
+	    if ($len + length("$comma$argname") + 3 > 132) {
+		printf ", &\n%*s", $len0, "";
+		$len = $len0;
+		$comma = "";
+	    }
+	    print "$comma$argname";
+	    $len = $len + length("$comma$argname");
+	    $comma = ",";
+	}
+	print ") "; $len = $len + 2;
+
+	if ($len + length("bind(C, name='$cname')") > 132) {
+	    printf "&\n%*s", $len0 - length("$name("), "";
+	}
+	print "bind(C, name='$cname')\n";
+
+	print "      import\n";
+	foreach $arg (split(/ *, */, $args)) {
+	    $arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/;
+	    $argtype = &canonicalize_type($1);
+	    $argname = $2;
+	    $ftype = $arg_types{$argtype};
+
+	    # Various special cases for argument types:
+	    if ($name =~ /_flops$/ && $argtype eq "double *") {
+		$ftype = "real(C_DOUBLE), intent(out)" 
+	    }
+	    if ($name =~ /_execute/ && ($argname eq "ri" ||
+					$argname eq "ii" || 
+					$argname eq "in")) {
+		$ftype =~ s/intent\(out\)/intent(inout)/;
+	    }
+
+	    print "      $ftype :: $argname\n"
+	}
+
+	print "    end $kind $name\n";
+	print "    \n";
+    }
+}

SynthesisTransform/include/guru.h

+#define XGURU(name) X(plan_guru_ ## name)
+#define IODIM X(iodim)
+#define MKTENSOR_IODIMS X(mktensor_iodims)
+#define GURU_KOSHERP X(guru_kosherp)

SynthesisTransform/include/guru64.h

+#define XGURU(name) X(plan_guru64_ ## name)
+#define IODIM X(iodim64)
+#define MKTENSOR_IODIMS X(mktensor_iodims64)
+#define GURU_KOSHERP X(guru64_kosherp)

SynthesisTransform/include/import-system-wisdom.c

+/*
+ * Copyright (c) 2003, 2007-14 Matteo Frigo
+ * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *
+ */
+
+#include "api/api.h"
+
+#if defined(FFTW_SINGLE)
+#  define WISDOM_NAME "wisdomf"
+#elif defined(FFTW_LDOUBLE)
+#  define WISDOM_NAME "wisdoml"
+#else
+#  define WISDOM_NAME "wisdom"
+#endif
+
+/* OS-specific configuration-file directory */
+#if defined(__DJGPP__)
+#  define WISDOM_DIR "/dev/env/DJDIR/etc/fftw/"
+#else
+#  define WISDOM_DIR "/etc/fftw/"
+#endif
+
+int X(import_system_wisdom)(void)
+{
+#if defined(__WIN32__) || defined(WIN32) || defined(_WINDOWS)
+     return 0; /* TODO? */
+#else
+
+     FILE *f;
+     f = fopen(WISDOM_DIR WISDOM_NAME, "r");
+     if (f) {
+          int ret = X(import_wisdom_from_file)(f);
+          fclose(f);
+          return ret;
+     } else
+          return 0;
+#endif
+}

SynthesisTransform/include/import-wisdom-from-file.c

+/*
+ * Copyright (c) 2003, 2007-14 Matteo Frigo
+ * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *
+ */
+
+#include "api/api.h"
+#include <stdio.h>
+
+/* getc()/putc() are *unbelievably* slow on linux.  Looks like glibc
+   is grabbing a lock for each call to getc()/putc(), or something
+   like that.  You pay the price for these idiotic posix threads
+   whether you use them or not.
+
+   So, we do our own buffering.  This completely defeats the purpose
+   of having stdio in the first place, of course.
+*/
+  
+#define BUFSZ 256
+
+typedef struct {
+     scanner super;
+     FILE *f;
+     char buf[BUFSZ];
+     char *bufr, *bufw;
+} S;
+
+static int getchr_file(scanner * sc_)
+{
+     S *sc = (S *) sc_;
+
+     if (sc->bufr >= sc->bufw) {
+	  sc->bufr = sc->buf;
+	  sc->bufw = sc->buf + fread(sc->buf, 1, BUFSZ, sc->f);
+	  if (sc->bufr >= sc->bufw)
+	       return EOF;
+     }
+
+     return *(sc->bufr++);
+}
+
+static scanner *mkscanner_file(FILE *f)
+{
+     S *sc = (S *) X(mkscanner)(sizeof(S), getchr_file);
+     sc->f = f;
+     sc->bufr = sc->bufw = sc->buf;
+     return &sc->super;
+}
+
+int X(import_wisdom_from_file)(FILE *input_file)
+{
+     scanner *s = mkscanner_file(input_file);
+     planner *plnr = X(the_planner)();
+     int ret = plnr->adt->imprt(plnr, s);
+     X(scanner_destroy)(s);
+     return ret;
+}
+
+int X(import_wisdom_from_filename)(const char *filename)
+{
+     FILE *f = fopen(filename, "r");
+     int ret;
+     if (!f) return 0; /* error opening file */
+     ret = X(import_wisdom_from_file)(f);
+     if (fclose(f)) ret = 0; /* error closing file */
+     return ret;
+}

SynthesisTransform/include/import-wisdom-from-string.c

+/*
+ * Copyright (c) 2003, 2007-14 Matteo Frigo
+ * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *
+ */
+
+#include "api/api.h"
+
+typedef struct {
+     scanner super;
+     const char *s;
+} S_str;
+
+static int getchr_str(scanner * sc_)
+{
+     S_str *sc = (S_str *) sc_;
+     if (!*sc->s)
+          return EOF;
+     return *sc->s++;
+}
+
+static scanner *mkscanner_str(const char *s)
+{
+     S_str *sc = (S_str *) X(mkscanner)(sizeof(S_str), getchr_str);
+     sc->s = s;
+     return &sc->super;
+}
+
+int X(import_wisdom_from_string)(const char *input_string)
+{
+     scanner *s = mkscanner_str(input_string);
+     planner *plnr = X(the_planner)();
+     int ret = plnr->adt->imprt(plnr, s);
+     X(scanner_destroy)(s);
+     return ret;
+}

SynthesisTransform/include/import-wisdom.c

+/*
+ * Copyright (c) 2003, 2007-14 Matteo Frigo
+ * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *
+ */
+
+#include "api/api.h"
+
+typedef struct {
+     scanner super;
+     int (*read_char)(void *);
+     void *data;
+} S;
+
+static int getchr_generic(scanner * s_)
+{
+     S *s = (S *) s_;
+     return (s->read_char)(s->data);
+}
+
+int X(import_wisdom)(int (*read_char)(void *), void *data)
+{
+     S *s = (S *) X(mkscanner)(sizeof(S), getchr_generic);
+     planner *plnr = X(the_planner)();
+     int ret;
+
+     s->read_char = read_char;
+     s->data = data;
+     ret = plnr->adt->imprt(plnr, (scanner *) s);
+     X(scanner_destroy)((scanner *) s);
+     return ret;
+}