TCL與c/c++的互相調用

http://lauwd.blog.163.com/blog/static/7605696920107429017/
 

  TCL是一個解釋型的語言，但是功能相當強大，一個重要原因就在於它的擴展性，現有的諸如http,socket,xml,oratcl等等，使得tcl可以輕鬆處理字符串、文件、通信以及數據庫等等多方面的工作，甚至支持多線程。
  TCL的擴展可以通過調用tcl library來完成，具體的開發語言可能有多種，本文第一部分將以c/c++爲例討論。
  此外，緣於客戶化的需要，也有可能在c/c++代碼中調用tcl的咚咚，例如執行腳本啊，配置文件什麼的，具體可見第二部分。
 
一.tcl中調用c/c++
  主要是利用c/c++處理複雜邏輯的能力，對於tcl來說，實際上就是一個擴展，因爲你可以通過Tcl_CreateCommand函數，創建出一個新的tcl命令。
  具體操作方法需要分情況：
 
1.如果當前tcl版本支持load命令
語法：load libpackage.so
意義：在tcl中，當一個動態庫libpackage.so被裝載時，tcl會調用其中名爲package_Init的函數，記住，名字一定不能錯，包括大小寫。這樣，你就獲得了一個入口，可以進入c/c++啦，你可以幹任何事，當然，最重要的還是Tcl_CreateCommand了。
 
函數原型：Tcl_Command Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
意義：創建一個新的tcl命令cmdName，對應的操作函數指針爲proc。
 
這裏以一個階乘算法爲例：目的是提供一個名爲myfract的tcl命令，只接收一個參數，例如：
myfract 10
表示計算10的階乘。
 
【fract.c】：
#include "tcl.h"
int Tcl_myfract(ClientData notUsed, Tcl_Interp *interp, int argc, char **argv)
{
  int i, j;
  double res=1.0;
  char re[30];
  if (argc > 2)
  {
    Tcl_SetResult(interp, "wrong args: should be myfract", TCL_VOLATILE);
    return TCL_ERROR;
  }
  if (Tcl_GetInt(interp, argv[1], &i) != TCL_OK)
  {
    return TCL_ERROR;
  }
  for (j=1;j<=i;j++)
    res *= j;
  sprintf(re,"%le",res);
  Tcl_SetResult(interp, re, TCL_VOLATILE);
  return TCL_OK;
}
int Fract_Init(Tcl_Interp *Interp) {
  Tcl_CreateCommand (Interp, "myfract", (Tcl_CmdProc *)Tcl_myfract, (ClientData)0, 0);
  return TCL_OK;
}
 
【Makefile】：
t = libfract.so
all: $t
clean:
  rm -f $t core
libfract.so: fract.c
  gcc -I. -shared -o $@ fract.c
 
【test.tcl】： 
#!/usr/bin/tclsh
load ./libfract.so
set tcl_flag  [catch {myfract 2} return_str]
if {$tcl_flag != 0} {
  puts "OK:$return_str"
} else {
  puts "Error:$return_str"
}
 
運行：
linux:~/test/tcl # ./test.tcl
2.000000e+00
 
【小結】：這裏有兩點需要注意，第一，Fract_Init是由TCL到c/c++的入口，而Tcl_CreateCommand則是由c/c++到TCL的入口；第二，編譯動態庫時不必鏈接tcl的開發庫，因爲這裏僅僅需要引用。
     
還有swig可以使用
 
【fract.i】：
%module fract
extern double myfract(int);
swig的語法這裏就不詳述了，具體可參見www.swig.org。
第一行表示模塊名稱叫做fract，對應前面的c/c++代碼，就是說要創建的動態庫叫做libfract.so；
第二行表示將要導出的函數，這個函數是需要你自己定義的。
 
【fract.c】：
double myfract(int n)
{
  double res=1.0;
  int j;
  for (j=1;j<=n;j++)
  {
    res *= j;
  }
  return(res);
}
 
【Makefile】：
t = fract_wrap.c libfract.so
all: $t
clean:
  rm -f $t core *.doc *.o
fract_wrap.c: fract.i
  swig -tcl fract.i
libfract.so:fract_wrap.c
  gcc -c fract.c fract_wrap.c
 
運行：
linux:~/test/tcl/swig # ./test.tcl
2.0
 
2.如果當前tcl版本不支持load命令
  我不知道哪個版本會這麼原始，但即便如此，仍然有解決方法，那就是把擴展模塊靜態鏈接到執行文件中去，具體操作如下：
【main.c】：
#include <tcl.h>
#include <stdio.h>
int Tcl_AppInit(Tcl_Interp *interp);
int main(int argc, char *argv[]) {
  Tcl_Main(argc, argv, Tcl_AppInit);
}
int Tcl_AppInit(Tcl_Interp *interp) {
  /* Initialize Tcl */
  if (Tcl_Init(interp) == TCL_ERROR) {
    return TCL_ERROR;
  }
  /* Initialize our extension */
  if (Fract_Init(interp) == TCL_ERROR) {
    return TCL_ERROR;
  }
  return TCL_OK;
}
 
