Updated 2013-09-01 16:05:28 by RLE

Bezoar 2007-5-23 : just saw a groups discussion on why the script was not initialized and added Tcl_Init(interp); to the code this initializes the interpreter so you do not have to do the stuff the script does at the top.

Bezoar 2007-5-22 : yeah just noticed theres no code for the two functions puts_Dingo and mk_Dingo made some changes other places as well. Dunno how it worked like it was. Works now. Thanks for heads up

XO 2006-11-30: Something must be left out accidentally while trimming the fat, I couldn't get this great example up and running. ^o^

Communicating between C and embedded Tcl Interpreter

In a recent project, a customer wanted to customize the behavior of a complex program by somehow incorporating flexible rules that would be invoked upon the input data and the interpreted results passed back to the C program. The initial proposal was to create a CORBA object that would be used to pass the data to a Java program that ran a JavaScript interpreter. The data would be run through a JavaScript program that implemented the flexible rules and the marshalling and unmarshalling of the data. The results returned using the same CORBA object. Well you don't have to be too sharp to see that this would be a maintenance nightmare, and this was just another "use java at all cost" occasions (don't get me started...). Since I heard about SWIG I suggested that we embed the rules as a tcl script instead and use SWIG to do the data translation from C to tcl and back again. What follows in the code snippets below is a simplified version of using swig as mentioned. Although with this SWIG solution there really isn't any marshalling/unmarshalling or network involved, which makes it significantly faster. Maintenance is also improved because all the code is in one location.

I trimmed most of the fat from the example for space reasons, but one should be able to quickly cut and paste the code into files and make the example (provided you have SWIG installed). The code below has been tested on Solaris and Linux. (Solaris 2.8), I used the SUNWspro6 compiler and on Linux, (Fedora Core 5/4/3) gcc. I ran into one problem that caused the loading of extensions into interpreted tcl script. Apparently, the global variable tcl_library is not set when you create an interpreter so the init.tcl does not run, and none of the auto_xxx variables or utilities are available. At the top of p.tcl you will see how I fix the situation. I call Tcl_FindExecutable, but it does not seem to help. This may be unique to my setup as I don't use the usual install paths. If anyone can come up with a better way please feel free to correct the code.[Bezoar ] (Corrected see comment in script).

Makefile
    INTERFACE = myif.i
    WRAPFILE = $(INTERFACE:.i=_wrap.c)
    WRAPOBJ = $(INTERFACE:.i=_wrap.o)
    TARGET = myif.so # output
    # compiler options
    #CC = /opt/SUNWspro6/bin/cc
    CC = gcc
    CFLAGS = -g 
    INCLUDE =
    #SWIG OPTIONS
    SWIG = /usr/bin/swig
    SWIGOPT = -tcl8
    SIWGCC = $(CC)
    # Rules for creating .o files form source.
    COBJS = $(SRCS:.c=.o)
    ALLOBJS = $(COBJS) $(OBJS)
    #Shared Library options ( Shown for Linux )
    #CCSHARED = -Kpic
    #BUILD = $(CC) -G
    CCSHARED = -fpic
    BUILD = $(CC) -shared
    # Tcl installation
    TCL_INCL = -I/opt/usr/include
    TCL_LIB= -L/opt/usr/lib
    # Tcl installation
    TCL_INCLUDE= -I/opt/usr/include
    TCL_LIB= -L/usr/lib
    
    # additional link libraries
    
    LIBS =  -lm
    
    .SUFFIXES: .c
    
    .c.o :
            gcc   $(CFLAGS) $(INCLUDE) -c $<
    
    all: $(TARGET)
            echo "All done"
    
        # convert the SWIG wrapper file into an object file
    $(WRAPOBJ): $(WRAPFILE)
            gcc $(CCSHARED) $(CFLAGS) -c $(WRAPFILE) $(TCL_INCLUDE) $(INCLUDE)
    
        # run SWIG
    $(WRAPFILE): $(INTERFACE)
            $(SWIG) $(SWIGOPT) -o $(WRAPFILE) $(INTERFACE)
    
        # Build the final extension module
    $(TARGET) : $(WRAPOBJ) $(ALLOBJS) myif.o
            $(BUILD) $(CCSHARED) $(WRAPOBJ) $(ALLOBJS) $(TCL_LIB) $(LIBS) myif.o /usr/lib/libtcl8.4.so -o $(TARGET)
    
    myapp : myapp.c myif.o
            gcc -g $(CCSHARED) -I. $(TCL_INCL) $(TCL_LIB) $(LIBS) myif.o myapp.c /usr/lib/libtcl8.4.so   -o myapp
    
    clean:
             rm -f $(WRAPFILE) $(TARGET) *.o myapp

