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