【Makefile】：
t = main
TCL_LIBS = -L/usr/lib -ltcl8.4
all: $t
clean:
  rm -f $t core
main:main.c fract.c
  gcc -I. ${TCL_LIBS} -o $@ main.c fract.c
 
運行：
linux:~/test/tcl # ./main
% myfract 8
4.032000e+04
% exit
linux:~/test/tcl # ldd main
        linux-gate.so.1 =>  (0xffffe000)
        libtcl8.4.so => /usr/lib/libtcl8.4.so (0x40030000)
        libc.so.6 => /lib/tls/libc.so.6 (0x400d8000)
        libdl.so.2 => /lib/libdl.so.2 (0x401f1000)
        libm.so.6 => /lib/tls/libm.so.6 (0x401f5000)
        /lib/ld-linux.so.2 (0x40000000)
       
我們發現，代碼中重寫了Tcl_AppInit函數，在tcl手冊中該函數被形容爲一個``hook'' procedure，很奇妙的東西。
因爲最後會創建一個類似tclsh的執行文件，所以，tcl開發庫必須鏈接上。
 
二.c/c++中調用tcl
  之所以會有這樣的做法，主要是想利用tcl的客戶化能力。
  例如把流程寫在tcl腳本中，c/c++代碼中僅僅執行Tcl_EvalFile就可以了，對於不同的服務，我們可以藉助某種手段，綁定一個流程腳本，這樣，當增加新的服務時或者服務流程需要變更時，不必修改源碼，只要增加或修改配置文件/腳本文件即可，這也就實現了我們所說的客戶化。
  我們只討論幾個常用的函數：
Tcl_CreateInterp    － 創建一個tcl解釋器
Tcl_Eval            － 執行一個tcl命令
Tcl_VarEval         － 類似Tcl_Eval，只不過這個命令是被參數串起來的
Tcl_EvalFile        － 執行一個tcl腳本
Tcl_SetVar          － 設置tcl變量
Tcl_GetVar          － 獲取tcl變量的值
 
下面是一個用法測試：
【test.c】：
#include <tcl.h>
#include <string.h>
#include <stdlib.h>
#include <assert.h>
int main()
{
  Tcl_Interp* interp;
  char    *p;
  int tclres;
  //create interpreter
  interp = Tcl_CreateInterp();
  /*
   * Test Tcl_SetVar
   */
  char *varname = "SERVICE_NAME";
  char *varval = "MyServer";
  p = (char *)Tcl_SetVar(interp, varname, varval, TCL_GLOBAL_ONLY);
  assert ( p!=NULL && !strncmp(p, "MyServer", 8) );
  /*
   * Test Tcl_GetVar
   */
  p = (char *)Tcl_GetVar(interp, "SERVICE_NAME", TCL_GLOBAL_ONLY);
  assert ( p!=NULL && !strncmp(p, "MyServer", 8) );
  /*
   * Test Tcl_Eval
   */
  tclres = Tcl_eval_r(interp, "set CFG_val world");
  assert ( tclres == TCL_OK) ;
  p = (char *)Tcl_GetVar(interp, "CFG_val", TCL_GLOBAL_ONLY);
  assert ( p!=NULL && !strncmp(p, "world", 5) );
  /*
   * Test Tcl_VarEval
   */
  char *home = "./";
  tclres = Tcl_Vareval_r(interp, "source ", home, "test.cfg", NULL) ;
  assert ( tclres == TCL_OK) ;
  p = (char *)Tcl_GetVar(interp, "CFG_val", TCL_GLOBAL_ONLY);
  assert ( p!=NULL && !strncmp(p, "hello", 5) );
  /*
   * Test Tcl_EvalFile
   */
  char *path = "./test.cfg";
  tclres = Tcl_EvalFile(interp, path);
  assert ( tclres == TCL_OK) ;
  p = (char *)Tcl_GetVar(interp, "CFG_val", TCL_GLOBAL_ONLY);
  assert ( p!=NULL && !strncmp(p, "hello", 5) );
  //END
  printf("OK\n");
  }
 
【Makefile】：
t = test
TCL_LIBS = -L/usr/lib -ltcl8.4
all: $t
clean:
  rm -f $t core
test: test.c
  gcc -I. ${TCL_LIBS} -o $@ test.c
linux:~/test/tcl/test # ./test
OK
 
三.後記
  在實踐中，以上二者往往是聯繫在一起的，例如c/c++中調用的tcl腳本，也可以執行擴展命令（該命令完全可能是用c/c++代碼實現的）。沒有必要刻意去區分它們，正確的時候做正確的事，這就是原則。