Version 3 of Building kiss_fft library extension for TCL

Updated 2015-10-25 22:09:56 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 describe 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. The basic idea is to represent C struct as Tcl list and use various Tcl C API to convert Tcl_Obj to native C data types.


// 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 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;

}