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 only created on Tcl command, kiss_fft 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.
// 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"