myif.c
     #define MYIF_H
    #include "myif.h"
    struct Dingo * request;
    struct Dingo * Reply;
    
    struct Dingo * mk_Dingo(const char * name, const char* middlename, const char * lname, int selector, union Data* d )     {
             struct Dingo * retval = malloc( sizeof(struct Dingo));
             memset(retval->name,0,30);
             strncpy(retval->name,name,29);
             memset(retval->lname,0,40);
             strncpy(retval->lname,lname,39);
             memset(retval->middlename,0,50);
             strncpy(retval->middlename,middlename,49);
             retval->selector = selector;
             memset(&retval->data,0, sizeof(union Data));
             memcpy(& retval->data, d, sizeof(union Data));
             return retval;
         }
     char *  puts_Dingo(struct Dingo * ptr) {
         char buffer[1000];
         memset(buffer,0,1000);
         if ( ptr->selector == 0 ) {
           sprintf(buffer,"N:%s M:%s L:%s S:%s",ptr->name,ptr->middlename,ptr->lname,ptr->data.strvalue);
         } else {
           sprintf(buffer,"N:%s M:%s L:%s S:%d",ptr->name,ptr->middlename,ptr->lname,ptr->data.value);
         }
         char * retval = malloc( strlen(buffer)+ 1 );
         memset(retval,0, strlen(buffer) + 1 );
         strncpy(retval,buffer,strlen(buffer));
         return retval;
       }

myif.h
    #include <math.h>
    #include <stdlib.h>
    #include <unistd.h>
    #include <errno.h>
    #include <sys/time.h>
    #include <sys/types.h>
    #include <sys/resource.h>
    
    
    union Data {
      double value;
      char strvalue[10];
    } ;
    struct Dingo {
      char name[30];
      char lname[40];
      char middlename [50];
      int selector;
      union Data data;
    };
    #ifndef MYIF_H 
    /* these are the C code structures that we are going to modify in the script */
    extern struct Dingo * request;
    extern struct Dingo * Reply;
    struct Dingo * mk_Dingo(const char * name, const char * middlename,const char * lname, int selector,union Data * d);
    char *  puts_Dingo(struct Dingo * ptr);
    #endif

myif.i
    %module myif
    %{
    #include <math.h>
    #include <stdlib.h>
    #include "myif.h"
    %}
    %include "myif.h"

myapp.c
    #include <string.h>
    #include <tcl.h>
    #include "myif.h"
  
    int main(int argc, char** argv)
    {
            // Local variables
        Tcl_Interp * interp;
            union Data d;
            char * strvalue="This is a test";
            double value =0.0;
            char * name="Chuck";
            char * lname="Cheese";
            char * middlename="E.";
            char * retstr=NULL;
            int selector=1;
        memset(d.strvalue,0,10);
            strncpy(d.strvalue,strvalue,9);
            request=mk_Dingo(name,middlename,lname,selector,&d);
            retstr=puts_Dingo(request);
            printf("CCODE:request before p.tcl: %s\n",retstr);
            free(retstr);
            Reply=mk_Dingo("","","",selector,&d);
            retstr=puts_Dingo(Reply);
            printf("CCODE:Reply before p.tcl%s\n",retstr);
            free(retstr);
            Tcl_FindExecutable(argv[0]);
            interp=Tcl_CreateInterp();
            if ( interp == NULL ) {
              printf("Unable to create Interpreter");
              exit(127);
            }
        Tcl_Init(interp);
            switch(Tcl_EvalFile(interp,"p.tcl")) {
            case TCL_OK: 
              printf ("CCODE:p.tcl completed successfully\n");
              break;
            case TCL_ERROR:
              printf("CCODE:rocess.tcl returned with an error: TCL_ERROR\n");
              break;
            case TCL_RETURN:
              printf("CCODE:p.tcl returned with an error: TCL_RETURN\n");
              break;
            case TCL_BREAK:
              printf("CCODE:p.tcl returned with an error: TCL_BREAK\n");
              break;
            case TCL_CONTINUE:
              printf("CCODE:p.tcl returned with an error: TCL_CONTINUE\n");
              break;
            default: 
              printf("CCODE:p.tcl returned with unknown error code:?\n");
              break;
            }
            printf("%s\n",Tcl_GetStringResult(interp));
            retstr=puts_Dingo(Reply);
            printf("CCODE:Reply after p.tcl: %s\n",retstr);
            free(retstr);
            retstr=puts_Dingo(request);
            printf("CCODE:request after p.tcl: %s\n",retstr);
            free(retstr);
            Tcl_DeleteInterp(interp);
            exit(0);
    }

