开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tclStubLib.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：3k
源码类别：

通讯编程

开发平台：

Visual C++

tclStubLib.c：源码内容
  1. /* 
  2.  * tclStubLib.c --
  3.  *
  4.  * Stub object that will be statically linked into extensions that wish
  5.  * to access Tcl.
  6.  *
  7.  * Copyright (c) 1998-1999 by Scriptics Corporation.
  8.  * Copyright (c) 1998 Paul Duffin.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * RCS: @(#) $Id: tclStubLib.c,v 1.6.2.1 2005/11/20 18:23:03 jenglish Exp $
  14.  */
  16. /*
  17.  * We need to ensure that we use the stub macros so that this file contains
  18.  * no references to any of the stub functions.  This will make it possible
  19.  * to build an extension that references Tcl_InitStubs but doesn't end up
  20.  * including the rest of the stub functions.
  21.  */
  23. #ifndef USE_TCL_STUBS
  24. #define USE_TCL_STUBS
  25. #endif
  26. #undef USE_TCL_STUB_PROCS
  28. #include "tclInt.h"
  29. #include "tclPort.h"
  31. /*
  32.  * Ensure that Tcl_InitStubs is built as an exported symbol.  The other stub
  33.  * functions should be built as non-exported symbols.
  34.  */
  36. TclStubs *tclStubsPtr = NULL;
  37. TclPlatStubs *tclPlatStubsPtr = NULL;
  38. TclIntStubs *tclIntStubsPtr = NULL;
  39. TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
  41. static TclStubs * HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp));
  43. static TclStubs *
  44. HasStubSupport (interp)
  45.     Tcl_Interp *interp;
  46. {
  47.     Interp *iPtr = (Interp *) interp;
  49.     if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
  50. return iPtr->stubTable;
  51.     }
  52.     interp->result = "This interpreter does not support stubs-enabled extensions.";
  53.     interp->freeProc = TCL_STATIC;
  55.     return NULL;
  56. }
  58. /*
  59.  *----------------------------------------------------------------------
  60.  *
  61.  * Tcl_InitStubs --
  62.  *
  63.  * Tries to initialise the stub table pointers and ensures that
  64.  * the correct version of Tcl is loaded.
  65.  *
  66.  * Results:
  67.  * The actual version of Tcl that satisfies the request, or
  68.  * NULL to indicate that an error occurred.
  69.  *
  70.  * Side effects:
  71.  * Sets the stub table pointers.
  72.  *
  73.  *----------------------------------------------------------------------
  74.  */
  76. #ifdef Tcl_InitStubs
  77. #undef Tcl_InitStubs
  78. #endif
  80. CONST char *
  81. Tcl_InitStubs (interp, version, exact)
  82.     Tcl_Interp *interp;
  83.     CONST char *version;
  84.     int exact;
  85. {
  86.     CONST char *actualVersion = NULL;
  87.     ClientData pkgData = NULL;
  89.     /*
  90.      * We can't optimize this check by caching tclStubsPtr because
  91.      * that prevents apps from being able to load/unload Tcl dynamically
  92.      * multiple times. [Bug 615304]
  93.      */
  95.     tclStubsPtr = HasStubSupport(interp);
  96.     if (!tclStubsPtr) {
  97. return NULL;
  98.     }
  100.     actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData);
  101.     if (actualVersion == NULL) {
  102. return NULL;
  103.     }
  104.     tclStubsPtr = (TclStubs*)pkgData;
  106.     if (tclStubsPtr->hooks) {
  107. tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
  108. tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
  109. tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
  110.     } else {
  111. tclPlatStubsPtr = NULL;
  112. tclIntStubsPtr = NULL;
  113. tclIntPlatStubsPtr = NULL;
  114.     }
  115.     
  116.     return actualVersion;
  117. }