Version 21 of Building kiss_fft library extension for TCL

Updated 2015-10-26 03:14:07 by newTclguy

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
// 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 link name