Version 12 of Building kiss_fft library extension for TCL

Updated 2015-10-25 22:40:37 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

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, it's 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

#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 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"