Tutorial Pages‎ > ‎

    Creating New Tcl Packages in C

    How to add new commands and functionality the easy way.

    Attempting to write everything in Tcl is probably not too good an idea. Tcl is an interpreted language and relies upon the design principle that 'everything is as string'. For the most part is a real bonus but this does have its own limitations -notably a speed trade-off. This is particularly an issue when a stream of data, such a pixel info, is passed two and fro between the Tcl interpretor and other lower-level functions. But, don't worry! One of the great things about Tcl is just how easy the processes of extensibility is.  In most cases of that 'advanced functionality' we want is already out in some code module there in the 'cloud' and what is needed is an easy way to glue this functionality into a new package. One doesn't need to be a C-SuperGuru to achieve this. Just a smattering of how C works (easily done once one knows how to code in Tcl) is all that's needed. Drawing upon the resources already found in the Gnocl libraries, the barest minimum to get a C coded Tcl extension in place has been put together. The supplied Makefile controls the build, installation and removal of the package.

    Module Source


    The source code that has been used for this article is based upon a snippet found here at the Tcler's wiki. It's a good, simple introduction and here its been modified to show how to quickly add more than a single new command. Lets take a look at it bit by bit.

    /**
    hello.c -- A minimal Tcl C extension.

        NOTE: The following strings are defined as in the Makefile.
            PACKAGE_LOAD_NAME
            VERSION
            PACKAGE_INIT

    **/

    The module header block. Simple enough, but here we anticipate some future developments such as package name change and version number. These are only used once in this module but are accessed right throughout the makefile itself. Passing these values to the compiler will prevent any mis-match.

    #include <tcl.h>

    typedef struct
    {
        char *name;
        Tcl_ObjCmdProc *proc;
    } TclCmd;

    Next comes the header files for the Tcl package itself and a simple structure to hold the names of the new commands to be  made public via the interpreter and the module functions that these will invoke. Next comes the function declarations themselves.

    /* Declare are commands here */
    static Tcl_ObjCmdProc Hello_Cmd;
    static Tcl_ObjCmdProc Bye_Cmd;

    The Tcl_ObjCmdProc is already defined in the Tcl sources and removes the need to fully expand the function declarations. Next, create a structure array to contain a list of paired commands names and functions (this will be called later during the package initialisation itself). It might look a little much for a fledgling package, but in the long run, this approach will make complex package development a much easier process.

    /* create an array of command names and their library functions */
    static TclCmd commands[] =
    {
        { "hello", Hello_Cmd },
        { "bye", Bye_Cmd },
        { NULL, NULL },
    };

    Now follows the commands that we want to add.

    /**
        Simple "Hello" command.
    **/
    static int Hello_Cmd ( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] )
    {

    #ifdef DEBUG_TAG
        printf("%s\n",__FUNCTION__);
    #endif

        Tcl_SetObjResult ( interp, Tcl_NewStringObj ( "Hello, World!", -1 ) );
        return TCL_OK;
    }

    /**
        Simple "Bye" command.
    **/
    static int Bye_Cmd ( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] )
    {

    #ifdef DEBUG_TAG
        printf("%s\n",__FUNCTION__);
    #endif

        Tcl_SetObjResult ( interp, Tcl_NewStringObj ( "Bye-Bye, World!", -1 ) );
        return TCL_OK;
    }

    In order to enable quickly trace the function flow whilst development occurs, macros can be used to turn on-off feedback options. Here the macro DEBUG_TAG has been set enabling some feedback to be written to the console. At the moment this will simply given the name of the active function. Finally, there is the package _Init function.  Each package needs a function like the following, the most critical feature is that the function name must include the package load name suffixed with _Init.

    /**
        PACKAKGE_INIT -- Called when Tcl loads this extension.
    **/
    int PACKAGE_INIT ( Tcl_Interp *interp )
    {
        int k;

        if ( Tcl_InitStubs ( interp, TCL_VERSION, 0 ) == NULL ) {
            return TCL_ERROR;
            }

        if ( Tcl_PkgProvide ( interp, PACKAGE_LOAD_NAME, VERSION ) == TCL_ERROR ) {
            return TCL_ERROR;
            }

        for ( k = 0; commands[k].name; ++k ) {
            Tcl_CreateObjCommand ( interp,  commands[k].name, commands[k]. proc, NULL, NULL );
            }

        return TCL_OK;
    }


    As can be seen here, the commands array which contains the matched pairings of command and function names is stepped through and the commands registered using Tcl_CreateObjCommand.

    Makefile


    #---------------
    # NAME
    #   makefile -- template makefile for building Tcl C extensions
    #---------------
    # AUTHORS
    #    William J Giddings. 2010
    #---------------
    # SYNOPSIS
    #   * make all
    #   * make clean
    #   * make install
    #   * make reinstall
    #   * make uninstall
    #---------------
    # PURPOSE
    #---------------
    # NOTES
    #   http://www.gnu.org/software/make/manual/html_node
    #---------------
    # DEPENDENCIES
    #---------------
    # HISTORY
    #---------------
    # TODO:
    #---------------

    #---------------
    # PACKAGE NAME, replace these entries with required details.
    #---------------
    PACKAGE_NAME := libhello
    PACKAGE_LOAD_NAME := Hello
    VERSION := 1.0
    SUFFIX :=

    #---------------
    # Specify tags for controlling debugging feedback.
    #---------------
    DEFINE:= "NONE"
    DEFINE:= "DEBUG_TAG"

    #---------------
    # Specify which object modules need to be built.
    # Append the names of additional modules to the end of the list.
    #---------------
    OBJS := \
        $(PACKAGE_NAME).o

    ############################################################
    # There should be no need to edit anything below this line
    ############################################################

    #-------------
    # Determine Tcl version currently installed on system.
    #-------------
    TCL_VERSION := $(shell echo 'puts $$tcl_version' | tclsh)

    #-------------
    # For releases use -Os, this makes the lib 15% smaller.
    # amd64 need -fPIC, x86 works with and without, remove warnings.
    #-------------
    CFLAGS := -D$(DEFINE) -pedantic -fPIC -w

    #-------------
    # Modify ADDCFLAGS to find package include files.
    #-------------
    ADDCFLAGS := \
        -D PACKAGE_LOAD_NAME=\"$(PACKAGE_LOAD_NAME)\" \
        -D VERSION=\"$(VERSION)\" \
        -D PACKAGE_INIT=$(PACKAGE_LOAD_NAME)_Init \
        -D USE_TCL_STUBS \
        -I /usr/include/tcl$(TCL_VERSION)


    #-------------
    # Modify LIBS to find link libraries.
    #-------------
    LIBS := -ltclstub$(TCL_VERSION)

    #---------------
    # This area works, but probably needs some attention.
    # http://www.gnu.org/software/automake/manual/make/Phony-Targets.html
    #---------------
    .PHONY: all $(PACKAGE_NAME) clean
    %.o : %.c; $(CC) -c $(CFLAGS) $(ADDCFLAGS) -o $*.o $<

    #---------------
    # Build the package.
    #---------------
    all: $(PACKAGE_NAME)

    $(PACKAGE_NAME): ./$(PACKAGE_NAME).so ;

    ./$(PACKAGE_NAME).so: $(PACKAGE_NAME).o
        $(CC) -shared -o ./$(PACKAGE_NAME).so $(OBJS) $(LIBS)

    #---------------
    # Remove all objects modules and shared libraries, created by this project.
    #---------------
    clean:
        rm -f $(PACKAGE_NAME).o $(PACKAGE_NAME).so

    #---------------
    # Run external Tcl script to install available packages.
    #---------------
    install:
        sudo ./install.tcl $(PACKAGE_LOAD_NAME) $(VERSION) $(PACKAGE_NAME) install

    #---------------
    # Run external Tcl script to remove currently installed package
    #---------------
    uninstall:
        sudo ./install.tcl $(PACKAGE_LOAD_NAME) $(VERSION) $(PACKAGE_NAME) uninstall

    #---------------
    #   Reinstall gnocl from recently compiled files
    #---------------
    reinstall:
        sudo ./install.tcl $(PACKAGE_LOAD_NAME) $(VERSION) $(PACKAGE_NAME) uninstall
        sudo ./install.tcl $(PACKAGE_LOAD_NAME) $(VERSION) $(PACKAGE_NAME) install

    Apart from controlling the build, this will also provide the means of installing/uninstalling the package itself. Extensive use is made of setting module settings and passing these onto the  compiler using the -D option. Control over the what parts of the code gives debug feedback during development can be obtained by creating and adjusting the DEFINE:= "DEBUG_TAG" lines of the Makefile.

    Installation

    Once again, the installation process can be controlled via the makefile. To get this work, the following Tcl script also needs to be installed.

    #---------------
    # install.tcl
    #---------------
    # Author(s):
    #   Peter G Baum, 2003
    #   William J Giddings, 2009
    #---------------
    # Description:
    #   Install package using Tcl.
    #   This will ensure installation into correct directory.
    # Notes:
    #   Ensure that pkgIndex.tcl is up to date. To ensure this,run
    #   make pkgIndex.tcl.
    #---------------

    #!/bin/sh
    # the next line restarts using tclsh \
    exec tclsh "$0" "$@"

    #---------------
    # lazy way to get preformated time and date
    #---------------
    proc date { {i date} } {
      switch -- $i {
        d&t   { set f "%c" }
        year  { set f "%Y" }
        week  { set f "%W" }
        day   { set f "%A" }
        month { set f "%B" }
        time  { set f "%H:%M:%S" }
        date  { set f "%d/%m/%y" }
        date4 { set f "%Y-%m-%d" }
        D4T24 { set f "%Y-%m-%d %T" }
      }
      return [clock format [clock seconds] -format "$f"]
    }

    # error checking
    if { $argc != 4 } {
       set name [file tail $argv0]
       error "Wrong number of args.\nUsage: $name package version install/uninstall"
    }

    # get parameters
    foreach {package version name what} $argv { break }

    # get installation directory
    set dir [info library]

    # create sub-directory to receive package
    set destDir [file join $dir $name$version]
    switch -- $what {
       "install"   {
           if { [file exists $destDir] } {
               puts "$destDir exists already. Aborting installation."
               exit -1
               }
               puts "Create updated package file."
               set fp [open pkgIndex.tcl "w"]
               puts $fp "# Created: [date] [date time]"
               puts $fp {# Tcl package index file, version 1.1}
               puts $fp {# This file is sourced either when an application starts up or}
               puts $fp {# by a "package unknown" script.  It invokes the}
               puts $fp {# "package ifneeded" command to set up package-related}
               puts $fp {# information so that packages will be loaded automatically}
               puts $fp {# in response to "package require" commands.  When this}
               puts $fp {# script is sourced, the variable $dir must contain the}
               puts $fp {# full path name of this file's directory.}
               puts $fp {}
               puts $fp "package ifneeded $package $version \[list load \[file join \$dir $name.so\]\]"
               close $fp
               puts "Creating $destDir"
               file mkdir $destDir
               set files [glob *.so]
               lappend files pkgIndex.tcl
               foreach file $files {
                   puts "Copying $file"
                   file copy $file $destDir
                   }
            }
       "uninstall" {
                      puts "Deleting $destDir"
                      file delete -force $destDir
                   }
       default     {
                      error "unknown type \"$what\" must be install, test or uninstall"
                   }
    }

    So, with all these elements in place and properly executed. The following test script can be run to test the whole project.

    Test Script

    #---------------
    # test-libhello.tcl
    #---------------
    #!./bin/sh
    #\
    exec "$0" "$@"
    #---------------

    package require Hello

    puts [hello]
    puts [bye]

    exit


    Comments

    Sections