1
2
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
59
60
61
62
63
64
65
66
67
68
69
70
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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
unit fftw;
{
FFTW - Fastest Fourier Transform in the West library
This interface unit is (C) 2005 by Daniel Mantione
member of the Free Pascal development team.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This file carries, as a independend work calling a well
documented binary interface, the Free Pascal LGPL license
with static linking exception.
Note that the FFTW library itself carries the GPL license
and can therefore not be used in non-GPL software.
}
{*****************************************************************************}
interface
{*****************************************************************************}
{$CALLING cdecl} {Saves some typing.}
{$MACRO on}
{$INLINE on}
{$IFDEF Unix}
const
fftwlib = 'fftw3';
{$ELSE}
const
fftwlib = 'libfftw3';
{$ENDIF}
type complex_double=record
re,im:double;
end;
Pcomplex_double=^complex_double;
fftw_iodim=record
n,ins,ous: integer;
end;
pFft_iodim=^fftw_iodim;
fftw_plan_double=type pointer;
fftw_sign=(fftw_forward=-1,fftw_backward=1);
fftw_flag=(fftw_measure, {generated optimized algorithm}
fftw_destroy_input, {default}
fftw_unaligned, {data is unaligned}
fftw_conserve_memory, {needs no explanation}
fftw_exhaustive, {search optimal algorithm}
fftw_preserve_input, {don't overwrite input}
fftw_patient, {generate highly optimized alg.}
fftw_estimate); {don't optimize, just use an alg.}
fftw_flagset=set of fftw_flag;
fftw_r2r_kind = (
FFTW_R2HC=0, FFTW_HC2R=1, FFTW_DHT=2,
FFTW_REDFT00=3, FFTW_REDFT01=4, FFTW_REDFT10=5, FFTW_REDFT11=6,
FFTW_RODFT00=7, FFTW_RODFT01=8, FFTW_RODFT10=9, FFTW_RODFT11=10
);
Pfftw_r2r_kind = ^fftw_r2r_kind;
{Complex to complex transformations.}
function fftw_plan_dft_1d(n:cardinal;i,o:Pcomplex_double;
sign:fftw_sign;flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_1d';
function fftw_plan_dft_2d(nx,ny:cardinal;i,o:Pcomplex_double;
sign:fftw_sign;flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_2d';
function fftw_plan_dft_3d(nx,ny,nz:cardinal;i,o:Pcomplex_double;
sign:fftw_sign;flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_3d';
function fftw_plan_dft(rank:cardinal;n:Pcardinal;i,o:Pcomplex_double;
sign:fftw_sign;flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft';
{Real to complex transformations.}
function fftw_plan_dft_1d(n:cardinal;i:pDouble;o:Pcomplex_double;
flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_r2c_1d';
function fftw_plan_dft_2d(nx,ny:cardinal;i:pDouble;o:Pcomplex_double;
flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_r2c_2d';
function fftw_plan_dft_3d(nx,ny,nz:cardinal;i:pDouble;o:Pcomplex_double;
flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_r2c_3d';
function fftw_plan_dft(rank:cardinal;n:Pcardinal;i:pDouble;o:Pcomplex_double;
flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_r2c';
function fftw_plan_many_dft_r2c(rank:cardinal;n:Pcardinal;howmany:cardinal;
i:pDouble;inembed:Pcardinal;istride:cardinal;
idist:cardinal;o:Pcomplex_double;onembed:Pcardinal;
ostride:cardinal;odist:cardinal;
flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_many_dft_r2c';
function fftw_plan_many_dft_c2r(rank:cardinal;n:Pcardinal;howmany:cardinal;
i:Pcomplex_double;inembed:Pcardinal;istride:cardinal;
idist:cardinal;o:pDouble;onembed:Pcardinal;
ostride:cardinal;odist:cardinal;
flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_many_dft_c2r';
{Complex to real transformations.}
function fftw_plan_dft_1d(n:cardinal;i:Pcomplex_double;o:pDouble;
flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_c2r_1d';
function fftw_plan_dft_2d(nx,ny:cardinal;i:Pcomplex_double;o:pDouble;
flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_c2r_2d';
function fftw_plan_dft_3d(nx,ny,nz:cardinal;i:Pcomplex_double;o:pDouble;
flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_c2r_3d';
function fftw_plan_dft(rank:cardinal;n:Pcardinal;i:Pcomplex_double;o:pDouble;
flags:fftw_flagset):fftw_plan_double;
external fftwlib name 'fftw_plan_dft_c2r';
{Real to real transformations.}
function fftw_plan_guru_r2r(rank:cardinal;dims:pFft_iodim;howmany_rank:cardinal;
howmany_dims:pFftw_iodim;i,o:pDouble;
kind:Pfftw_r2r_kind;flags:fftw_flagset): fftw_plan_double;
external fftwlib name 'fftw_plan_guru_r2r';
procedure fftw_destroy_plan(plan:fftw_plan_double);
external fftwlib name 'fftw_destroy_plan';
procedure fftw_execute(plan:fftw_plan_double);
external fftwlib name 'fftw_execute';
function fftw_export_wisdom_to_filename(filename: pChar): cardinal;
external fftwlib name 'fftw_export_wisdom_to_filename';
function fftw_import_wisdom_from_filename(filename: pChar): cardinal;
external fftwlib name 'fftw_import_wisdom_from_filename';
{$calling register} {Back to normal!}
procedure fftw_getmem(var p:pointer;size:sizeInt);
procedure fftw_freemem(p:pointer);inline;
{*****************************************************************************}
implementation
{*****************************************************************************}
{$ifndef Windows}
{$LINKLIB fftw3f}
{$endif}
{Required libraries by libfftw3}
{ $LINKLIB gcc}
{ $LINKLIB c}
{ $LINKLIB m}
{Better don't use fftw_malloc and fftw_free, but provide Pascal replacements.}
{$IF defined(cpui386) or defined(cpupowerpc)}
{$DEFINE align:=16}
{$ENDIF}
procedure fftw_getmem(var p:pointer;size:sizeInt);
{$IFDEF align}
var
originalptr:pointer;
begin
{ We allocate additional "align-1" bytes to be able to align.
And we allocate additional "sizeOf(pointer)" to always have space to store
the value of the original pointer. }
getMem(originalptr,size + align-1 + sizeOf(pointer));
ptrUInt(p):=(ptrUInt(originalptr) + sizeOf(pointer));
ptrUInt(p):=(ptrUInt(p)+align-1) and not (align-1);
pPointer(ptrUInt(p) - sizeOf(pointer))^:=originalptr;
{$ELSE}
begin
getMem(p,size);
{$ENDIF}
end;
procedure fftw_freemem(p:pointer);inline;
begin
{$IFDEF align}
freeMem(pPointer(ptrUInt(p) - sizeOf(pointer))^);
{$ELSE}
freeMem(p);
{$ENDIF}
end;
end.
|
