Posted to tcl by patthoyts at Wed Apr 08 14:10:37 GMT 2009view raw

  1. /* basethrd.c - Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
  2. *
  3. * Sample of an embedded Tcl application linked using the Tcl stubs mechanism
  4. * as seen at http://wiki.tcl.tk/2074.
  5. *
  6. * This version demonstrates linking to the stardll (ActiveTcl calls it a
  7. * basekit DLL) which is a TclKit presented as a DLL.
  8. *
  9. * This will create two threads and load a given basekit dll library on
  10. * each.
  11. *
  12. * can be built using:
  13. * cl -MD -W3 -I/opt/tcl/include basethrd.c \opt\tcl\lib\tclstub85.lib
  14. *
  15. * ----------------------------------------------------------------------
  16. * This source code is public domain.
  17. * ----------------------------------------------------------------------
  18. *
  19. * $Id$
  20. */
  21.  
  22. #define STRICT
  23. #define WIN32_LEAN_AND_MEAN
  24. #include <windows.h>
  25.  
  26. #ifndef USE_TCL_STUBS
  27. #define USE_TCL_STUBS
  28. #endif
  29. #include <tcl.h>
  30.  
  31. static Tcl_Interp *InitializeTcl(const char *dllname,int argc, char *args[]);
  32.  
  33. typedef struct Init {
  34. const char *path;
  35. int argc;
  36. char **argv;
  37. DWORD tid;
  38. } Init;
  39.  
  40. DWORD WINAPI
  41. BeginThread(LPVOID pClientData)
  42. {
  43. Init *pInit = pClientData;
  44. Tcl_Interp *interp;
  45. int r = TCL_OK;
  46.  
  47. interp = InitializeTcl(pInit->path, pInit->argc, pInit->argv);
  48. if (interp == NULL) {
  49. fprintf(stderr, "error: failed to initialize Tcl\n");
  50. } else {
  51. if (pInit->argc > 1) {
  52. r = Tcl_EvalFile(interp, pInit->argv[1]);
  53. printf(Tcl_GetStringResult(interp));
  54. }
  55. Tcl_DeleteInterp(interp);
  56. }
  57. return r;
  58. }
  59.  
  60. int
  61. main(int argc, char *argv[])
  62. {
  63. HANDLE threads[2];
  64. Init init[2];
  65. int n;
  66.  
  67. init[0].path = "basekit.dll";
  68. init[1].path = "basekit85.dll";
  69.  
  70. for (n = 0; n < sizeof(threads)/sizeof(threads[0]); ++n)
  71. {
  72. init[n].argc = argc;
  73. init[n].argv = argv;
  74.  
  75. threads[n] = CreateThread(0, 0, BeginThread, &init[n],
  76. CREATE_SUSPENDED, &init[n].tid);
  77. }
  78.  
  79. /* start the threads */
  80. for (n = 0; n < sizeof(threads)/sizeof(threads[0]); ++n)
  81. ResumeThread(threads[n]);
  82.  
  83. while (1)
  84. {
  85. DWORD dwWait = WaitForMultipleObjects(n, threads, TRUE, 1000);
  86. if (dwWait == WAIT_TIMEOUT) {
  87. printf("tick\n");
  88. } else if (dwWait >= WAIT_OBJECT_0 && dwWait < (WAIT_OBJECT_0 + n)) {
  89. break;
  90. } else {
  91. fprintf(stderr, "error!\n");
  92. break;
  93. }
  94. }
  95.  
  96. /* cleanup politely */
  97. for (n = 0; n < sizeof(threads)/sizeof(threads[0]); ++n)
  98. CloseHandle(threads[n]);
  99.  
  100. return 0;
  101. }
  102.  
  103. typedef Tcl_Interp * (*LPFNCREATEINTERP) ();
  104. typedef int (*LPFNBASEKITINIT) (Tcl_Interp *);
  105. typedef char * (*LPFNSETKITPATH) (char *);
  106.  
  107. Tcl_Interp *
  108. InitializeTcl(const char *dllname, int argc, char *argv[])
  109. {
  110. WCHAR szLibrary[MAX_PATH];
  111. CHAR utfLibrary[MAX_PATH * 2];
  112. HINSTANCE hTcl = NULL;
  113. Tcl_Interp *interp = NULL;
  114.  
  115. hTcl = LoadLibraryA(dllname);
  116. if (hTcl != NULL) {
  117.  
  118. LPFNCREATEINTERP lpfnCreateInterp
  119. = (LPFNCREATEINTERP)GetProcAddress(hTcl, "Tcl_CreateInterp");
  120. LPFNBASEKITINIT lpfnBasekitInit
  121. = (LPFNBASEKITINIT)GetProcAddress(hTcl, "TclKit_AppInit");
  122. LPFNSETKITPATH lpfnSetKitPath
  123. = (LPFNSETKITPATH)GetProcAddress(hTcl, "TclKit_SetKitPath");
  124.  
  125. if (lpfnCreateInterp != NULL && lpfnBasekitInit != NULL
  126. && lpfnSetKitPath != NULL)
  127. {
  128. interp = lpfnCreateInterp();
  129. if (interp != NULL) {
  130. Tcl_InitStubs(interp, "8.4", 0);
  131. Tcl_FindExecutable(argv[0]);
  132. GetModuleFileNameW(hTcl, szLibrary, MAX_PATH);
  133. WideCharToMultiByte(CP_UTF8, 0, szLibrary, -1, utfLibrary, MAX_PATH*2, NULL, NULL);
  134. lpfnSetKitPath(utfLibrary);
  135. if (lpfnBasekitInit(interp) == TCL_OK) {
  136. Tcl_InitMemory(interp);
  137. } else {
  138. fprintf(stderr, "TclKit_AppInit: %s\n",
  139. Tcl_GetStringResult(interp));
  140. }
  141. }
  142. }
  143. }
  144. return interp;
  145. }