diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.h | 9 | ||||
-rw-r--r-- | generic/tclBasic.c | 4 | ||||
-rw-r--r-- | generic/tclInt.h | 4 | ||||
-rw-r--r-- | generic/tclLoad.c | 505 |
4 files changed, 504 insertions, 18 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 83ad1bd..e53fcf0 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.170 2004/01/09 20:55:26 davygrvy Exp $ + * RCS: @(#) $Id: tcl.h,v 1.171 2004/02/24 22:58:45 dkf Exp $ */ #ifndef _TCL @@ -697,6 +697,8 @@ typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv)); typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp)); +typedef int (Tcl_PackageUnloadProc) _ANSI_ARGS_((Tcl_Interp *interp, + int flags)); typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(CONST char *, format)); typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData, Tcl_Channel chan, char *address, int port)); @@ -1627,6 +1629,11 @@ typedef struct Tcl_GlobTypeData { #define TCL_GLOB_PERM_W (1<<3) #define TCL_GLOB_PERM_X (1<<4) +/* + * Flags for the unload callback procedure + */ +#define TCL_UNLOAD_DETACH_FROM_INTERPRETER (1<<0) +#define TCL_UNLOAD_DETACH_FROM_PROCESS (1<<1) /* * Typedefs for the various filesystem operations: diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 2334d53..7c5e460 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.96 2004/01/18 16:19:04 dkf Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.97 2004/02/24 22:58:46 dkf Exp $ */ #include "tclInt.h" @@ -166,6 +166,8 @@ static CmdInfo builtInCmds[] = { TclCompileSwitchCmd, 1}, {"trace", (Tcl_CmdProc *) NULL, Tcl_TraceObjCmd, (CompileProc *) NULL, 1}, + {"unload", (Tcl_CmdProc *) NULL, Tcl_UnloadObjCmd, + (CompileProc *) NULL, 1}, {"unset", (Tcl_CmdProc *) NULL, Tcl_UnsetObjCmd, (CompileProc *) NULL, 1}, {"uplevel", (Tcl_CmdProc *) NULL, Tcl_UplevelObjCmd, diff --git a/generic/tclInt.h b/generic/tclInt.h index 6825d08..27dbc89 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.143 2004/01/21 19:59:33 vincentdarley Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.144 2004/02/24 22:58:46 dkf Exp $ */ #ifndef _TCLINT @@ -2005,6 +2005,8 @@ EXTERN int Tcl_TimeObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int Tcl_TraceObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tcl_UnloadObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int Tcl_UnsetObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int Tcl_UpdateObjCmd _ANSI_ARGS_((ClientData clientData, diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 2227e6e..5be526c 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoad.c,v 1.10 2004/02/21 12:48:50 dkf Exp $ + * RCS: @(#) $Id: tclLoad.c,v 1.11 2004/02/24 22:58:48 dkf Exp $ */ #include "tclInt.h" @@ -47,6 +47,18 @@ typedef struct LoadedPackage { * untrusted scripts). NULL means the * package can't be used in unsafe * interpreters. */ + Tcl_PackageUnloadProc *unloadProc; + /* Finalisation procedure to unload a package + * from a trusted interpreter. NULL means + * that the package cannot be unloaded. */ + Tcl_PackageUnloadProc *safeUnloadProc; + /* Finalisation procedure to unload a package + * from a safe interpreter. NULL means + * that the package cannot be unloaded. */ + int interpRefCount; /* How many times the package has been loaded + in trusted interpreters. */ + int safeInterpRefCount; /* How many times the package has been loaded + in safe interpreters. */ Tcl_FSUnloadFileProc *unLoadProcPtr; /* Procedure to use to unload this package. * If NULL, then we do not attempt to unload @@ -119,10 +131,14 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) { Tcl_Interp *target; LoadedPackage *pkgPtr, *defaultPtr; - Tcl_DString pkgName, tmp, initName, safeInitName; - Tcl_PackageInitProc *initProc, *safeInitProc; + Tcl_DString pkgName, tmp, initName, safeInitName, + unloadName, safeUnloadName; + Tcl_PackageInitProc *initProc, *safeInitProc, *unloadProc, *safeUnloadProc; InterpPackage *ipFirstPtr, *ipPtr; int code, namesMatch, filesMatch; + CONST char *symbols[4]; + Tcl_PackageInitProc **procPtrs[4]; + ClientData clientData; char *p, *fullFileName, *packageName; Tcl_LoadHandle loadHandle; Tcl_FSUnloadFileProc *unLoadProcPtr = NULL; @@ -141,6 +157,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) Tcl_DStringInit(&pkgName); Tcl_DStringInit(&initName); Tcl_DStringInit(&safeInitName); + Tcl_DStringInit(&unloadName); + Tcl_DStringInit(&safeUnloadName); Tcl_DStringInit(&tmp); packageName = NULL; @@ -332,21 +350,33 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) Tcl_DStringAppend(&initName, "_Init", 5); Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1); Tcl_DStringAppend(&safeInitName, "_SafeInit", 9); + Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1); + Tcl_DStringAppend(&unloadName, "_Unload", 7); + Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1); + Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11); /* * Call platform-specific code to load the package and find the * two initialization procedures. */ + symbols[0] = Tcl_DStringValue(&initName); + symbols[1] = Tcl_DStringValue(&safeInitName); + symbols[2] = Tcl_DStringValue(&unloadName); + symbols[3] = Tcl_DStringValue(&safeUnloadName); + procPtrs[0] = &initProc; + procPtrs[1] = &safeInitProc; + procPtrs[2] = &unloadProc; + procPtrs[3] = &safeUnloadProc; Tcl_MutexLock(&packageMutex); - code = Tcl_FSLoadFile(interp, objv[1], Tcl_DStringValue(&initName), - Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc, - &loadHandle,&unLoadProcPtr); + code = TclLoadFile(interp, objv[1], 4, symbols, procPtrs, + &loadHandle, &clientData, &unLoadProcPtr); Tcl_MutexUnlock(&packageMutex); + loadHandle = (Tcl_LoadHandle) clientData; if (code != TCL_OK) { goto done; } - if (initProc == NULL) { + if (procPtrs[0] /* initProc */ == NULL) { Tcl_AppendResult(interp, "couldn't find procedure ", Tcl_DStringValue(&initName), (char *) NULL); if (unLoadProcPtr != NULL) { @@ -361,19 +391,23 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) */ pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage)); - pkgPtr->fileName = (char *) ckalloc((unsigned) + pkgPtr->fileName = (char *) ckalloc((unsigned) (strlen(fullFileName) + 1)); strcpy(pkgPtr->fileName, fullFileName); - pkgPtr->packageName = (char *) ckalloc((unsigned) + pkgPtr->packageName = (char *) ckalloc((unsigned) (Tcl_DStringLength(&pkgName) + 1)); strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName)); - pkgPtr->loadHandle = loadHandle; - pkgPtr->unLoadProcPtr = unLoadProcPtr; - pkgPtr->initProc = initProc; - pkgPtr->safeInitProc = safeInitProc; + pkgPtr->loadHandle = loadHandle; + pkgPtr->unLoadProcPtr = unLoadProcPtr; + pkgPtr->initProc = *procPtrs[0]; + pkgPtr->safeInitProc = *procPtrs[1]; + pkgPtr->unloadProc = (Tcl_PackageUnloadProc*) *procPtrs[2]; + pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc*) *procPtrs[3]; + pkgPtr->interpRefCount = 0; + pkgPtr->safeInterpRefCount = 0; Tcl_MutexLock(&packageMutex); - pkgPtr->nextPtr = firstPackagePtr; - firstPackagePtr = pkgPtr; + pkgPtr->nextPtr = firstPackagePtr; + firstPackagePtr = pkgPtr; Tcl_MutexUnlock(&packageMutex); } @@ -404,6 +438,16 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) */ if (code == TCL_OK) { + /* + * Update the proper reference count. + */ + Tcl_MutexLock(&packageMutex); + if (Tcl_IsSafe(target)) { + ++pkgPtr->safeInterpRefCount; + } else { + ++pkgPtr->interpRefCount; + } + Tcl_MutexUnlock(&packageMutex); /* * Refetch ipFirstPtr: loading the package may have introduced * additional static packages at the head of the linked list! @@ -424,6 +468,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) Tcl_DStringFree(&pkgName); Tcl_DStringFree(&initName); Tcl_DStringFree(&safeInitName); + Tcl_DStringFree(&unloadName); + Tcl_DStringFree(&safeUnloadName); Tcl_DStringFree(&tmp); return code; } @@ -431,6 +477,435 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) /* *---------------------------------------------------------------------- * + * Tcl_UnloadObjCmd -- + * + * This procedure is invoked to process the "unload" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_UnloadObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + Tcl_Interp *target; /* Which interpreter to unload from. */ + LoadedPackage *pkgPtr; + LoadedPackage *defaultPtr; + Tcl_DString pkgName; + Tcl_DString tmp; + Tcl_PackageUnloadProc *unloadProc; + InterpPackage *ipFirstPtr; + InterpPackage *ipPtr; + int i; + int index; + int code; + int complain = 1; + int keepLibrary = 0; + int trustedRefCount = -1; + int safeRefCount = -1; + char *fullFileName = ""; + char *packageName; + static CONST char *options[] = { + "-nocomplain", "-keeplibrary", "--", NULL + }; + enum options { + UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST + }; + + for (i = 1; i < objc; i++) { + if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, + &index) != TCL_OK) { + fullFileName = Tcl_GetString(objv[i]); + if (fullFileName[0] == '-') { + /* + * It looks like the command contains an option so signal + * an error + */ + + return TCL_ERROR; + } else { + /* + * This clearly isn't an option; assume it's the + * filename. We must clear the error. + */ + + Tcl_ResetResult(interp); + break; + } + } + switch (index) { + case UNLOAD_NOCOMPLAIN: /* -nocomplain */ + complain = 0; + break; + case UNLOAD_KEEPLIB: /* -keeplibrary */ + keepLibrary = 1; + break; + case UNLOAD_LAST: /* -- */ + i++; + goto endOfForLoop; + } + } + endOfForLoop: + if ((objc-i < 1) || (objc-i > 3)) { + Tcl_WrongNumArgs(interp, 1, objv, + "?switches? fileName ?packageName? ?interp?"); + return TCL_ERROR; + } + if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) { + return TCL_ERROR; + } + + fullFileName = Tcl_GetString(objv[i]); + Tcl_DStringInit(&pkgName); + Tcl_DStringInit(&tmp); + + packageName = NULL; + if (objc - i >= 2) { + packageName = Tcl_GetString(objv[i+1]); + if (packageName[0] == '\0') { + packageName = NULL; + } + } + if ((fullFileName[0] == 0) && (packageName == NULL)) { + Tcl_SetResult(interp, + "must specify either file name or package name", + TCL_STATIC); + code = TCL_ERROR; + goto done; + } + + /* + * Figure out which interpreter we're going to load the package into. + */ + + target = interp; + if (objc - i == 3) { + char *slaveIntName; + slaveIntName = Tcl_GetString(objv[i+2]); + target = Tcl_GetSlave(interp, slaveIntName); + if (target == NULL) { + return TCL_ERROR; + } + } + + /* + * Scan through the packages that are currently loaded to see if the + * package we want is already loaded. We'll use a loaded package if + * it meets any of the following conditions: + * - Its name and file match the once we're looking for. + * - Its file matches, and we weren't given a name. + * - Its name matches, the file name was specified as empty, and there + * is only no statically loaded package with the same name. + */ + + Tcl_MutexLock(&packageMutex); + + defaultPtr = NULL; + for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { + int namesMatch, filesMatch; + + if (packageName == NULL) { + namesMatch = 0; + } else { + Tcl_DStringSetLength(&pkgName, 0); + Tcl_DStringAppend(&pkgName, packageName, -1); + Tcl_DStringSetLength(&tmp, 0); + Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); + Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); + Tcl_UtfToLower(Tcl_DStringValue(&tmp)); + if (strcmp(Tcl_DStringValue(&tmp), + Tcl_DStringValue(&pkgName)) == 0) { + namesMatch = 1; + } else { + namesMatch = 0; + } + } + Tcl_DStringSetLength(&pkgName, 0); + + filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); + if (filesMatch && (namesMatch || (packageName == NULL))) { + break; + } + if (namesMatch && (fullFileName[0] == 0)) { + defaultPtr = pkgPtr; + } + if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { + break; + } + } + Tcl_MutexUnlock(&packageMutex); + if (fullFileName[0] == 0) { + /* + * It's an error to try unload a static package. + */ + + Tcl_AppendResult(interp, "package \"", packageName, + "\" is loaded statically and cannot be unloaded", + (char *) NULL); + code = TCL_ERROR; + goto done; + } + if (pkgPtr == NULL) { + /* + * The DLL pointed by the provided filename has never been + * loaded. + */ + + Tcl_AppendResult(interp, "file \"", fullFileName, + "\" has never been loaded", (char *) NULL); + code = TCL_ERROR; + goto done; + } + + /* + * Scan through the list of packages already loaded in the target + * interpreter. If the package we want is already loaded there, + * then we should proceed with unloading. + */ + + code = TCL_ERROR; + if (pkgPtr != NULL) { + ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", + (Tcl_InterpDeleteProc **) NULL); + for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { + if (ipPtr->pkgPtr == pkgPtr) { + code = TCL_OK; + break; + } + } + } + if (code != TCL_OK) { + /* + * The package has not been loaded in this interpreter. + */ + Tcl_AppendResult(interp, "file \"", fullFileName, + "\" has never been loaded in this interpreter", (char *) NULL); + code = TCL_ERROR; + goto done; + } + + /* + * Ensure that the DLL can be unloaded. If it is a trusted + * interpreter, pkgPtr->unloadProc must not be NULL for the DLL to + * be unloadable. If the interpreter is a safe one, + * pkgPtr->safeUnloadProc must be non-NULL. + */ + + if (Tcl_IsSafe(target)) { + if (pkgPtr->safeUnloadProc == NULL) { + Tcl_AppendResult(interp, "file \"", fullFileName, + "\" cannot be unloaded under a safe interpreter", + (char *) NULL); + code = TCL_ERROR; + goto done; + } + unloadProc = pkgPtr->safeUnloadProc; + } else { + if (pkgPtr->unloadProc == NULL) { + Tcl_AppendResult(interp, "file \"", fullFileName, + "\" cannot be unloaded under a trusted interpreter", + (char *) NULL); + code = TCL_ERROR; + goto done; + } + unloadProc = pkgPtr->unloadProc; + } + + /* + * We are ready to unload the package. First, evaluate the unload + * procedure. If this fails, we cannot proceed with unload. Also, + * we must specify the proper flag to pass to the unload callback. + * TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback + * should only remove itself from the interpreter; the library + * will be unloaded in a future call of unload. In case the + * library will be unloaded just after the callback returns, + * TCL_UNLOAD_DETACH_FROM_PROCESS is passed. + */ + + code = TCL_UNLOAD_DETACH_FROM_INTERPRETER; + if (!keepLibrary) { + Tcl_MutexLock(&packageMutex); + trustedRefCount = pkgPtr->interpRefCount; + safeRefCount = pkgPtr->safeInterpRefCount; + Tcl_MutexUnlock(&packageMutex); + + if (Tcl_IsSafe(target)) { + --safeRefCount; + } else { + --trustedRefCount; + } + + if (safeRefCount <= 0 && trustedRefCount <= 0) { + code = TCL_UNLOAD_DETACH_FROM_PROCESS; + } + } + code = (*unloadProc)(target, code); + if (code != TCL_OK) { + TclTransferResult(target, code, interp); + goto done; + } + + /* + * The unload procedure executed fine. Examine the reference + * count to see if we unload the DLL. + */ + + Tcl_MutexLock(&packageMutex); + if (Tcl_IsSafe(target)) { + --pkgPtr->safeInterpRefCount; + /* + * Do not let counter get negative + */ + if (pkgPtr->safeInterpRefCount < 0) { + pkgPtr->safeInterpRefCount = 0; + } + } else { + --pkgPtr->interpRefCount; + /* + * Do not let counter get negative + */ + if (pkgPtr->interpRefCount < 0) { + pkgPtr->interpRefCount = 0; + } + } + trustedRefCount = pkgPtr->interpRefCount; + safeRefCount = pkgPtr->safeInterpRefCount; + Tcl_MutexUnlock(&packageMutex); + + code = TCL_OK; + if (pkgPtr->safeInterpRefCount <= 0 && pkgPtr->interpRefCount <= 0 + && !keepLibrary) { + /* + * Unload the shared library from the application memory... + */ + +#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__) + /* + * Some Unix dlls are poorly behaved - registering things like + * atexit calls that can't be unregistered. If you unload + * such dlls, you get a core on exit because it wants to call + * a function in the dll after it's been unloaded. + */ + + if (pkgPtr->fileName[0] != '\0') { + Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr; + + if (unLoadProcPtr != NULL) { + Tcl_MutexLock(&packageMutex); + (*unLoadProcPtr)(pkgPtr->loadHandle); + + /* + * Remove this library from the loaded library cache. + */ + + defaultPtr = pkgPtr; + if (defaultPtr == firstPackagePtr) { + firstPackagePtr = pkgPtr->nextPtr; + } else { + for (pkgPtr = firstPackagePtr; pkgPtr != NULL; + pkgPtr = pkgPtr->nextPtr) { + if (pkgPtr->nextPtr == defaultPtr) { + pkgPtr->nextPtr = defaultPtr->nextPtr; + break; + } + } + } + + /* + * Remove this library from the interpreter's library + * cache. + */ + + ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, + "tclLoad", (Tcl_InterpDeleteProc **) NULL); + ipPtr = ipFirstPtr; + if (ipPtr->pkgPtr == defaultPtr) { + ipFirstPtr = ipFirstPtr->nextPtr; + } else { + InterpPackage *ipPrevPtr; + + for (ipPrevPtr = ipPtr; ipPtr != NULL; + ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) { + if (ipPtr->pkgPtr == pkgPtr) { + ipPrevPtr->nextPtr = ipPtr->nextPtr; + break; + } + } + } + Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, + (ClientData) ipFirstPtr); + ckfree(defaultPtr->fileName); + ckfree(defaultPtr->packageName); + ckfree((char *) defaultPtr); + ckfree((char *) ipPtr); + Tcl_MutexUnlock(&packageMutex); + } else { + Tcl_AppendResult(interp, "file \"", fullFileName, + "\" cannot be unloaded: filesystem does not support unloading", + (char *) NULL); + code = TCL_ERROR; + } + } +#else + Tcl_AppendResult(interp, "file \"", fullFileName, + "\" cannot be unloaded: unloading disabled", (char *) NULL); + code = TCL_ERROR; +#endif + } + + done: + Tcl_DStringFree(&pkgName); + Tcl_DStringFree(&tmp); + if (!complain && code!=TCL_OK) { + code = TCL_OK; + Tcl_ResetResult(interp); + } + if (code == TCL_OK) { +#if 0 + /* + * Result of [unload] was not documented in TIP#100, so force + * to be the empty string by commenting this out. DKF. + */ + + Tcl_Obj *resultObjPtr, *objPtr[2]; + + /* + * Our result is the two reference counts. + */ + + objPtr[0] = Tcl_NewIntObj(trustedRefCount); + objPtr[1] = Tcl_NewIntObj(safeRefCount); + if (objPtr[0] == NULL || objPtr[1] == NULL) { + if (objPtr[0]) { + Tcl_DecrRefCount(objPtr[0]); + } + if (objPtr[1]) { + Tcl_DecrRefCount(objPtr[1]); + } + } else { + resultObjPtr = Tcl_NewListObj(2, objPtr); + if (resultObjPtr != NULL) { + Tcl_SetObjResult(interp, resultObjPtr); + } + } +#endif + } + return code; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_StaticPackage -- * * This procedure is invoked to indicate that a particular |