p.tcl
    ### THIS section not needed anymore because of addtion of Tcl_Init(interp); in myapp.c
    #global tcl_library 
    #if { ![ info exists tcl_library ] } {
    #    puts stdout "TCLCODE:setting tcl_library"
    #    set tcl_library /opt/usr/lib/tcl8.4
    #
    #}
    #catch { source [file join $tcl_library init.tcl ]  }  
    #lappend auto_path [file dirname $tcl_library ]  [pwd]
    # load swig generated extension
    load [file normalize [ file join . myif.so ] ]
    # call swig extension methods does not affect C structures but shows how to use swig
    # generated methods in tcl script
    Dingo test; # create a Dingo struct called test 
    test configure -name Charlie -lname Cheezit -middlename G. -selector 1 ; # set some data
    [test cget -data ] configure -strvalue "Rain" 
    # access req structure from C code
    puts stdout "TCLCODE:test name:[test cget -name  ] \
    mname:[test cget -middlename ] \
    lname:[test cget -lname  ] "
    puts stdout "TCLCODE:test selector:[test cget -selector ] \
    strvalue:[[test cget -data ] cget -strvalue] "
    puts stdout "TCLCODE:Accessing C code filled out structure request: \
    N:[Dingo_name_get $request ] \
    M:[Dingo_middlename_get $request ] \
    L:[Dingo_lname_get $request ] " 
    puts stdout "TCLCODE:Global C variable Reply is a swig pointer Reply= $Reply"
    puts stdout "TCLCODE:Setting Reply: name:Wally\
    middlename: [ Dingo_name_get $request ] \
    lname: [Dingo_lname_get $request ]" 
    Dingo_name_set $Reply "Wally"
    Dingo_middlename_set $Reply [ Dingo_name_get $request ]
    Dingo_lname_set $Reply [Dingo_lname_get $request ] 
    puts stdout "TCLCODE:request: [puts_Dingo $request ]"
    puts stdout "TCLCODE:Reply : [puts_Dingo $Reply ]"
    close $fd

Building

Cut and paste all code with the filenames given then run make. You should have also installed swig and updated the Makefile paths to match your system.
    make
    make myapp

Run
    myapp

Output
    ./myapp
    CCODE:request before p.tcl: N:Chuck M:E. L:Cheese S:1936287828
    CCODE:Reply before p.tclN: M: L: S:1936287828
    TCLCODE:setting tcl_library
    TCLCODE:test name:Charlie  mname:G.  lname:Cheezit
    TCLCODE:test selector:1  strvalue:Rain
    TCLCODE:Accessing C code filled out structure request:  N:Chuck  M:E.  L:Cheese
    TCLCODE:Global C variable Reply is a swig pointer Reply= _c0c03109_p_Dingo
    TCLCODE:Setting Reply: name:Wally  middlename: Chuck  lname: Cheese
    TCLCODE:request: N:Chuck M:E. L:Cheese S:1936287828
    TCLCODE:Reply : N:Wally M:Chuck L:Cheese S:1936287828
    CCODE:p.tcl completed successfully

    CCODE:Reply after p.tcl: N:Wally M:Chuck L:Cheese S:1936287828
    CCODE:request after p.tcl: N:Chuck M:E. L:Cheese S:1936287828