fftw_s.pas 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159
  1. {$IFNDEF FPC_DOTTEDUNITS}
  2. unit fftw_s;
  3. {$ENDIF FPC_DOTTEDUNITS}
  4. {
  5. FFTW - Fastest Fourier Transform in the West library
  6. This interface unit is (C) 2005 by Daniel Mantione
  7. member of the Free Pascal development team.
  8. See the file COPYING.FPC, included in this distribution,
  9. for details about the copyright.
  10. This file carries, as a independend work calling a well
  11. documented binary interface, the Free Pascal LGPL license
  12. with static linking exception.
  13. Note that the FFTW library itself carries the GPL license
  14. and can therefore not be used in non-GPL software.
  15. }
  16. {*****************************************************************************}
  17. interface
  18. {*****************************************************************************}
  19. {$CALLING cdecl} {Saves some typing.}
  20. {$MACRO on}
  21. {$INLINE on}
  22. {$IFDEF Unix}
  23. const
  24. fftwlib = 'fftw3f';
  25. {$ELSE}
  26. const
  27. fftwlib = 'libfftw3f';
  28. {$ENDIF}
  29. type complex_single=record
  30. re,im:single;
  31. end;
  32. Pcomplex_single=^complex_single;
  33. fftw_plan_single=type pointer;
  34. fftw_sign=(fftw_forward=-1,fftw_backward=1);
  35. fftw_flag=(fftw_measure, {generated optimized algorithm}
  36. fftw_destroy_input, {default}
  37. fftw_unaligned, {data is unaligned}
  38. fftw_conserve_memory, {needs no explanation}
  39. fftw_exhaustive, {search optimal algorithm}
  40. fftw_preserve_input, {don't overwrite input}
  41. fftw_patient, {generate highly optimized alg.}
  42. fftw_estimate); {don't optimize, just use an alg.}
  43. fftw_flagset=set of fftw_flag;
  44. {Complex to complex transformations.}
  45. function fftw_plan_dft_1d(n:cardinal;i,o:Pcomplex_single;
  46. sign:fftw_sign;flags:fftw_flagset):fftw_plan_single;
  47. external fftwlib name 'fftwf_plan_dft_1d';
  48. function fftw_plan_dft_2d(nx,ny:cardinal;i,o:Pcomplex_single;
  49. sign:fftw_sign;flags:fftw_flagset):fftw_plan_single;
  50. external fftwlib name 'fftwf_plan_dft_2d';
  51. function fftw_plan_dft_3d(nx,ny,nz:cardinal;i,o:Pcomplex_single;
  52. sign:fftw_sign;flags:fftw_flagset):fftw_plan_single;
  53. external fftwlib name 'fftwf_plan_dft_3d';
  54. function fftw_plan_dft(rank:cardinal;n:Pcardinal;i,o:Pcomplex_single;
  55. sign:fftw_sign;flags:fftw_flagset):fftw_plan_single;
  56. external fftwlib name 'fftwf_plan_dft';
  57. {Real to complex transformations.}
  58. function fftw_plan_dft_1d(n:cardinal;i:Psingle;o:Pcomplex_single;
  59. flags:fftw_flagset):fftw_plan_single;
  60. external fftwlib name 'fftwf_plan_dft_r2c_1d';
  61. function fftw_plan_dft_2d(nx,ny:cardinal;i:Psingle;o:Pcomplex_single;
  62. flags:fftw_flagset):fftw_plan_single;
  63. external fftwlib name 'fftwf_plan_dft_r2c_2d';
  64. function fftw_plan_dft_3d(nx,ny,nz:cardinal;i:Psingle;o:Pcomplex_single;
  65. flags:fftw_flagset):fftw_plan_single;
  66. external fftwlib name 'fftwf_plan_dft_r2c_3d';
  67. function fftw_plan_dft(rank:cardinal;n:Pcardinal;i:Psingle;o:Pcomplex_single;
  68. flags:fftw_flagset):fftw_plan_single;
  69. external fftwlib name 'fftwf_plan_dft_r2c';
  70. {Complex to real transformations.}
  71. function fftw_plan_dft_1d(n:cardinal;i:Pcomplex_single;o:Psingle;
  72. flags:fftw_flagset):fftw_plan_single;
  73. external fftwlib name 'fftwf_plan_dft_c2r_1d';
  74. function fftw_plan_dft_2d(nx,ny:cardinal;i:Pcomplex_single;o:Psingle;
  75. flags:fftw_flagset):fftw_plan_single;
  76. external fftwlib name 'fftwf_plan_dft_c2r_2d';
  77. function fftw_plan_dft_3d(nx,ny,nz:cardinal;i:Pcomplex_single;o:Psingle;
  78. flags:fftw_flagset):fftw_plan_single;
  79. external fftwlib name 'fftwf_plan_dft_c2r_3d';
  80. function fftw_plan_dft(rank:cardinal;n:Pcardinal;i:Pcomplex_single;o:Psingle;
  81. flags:fftw_flagset):fftw_plan_single;
  82. external fftwlib name 'fftwf_plan_dft_c2r';
  83. procedure fftw_destroy_plan(plan:fftw_plan_single);
  84. external fftwlib name 'fftwf_destroy_plan';
  85. procedure fftw_execute(plan:fftw_plan_single);
  86. external fftwlib name 'fftwf_execute';
  87. {$calling register} {Back to normal!}
  88. procedure fftw_getmem(var p:pointer;size:sizeint);
  89. procedure fftw_freemem(p:pointer);inline;
  90. {*****************************************************************************}
  91. implementation
  92. {*****************************************************************************}
  93. {$ifndef Windows}
  94. {$LINKLIB fftw3f}
  95. {$endif}
  96. {Required libraries by libfftw3}
  97. { $LINKLIB gcc}
  98. { $LINKLIB c}
  99. { $LINKLIB m}
  100. {Better don't use fftw_malloc and fftw_free, but provide Pascal replacements.}
  101. {$IF defined(cpui386) or defined(cpupowerpc)}
  102. {$DEFINE align:=16}
  103. {$ENDIF}
  104. procedure fftw_getmem(var p:pointer;size:sizeint);
  105. {$IFDEF align}
  106. var
  107. originalptr:pointer;
  108. begin
  109. { We allocate additional "align-1" bytes to be able to align.
  110. And we allocate additional "SizeOf(Pointer)" to always have space to store
  111. the value of the original pointer. }
  112. getmem(originalptr,size + align-1 + SizeOf(Pointer));
  113. ptruint(p):=(ptruint(originalptr) + SizeOf(Pointer));
  114. ptruint(p):=(ptruint(p)+align-1) and not (align-1);
  115. PPointer(ptruint(p) - SizeOf(Pointer))^:=originalptr;
  116. {$ELSE}
  117. begin
  118. getmem(p,size);
  119. {$ENDIF}
  120. end;
  121. procedure fftw_freemem(p:pointer);inline;
  122. begin
  123. {$IFDEF align}
  124. freemem(PPointer(ptruint(p) - SizeOf(Pointer))^);
  125. {$ELSE}
  126. freemem(p);
  127. {$ENDIF}
  128. end;
  129. end.