To create a C extension loadable by tclsh is quite easy. However, direction for doing it is well hidden in various books especially passing C array of struct which is commonly required by engineering application. As an example, I'll show here how to wrap the kiss_fft library for tclsh interpreter using Tcl C API calls. I've also tried to use SWIG, and it seems to be next to impossible to use it to pass array of C struct. Anyone with knowledge of how to do this using SWIG, please share it here, Thanks! The basic idea is to represent C struct as Tcl list and then use various Tcl C API to convert Tcl_Obj to native C data types. call the kiss_fft then convert the output array of struct back to Tcl list before passing it back to Tcl interpreter.
Kiss_fft is an open source library for doing mix-radix Fast Fourier Transform. it can be downloaded from its homepage at:
http://sourceforge.net/projects/kissfft
Download kiss_fft130.zip. you will need _kiss_fft_guts.h, kiss_fft.h, and kiss_fft.c in the archive and tclkiss_fft.c (shown below) to build the extension.
I've created two C extension Tcl commands, kiss_fft for complex data input and kiss_fftr for real data input in this post; the rest of the library can be easily made available as Tcl commands.
I hope by seeing an example of how to create Tcl extension command using C APIs will help those of us who have no idea how to start solving problem like this. As you can see, the required C code is quite short and rather simple to extend the Tcl if shown by some example. Happy coding!
// written by Long To, 10/24/2015 to interface with TCL. note: inverse FFT needs to be scaled down by FFT length
// This code is in the public domain
// tclkiss_fft.c
#include "kiss_fft.h"
#include <tcl.h>
// following declaration is needed in Windows using MSVC compiler for the package to detect the ???_Init() function
__declspec(dllexport) int Kiss_fft_Init(Tcl_Interp *);
int Kiss_fftCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int Kiss_fftrCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int Kiss_fft_Init(Tcl_Interp *interp) {
if(Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgProvide(interp, "Kiss_fft", "1.1") == TCL_ERROR)
return TCL_ERROR;
Tcl_CreateObjCommand(interp, "kiss_fft", Kiss_fftCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "kiss_fftr", Kiss_fftrCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
return TCL_OK;
}
int Kiss_fftCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
if (objc != 3) {
Tcl_WrongNumArgs(interp, objc, objv, " ?inverse? ?fin?");
return TCL_ERROR;
}
int count, inverse;
Tcl_Obj *list_in = objv[2];
// extract the 1st arg of the kiss_fft command as an integer: 0 for foward transform, 1 for inverse transform
if (Tcl_GetIntFromObj(interp, objv[1], &inverse) != TCL_OK) {
Tcl_AppendResult(interp, " Couldn't get direction of transform");
return TCL_ERROR;
}
if (Tcl_ListObjLength(interp, list_in, &count) != TCL_OK) {
Tcl_AppendResult(interp, " Couldn't get fin length");
return TCL_ERROR;
}
int nfft = count;
kiss_fft_cpx *fin = (kiss_fft_cpx *)malloc(sizeof(kiss_fft_cpx) * nfft);
kiss_fft_cpx *fout = (kiss_fft_cpx *)malloc(sizeof(kiss_fft_cpx) * nfft);
Tcl_Obj *real; // individual element of Tcl_Obj double represent the real part of the complex number
Tcl_Obj *imag; // individual element of Tcl_Obj double represent the imaginary part of the complex number
Tcl_Obj *L; // inner sublist of outer list list_in
for (size_t i=0; i<count; ++i) {
if (Tcl_ListObjIndex(interp, list_in, i, &L) != TCL_OK) { // outer list list_in passed in from TCL command
Tcl_AppendResult(interp, " Invalid index");
return TCL_ERROR;
}
if (Tcl_ListObjIndex(interp, L, 0, &real) != TCL_OK) { // real part
Tcl_AppendResult(interp, " Invalid index");
return TCL_ERROR;
}
if (Tcl_ListObjIndex(interp, L, 1, &imag) != TCL_OK) { // imaginary part
Tcl_AppendResult(interp, " Invalid index");
return TCL_ERROR;
}
if (Tcl_GetDoubleFromObj(interp, real, &fin[i].r) != TCL_OK) { // convert Tcl_Obj to double
Tcl_AppendResult(interp, " Not a double");
return TCL_ERROR;
}
if (Tcl_GetDoubleFromObj(interp, imag, &fin[i].i) != TCL_OK) { // convert Tcl_Obj to double
Tcl_AppendResult(interp, " Not a double");
return TCL_ERROR;
}
}
kiss_fft_cfg cfg = kiss_fft_alloc(nfft,inverse,0,0);
kiss_fft(cfg,fin,fout);
free(cfg);
Tcl_Obj *list = Tcl_NewListObj(0, NULL);
Tcl_Obj* Re;
Tcl_Obj* Im;
Tcl_Obj* C;
for ( size_t i=0; i<nfft; ++i ) {
Re = Tcl_NewDoubleObj(fout[i].r);
Im = Tcl_NewDoubleObj(fout[i].i);
C = Tcl_NewListObj(0, NULL);
if ( Tcl_ListObjAppendElement(interp, C, Re) != TCL_OK ) {
Tcl_AppendResult(interp, " Couldn't append real part");
return TCL_ERROR;
}
if ( Tcl_ListObjAppendElement(interp, C, Im) != TCL_OK ) {
Tcl_AppendResult(interp, " Couldn't append imaginary part");
return TCL_ERROR;
}
if ( Tcl_ListObjAppendElement(interp, list, C) != TCL_OK ) {
Tcl_AppendResult(interp, " Couldn't append complex result");
return TCL_ERROR;
}
}
free(fin);
free(fout);
Tcl_SetObjResult(interp, list);
return TCL_OK;
}
int Kiss_fftrCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
if (objc != 3) {
Tcl_WrongNumArgs(interp, objc, objv, " ?inverse? ?fin?");
return TCL_ERROR;
}
int count, inverse;
Tcl_Obj *list_in = objv[2];
// extract the 1st arg of the kiss_fft command as an integer: 0 for foward transform, 1 for inverse transform
if (Tcl_GetIntFromObj(interp, objv[1], &inverse) != TCL_OK) {
Tcl_AppendResult(interp, " Couldn't get direction of transform");
return TCL_ERROR;
}
if (Tcl_ListObjLength(interp, list_in, &count) != TCL_OK) {
Tcl_AppendResult(interp, " Couldn't get fin length");
return TCL_ERROR;
}
int nfft = count;
kiss_fft_cpx *fin = (kiss_fft_cpx *)malloc(sizeof(kiss_fft_cpx) * nfft);
kiss_fft_cpx *fout = (kiss_fft_cpx *)malloc(sizeof(kiss_fft_cpx) * nfft);
Tcl_Obj *x; // individual element of double
for (size_t i=0; i<nfft; ++i) {
if (Tcl_ListObjIndex(interp, list_in, i, &x) != TCL_OK) { // list_in passed in from TCL command
Tcl_AppendResult(interp, " Invalid index");
return TCL_ERROR;
}
if (Tcl_GetDoubleFromObj(interp, x, &fin[i].r) != TCL_OK) { // individual list element of the list_in
Tcl_AppendResult(interp, " Not a double");
return TCL_ERROR;
}
fin[i].i = 0.0;
}
kiss_fft_cfg cfg = kiss_fft_alloc(nfft,inverse,0,0);
kiss_fft(cfg,fin,fout);
free(cfg);
Tcl_Obj *list = Tcl_NewListObj(0, NULL);
Tcl_Obj* Re;
Tcl_Obj* Im;
Tcl_Obj* C;
for ( size_t i=0; i<nfft; ++i ) {
Re = Tcl_NewDoubleObj(fout[i].r);
Im = Tcl_NewDoubleObj(fout[i].i);
C = Tcl_NewListObj(0, NULL);
if ( Tcl_ListObjAppendElement(interp, C, Re) != TCL_OK ) {
Tcl_AppendResult(interp, " Couldn't append real part");
return TCL_ERROR;
}
if ( Tcl_ListObjAppendElement(interp, C, Im) != TCL_OK ) {
Tcl_AppendResult(interp, " Couldn't append imaginary part");
return TCL_ERROR;
}
if ( Tcl_ListObjAppendElement(interp, list, C) != TCL_OK ) {
Tcl_AppendResult(interp, " Couldn't append complex result");
return TCL_ERROR;
}
}
free(fin);
free(fout);
Tcl_SetObjResult(interp, list);
return TCL_OK;
}To compile the code using Visual C++:
cl -c kiss_fft.c /Ox
cl -c tclkiss_fft.c /Ox /DUSE_TCL_STUBS /Ic:\tcl\include
link /DLL /LTCG /out:kiss_fft.dll kiss_fft.obj tclkiss_fft.obj /libpath:c:\tcl\lib tclstub86.lib
following is a test Tcl script (runme.tcl) to verify everything is working:
catch { load ./kiss_fft[info sharedlibextension] kiss_fft}
set cin {{1 0}\
{2 0}\
{3 0}\
{4 0}\
{5 0}}
puts "length of list cin is: [llength $cin]"
puts $cin
puts "\n"
set inverse 0
puts "set inverse to: $inverse"
puts "to perform foward FFT on a complex series: $cin"
set F [kiss_fft $inverse $cin]
puts "\noutput is:"
foreach el $F {
puts \{$el\}
}
puts "\n"
set inverse 1
puts "set inverse to: $inverse"
puts "to perform inverse FFT on a complex series: $F"
set I [kiss_fft $inverse $F]
puts "\noutput is:"
foreach el $I {
puts \{$el\}
}
puts "note: the output of inverse FFT needs be scaled by 1/[llength $I]"
if {0} {
foreach l $I {
foreach inner $l {
set inner [expr $inner/[llength $I]]
puts $inner
}
}
}
unset I
unset F
unset cin
puts "\n"
set R {1 2 3 4}
puts "perform FFT transform of real series: $R"
set inverse 0
puts "inverse is: $inverse"
set O [kiss_fftr $inverse $R]
puts "output is: $O"
The output from the script:
C:\tcl>tclsh86t runme.tcl
length of list cin is: 5
{1 0} {2 0} {3 0} {4 0} {5 0}
set inverse to: 0
to perform foward FFT on a complex series: {1 0} {2 0} {3 0} {4 0} {5 0}
output is:
{15.0 0.0}
{-2.499999999999999 3.440954801177934}
{-2.499999999999999 0.8122992405822661}
{-2.499999999999999 -0.8122992405822661}
{-2.499999999999999 -3.440954801177934}
set inverse to: 1
to perform inverse FFT on a complex series: {15.0 0.0} {-2.499999999999999 3.440954801177934} {-2.499999999999999 0.8122992405822661} {-2.499999999999999 -0.8122992405822661} {-2.499999999999999 -3.440954801177934}
output is:
{5.0000000000000036 0.0}
{10.0 0.0}
{15.0 0.0}
{20.0 0.0}
{25.0 0.0}
note: the output of inverse FFT needs be scaled by 1/5
perform FFT transform of real series: 1 2 3 4
inverse is: 0
output is: {10.0 0.0} {-2.0 2.0} {-2.0 0.0} {-2.0 -2.0}
C:\tcl>
Reference:
[1
] Tcl-FFTW
