C++ Tcl_GetString函数代码示例

static int
TeststringobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *unicode;
    int varIndex, option, i, length;
#define MAX_STRINGS 11
    const char *index, *string, *strings[MAX_STRINGS+1];
    TestString *strPtr;
    static const char *const options[] = {
	"append", "appendstrings", "get", "get2", "length", "length2",
	"set", "set2", "setlength", "maxchars", "getunicode",
	"appendself", "appendself2", NULL
    };

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    index = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option)
	    != TCL_OK) {
	return TCL_ERROR;
    }
    switch (option) {
	case 0:				/* append */
	    if (objc != 5) {
		goto wrongNumArgs;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[4], &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (varPtr[varIndex] == NULL) {
		SetVarToObj(varIndex, Tcl_NewObj());
	    }

	    /*
	     * If the object bound to variable "varIndex" is shared, we must
	     * "copy on write" and append to a copy of the object.
	     */

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }
	    string = Tcl_GetString(objv[3]);
	    Tcl_AppendToObj(varPtr[varIndex], string, length);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
	case 1:				/* appendstrings */
	    if (objc > (MAX_STRINGS+3)) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] == NULL) {
		SetVarToObj(varIndex, Tcl_NewObj());
	    }

	    /*
	     * If the object bound to variable "varIndex" is shared, we must
	     * "copy on write" and append to a copy of the object.
	     */

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }
	    for (i = 3;  i < objc;  i++) {
		strings[i-3] = Tcl_GetString(objv[i]);
	    }
	    for ( ; i < 12 + 3; i++) {
		strings[i - 3] = NULL;
	    }
	    Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1],
		    strings[2], strings[3], strings[4], strings[5],
		    strings[6], strings[7], strings[8], strings[9],
		    strings[10], strings[11]);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
	case 2:				/* get */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (CheckIfVarUnset(interp, varIndex)) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
	case 3:				/* get2 */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (CheckIfVarUnset(interp, varIndex)) {
		return TCL_ERROR;
//.........这里部分代码省略.........

extern void getLabFromList (LPcmsCIELab Lab,Tcl_Obj **list) {
	Lab->L=atof(Tcl_GetString(list[0]));
	Lab->a=atof(Tcl_GetString(list[1]));
	Lab->b=atof(Tcl_GetString(list[2]));
	return;
}

extern void getLChFromList (LPcmsCIELCh LCh,Tcl_Obj **list) {
	LCh->L=atof(Tcl_GetString(list[0]));
	LCh->C=atof(Tcl_GetString(list[1]));
	LCh->h=atof(Tcl_GetString(list[2]));
	return;
}

//.........这里部分代码省略.........
** list. For each token in the <input-string>, three elements are
** added to the returned list. The first is the token position, the 
** second is the token text (folded, stemmed, etc.) and the third is the
** substring of <input-string> associated with the token. For example, 
** using the built-in "simple" tokenizer:
**
**   SELECT fts_tokenizer_test('simple', 'I don't see how');
**
** will return the string:
**
**   "{0 i I 1 dont don't 2 see see 3 how how}"
**   
*/
static void testFunc(
  sqlite3_context *context,
  int argc,
  sqlite3_value **argv
){
  Fts3Hash *pHash;
  sqlite3_tokenizer_module *p;
  sqlite3_tokenizer *pTokenizer = 0;
  sqlite3_tokenizer_cursor *pCsr = 0;

  const char *zErr = 0;

  const char *zName;
  int nName;
  const char *zInput;
  int nInput;

  const char *zArg = 0;

  const char *zToken;
  int nToken;
  int iStart;
  int iEnd;
  int iPos;

  Tcl_Obj *pRet;

  assert( argc==2 || argc==3 );

  nName = sqlite3_value_bytes(argv[0]);
  zName = (const char *)sqlite3_value_text(argv[0]);
  nInput = sqlite3_value_bytes(argv[argc-1]);
  zInput = (const char *)sqlite3_value_text(argv[argc-1]);

  if( argc==3 ){
    zArg = (const char *)sqlite3_value_text(argv[1]);
  }

  pHash = (Fts3Hash *)sqlite3_user_data(context);
  p = (sqlite3_tokenizer_module *)sqlite3Fts3HashFind(pHash, zName, nName+1);

  if( !p ){
    char *zErr = sqlite3_mprintf("unknown tokenizer: %s", zName);
    sqlite3_result_error(context, zErr, -1);
    sqlite3_free(zErr);
    return;
  }

  pRet = Tcl_NewObj();
  Tcl_IncrRefCount(pRet);

  if( SQLITE_OK!=p->xCreate(zArg ? 1 : 0, &zArg, &pTokenizer) ){
    zErr = "error in xCreate()";
    goto finish;
  }
  pTokenizer->pModule = p;
  if( SQLITE_OK!=p->xOpen(pTokenizer, zInput, nInput, &pCsr) ){
    zErr = "error in xOpen()";
    goto finish;
  }
  pCsr->pTokenizer = pTokenizer;

  while( SQLITE_OK==p->xNext(pCsr, &zToken, &nToken, &iStart, &iEnd, &iPos) ){
    Tcl_ListObjAppendElement(0, pRet, Tcl_NewIntObj(iPos));
    Tcl_ListObjAppendElement(0, pRet, Tcl_NewStringObj(zToken, nToken));
    zToken = &zInput[iStart];
    nToken = iEnd-iStart;
    Tcl_ListObjAppendElement(0, pRet, Tcl_NewStringObj(zToken, nToken));
  }

  if( SQLITE_OK!=p->xClose(pCsr) ){
    zErr = "error in xClose()";
    goto finish;
  }
  if( SQLITE_OK!=p->xDestroy(pTokenizer) ){
    zErr = "error in xDestroy()";
    goto finish;
  }

finish:
  if( zErr ){
    sqlite3_result_error(context, zErr, -1);
  }else{
    sqlite3_result_text(context, Tcl_GetString(pRet), -1, SQLITE_TRANSIENT);
  }
  Tcl_DecrRefCount(pRet);
}

void
Tcl_MainEx(
    int argc,			/* Number of arguments. */
    TCHAR **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc,
				/* Application-specific initialization
				 * function to call after most initialization
				 * but before starting to execute commands. */
    Tcl_Interp *interp)
{
    Tcl_Obj *path, *resultPtr, *argvPtr, *appName, *LObj;
    int commandLen;
    char *commandStr;
    const char *encodingName = NULL;
    int code, exitCode = 0, isL = 0;
    Tcl_MainLoopProc *mainLoopProc;
    Tcl_Channel chan;
    InteractiveState is;

    TclpSetInitialEncodings();
    TclpFindExecutable((const char *)argv[0]);

    Tcl_InitMemory(interp);

    is.interp = interp;
    is.prompt = PROMPT_START;
    is.commandPtr = Tcl_NewObj();

    /*
     * If the application has not already set a startup script, parse the
     * first few command line arguments to determine the script path and
     * encoding.
     */

    if (NULL == Tcl_GetStartupScript(NULL)) {
	/*
	 * Check whether initial args (argv[1] and beyond) look like
	 *  -encoding ENCODING FILENAME
	 * or like
	 *  [-opt1] [-opt2] ... [-optn] FILENAME
	 */

	/* Create argv list obj for L. */
	L->global->tclsh_argc = 1;
	L->global->tclsh_argv = Tcl_NewObj();
	Tcl_ListObjAppendElement(NULL, L->global->tclsh_argv,
				 NewNativeObj(argv[0], -1));

	if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
		&& ('-' != argv[3][0])) {
	    Tcl_Obj *value = NewNativeObj(argv[2], -1);
	    Tcl_SetStartupScript(NewNativeObj(argv[3], -1),
		    Tcl_GetString(value));
	    Tcl_DecrRefCount(value);
	    argc -= 3;
	    argv += 3;
	} else if (argc > 1) {
	    /* Pass over all options to look for a file name. */
	    int i;
	    Tcl_Obj *argObj;
	    for (i = 1; i < argc; ++i) {
		argObj = NewNativeObj(argv[i], -1);
		Tcl_ListObjAppendElement(NULL, L->global->tclsh_argv, argObj);
		++L->global->tclsh_argc;
		if ('-' != argv[i][0]) {
		    Tcl_SetStartupScript(argObj, NULL);
		    argc -= i;
		    argv += i;
		    break;
		} else if (!_tcscmp(argv[i], TEXT("--version")) ||
			   !_tcscmp(argv[i], TEXT("-version"))) {
		    if (strlen(L_VER_TAG)) {
			printf("L version is %s %s for %s\n",
			       L_VER_TAG, L_VER_UTC, L_VER_PLATFORM);
		    } else {
			printf("L version is %s for %s\n",
			       L_VER_UTC, L_VER_PLATFORM);
		    }
		    printf("Built by: %s\n", L_VER_USER);
		    printf("Built in: %s\n", L_VER_PWD);
		    printf("Built on: %s\n", L_VER_BUILD_TIME);
		    exit(0);
		}
	    }
	}
    }

    path = Tcl_GetStartupScript(&encodingName);
    if (path == NULL) {
	appName = NewNativeObj(argv[0], -1);
    } else {
	appName = path;
    }
    Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
    argc--;
    argv++;

    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
    L->global->script_argc = argc;

//.........这里部分代码省略.........

static int
TestfindwindowObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    const TCHAR  *title = NULL, *class = NULL;
    Tcl_DString titleString, classString;
    HWND hwnd = NULL;
    int r = TCL_OK;
    DWORD myPid;

    Tcl_DStringInit(&classString);
    Tcl_DStringInit(&titleString);

    if (objc < 2 || objc > 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "title ?class?");
        return TCL_ERROR;
    }

    title = Tcl_WinUtfToTChar(Tcl_GetString(objv[1]), -1, &titleString);
    if (objc == 3) {
        class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString);
    }
    if (title[0] == 0)
        title = NULL;
#if 0
    hwnd  = FindWindow(class, title);
#else
    /* We want find a window the belongs to us and not some other process */
    hwnd = NULL;
    myPid = GetCurrentProcessId();
    while (1) {
        DWORD pid, tid;
        hwnd = FindWindowEx(NULL, hwnd, class, title);
        if (hwnd == NULL)
            break;
        tid = GetWindowThreadProcessId(hwnd, &pid);
        if (tid == 0) {
            /* Window has gone */
            hwnd = NULL;
            break;
        }
        if (pid == myPid)
            break;              /* Found it */
    }

#endif

    if (hwnd == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1));
	AppendSystemError(interp, GetLastError());
	r = TCL_ERROR;
    } else {
        Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd)));
    }

    Tcl_DStringFree(&titleString);
    Tcl_DStringFree(&classString);
    return r;

}

Pixmap
Tk_AllocBitmapFromObj(
    Tcl_Interp *interp,		/* Interp for error results. This may be
				 * NULL. */
    Tk_Window tkwin,		/* Need the screen the bitmap is used on.*/
    Tcl_Obj *objPtr)		/* Object describing bitmap; see manual entry
				 * for legal syntax of string value. */
{
    TkBitmap *bitmapPtr;

    if (objPtr->typePtr != &tkBitmapObjType) {
	InitBitmapObj(objPtr);
    }
    bitmapPtr = objPtr->internalRep.twoPtrValue.ptr1;

    /*
     * If the object currently points to a TkBitmap, see if it's the one we
     * want. If so, increment its reference count and return.
     */

    if (bitmapPtr != NULL) {
	if (bitmapPtr->resourceRefCount == 0) {
	    /*
	     * This is a stale reference: it refers to a TkBitmap that's no
	     * longer in use. Clear the reference.
	     */

	    FreeBitmapObj(objPtr);
	    bitmapPtr = NULL;
	} else if ((Tk_Display(tkwin) == bitmapPtr->display)
		&& (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum)) {
	    bitmapPtr->resourceRefCount++;
	    return bitmapPtr->bitmap;
	}
    }

    /*
     * The object didn't point to the TkBitmap that we wanted. Search the list
     * of TkBitmaps with the same name to see if one of the others is the
     * right one.
     */

    if (bitmapPtr != NULL) {
	TkBitmap *firstBitmapPtr = Tcl_GetHashValue(bitmapPtr->nameHashPtr);

	FreeBitmapObj(objPtr);
	for (bitmapPtr = firstBitmapPtr; bitmapPtr != NULL;
		bitmapPtr = bitmapPtr->nextPtr) {
	    if ((Tk_Display(tkwin) == bitmapPtr->display) &&
		    (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum)) {
		bitmapPtr->resourceRefCount++;
		bitmapPtr->objRefCount++;
		objPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr;
		return bitmapPtr->bitmap;
	    }
	}
    }

    /*
     * Still no luck. Call GetBitmap to allocate a new TkBitmap object.
     */

    bitmapPtr = GetBitmap(interp, tkwin, Tcl_GetString(objPtr));
    objPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr;
    if (bitmapPtr == NULL) {
	return None;
    }
    bitmapPtr->objRefCount++;
    return bitmapPtr->bitmap;
}

static int
TestobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int varIndex, destIndex, i;
    const char *index, *subCmd, *string;
    const Tcl_ObjType *targetType;

    if (objc < 2) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    subCmd = Tcl_GetString(objv[1]);
    if (strcmp(subCmd, "assign") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	string = Tcl_GetString(objv[3]);
	if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	SetVarToObj(destIndex, varPtr[varIndex]);
	Tcl_SetObjResult(interp, varPtr[destIndex]);
    } else if (strcmp(subCmd, "convert") == 0) {
	const char *typeName;

	if (objc != 4) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	typeName = Tcl_GetString(objv[3]);
	if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		    "no type ", typeName, " found", NULL);
	    return TCL_ERROR;
	}
	if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
		!= TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "duplicate") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	string = Tcl_GetString(objv[3]);
	if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	SetVarToObj(destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	Tcl_SetObjResult(interp, varPtr[destIndex]);
    } else if (strcmp(subCmd, "freeallvars") == 0) {
	if (objc != 2) {
	    goto wrongNumArgs;
	}
	for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	    if (varPtr[i] != NULL) {
		Tcl_DecrRefCount(varPtr[i]);
		varPtr[i] = NULL;
	    }
	}
    } else if (strcmp(subCmd, "invalidateStringRep") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_InvalidateStringRep(varPtr[varIndex]);
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "newobj") == 0) {
//.........这里部分代码省略.........

Tk_Cursor
Tk_AllocCursorFromObj(
    Tcl_Interp *interp,		/* Interp for error results. */
    Tk_Window tkwin,		/* Window in which the cursor will be used.*/
    Tcl_Obj *objPtr)		/* Object describing cursor; see manual entry
				 * for description of legal syntax of this
				 * obj's string rep. */
{
    TkCursor *cursorPtr;

    if (objPtr->typePtr != &tkCursorObjType) {
	InitCursorObj(objPtr);
    }
    cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;

    /*
     * If the object currently points to a TkCursor, see if it's the one we
     * want. If so, increment its reference count and return.
     */

    if (cursorPtr != NULL) {
	if (cursorPtr->resourceRefCount == 0) {
	    /*
	     * This is a stale reference: it refers to a TkCursor that's no
	     * longer in use. Clear the reference.
	     */

	    FreeCursorObjProc(objPtr);
	    cursorPtr = NULL;
	} else if (Tk_Display(tkwin) == cursorPtr->display) {
	    cursorPtr->resourceRefCount++;
	    return cursorPtr->cursor;
	}
    }

    /*
     * The object didn't point to the TkCursor that we wanted. Search the list
     * of TkCursors with the same name to see if one of the other TkCursors is
     * the right one.
     */

    if (cursorPtr != NULL) {
	TkCursor *firstCursorPtr = (TkCursor *)
		Tcl_GetHashValue(cursorPtr->hashPtr);
	FreeCursorObjProc(objPtr);
	for (cursorPtr = firstCursorPtr;  cursorPtr != NULL;
		cursorPtr = cursorPtr->nextPtr) {
	    if (Tk_Display(tkwin) == cursorPtr->display) {
		cursorPtr->resourceRefCount++;
		cursorPtr->objRefCount++;
		objPtr->internalRep.twoPtrValue.ptr1 = (void *) cursorPtr;
		return cursorPtr->cursor;
	    }
	}
    }

    /*
     * Still no luck. Call TkcGetCursor to allocate a new TkCursor object.
     */

    cursorPtr = TkcGetCursor(interp, tkwin, Tcl_GetString(objPtr));
    objPtr->internalRep.twoPtrValue.ptr1 = (void *) cursorPtr;
    if (cursorPtr == NULL) {
	return None;
    }
    cursorPtr->objRefCount++;
    return cursorPtr->cursor;
}

static int
TestintobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int intValue, varIndex, i;
    long longValue;
    const char *index, *subCmd, *string;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    index = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    subCmd = Tcl_GetString(objv[1]);
    if (strcmp(subCmd, "set") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetString(objv[3]);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
	intValue = i;

	/*
	 * If the object currently bound to the variable with index varIndex
	 * has ref count 1 (i.e. the object is unshared) we can modify that
	 * object directly. Otherwise, if RC>1 (i.e. the object is shared), we
	 * must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetString(objv[3]);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
	}
    } else if (strcmp(subCmd, "setlong") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetString(objv[3]);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetLongObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "setmaxlong") == 0) {
	long maxLong = LONG_MAX;
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetLongObj(varPtr[varIndex], maxLong);
	} else {
	    SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
	}
    } else if (strcmp(subCmd, "ismaxlong") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendToObj(Tcl_GetObjResult(interp),
		((longValue == LONG_MAX)? "1" : "0"), -1);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
//.........这里部分代码省略.........

static int
TestlistobjCmd(
    ClientData clientData,	/* Not used */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    /* Subcommands supported by this command */
    const char* subcommands[] = {
	"set",
	"get",
	"replace"
    };
    enum listobjCmdIndex {
	LISTOBJ_SET,
	LISTOBJ_GET,
	LISTOBJ_REPLACE
    };

    const char* index;		/* Argument giving the variable number */
    int varIndex;		/* Variable number converted to binary */
    int cmdIndex;		/* Ordinal number of the subcommand */
    int first;			/* First index in the list */
    int count;			/* Count of elements in a list */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
	return TCL_ERROR;
    }
    index = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
			    0, &cmdIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch(cmdIndex) {
    case LISTOBJ_SET:
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
	} else {
	    SetVarToObj(varIndex, Tcl_NewListObj(objc-3, objv+3));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
	break;

    case LISTOBJ_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
	break;

    case LISTOBJ_REPLACE:
	if (objc < 5) {
	    Tcl_WrongNumArgs(interp, 2, objv,
			     "varIndex start count ?element...?");
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK
	    || Tcl_GetIntFromObj(interp, objv[4], &count) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_IsShared(varPtr[varIndex])) {
	    SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	}
	Tcl_ResetResult(interp);
	return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
				  objc-5, objv+5);
    }
    return TCL_OK;
}

static int
TestindexobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int allowAbbrev, index, index2, setError, i, result;
    const char **argv;
    static const char *const tablePtr[] = {"a", "b", "check", NULL};
    /*
     * Keep this structure declaration in sync with tclIndexObj.c
     */
    struct IndexRep {
	void *tablePtr;		/* Pointer to the table of strings. */
	int offset;		/* Offset between table entries. */
	int index;		/* Selected index into table. */
    };
    struct IndexRep *indexRep;

    if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
	    "check") == 0)) {
	/*
	 * This code checks to be sure that the results of Tcl_GetIndexFromObj
	 * are properly cached in the object and returned on subsequent
	 * lookups.
	 */

	if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
	    return TCL_ERROR;
	}

	Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
	indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
	indexRep->index = index2;
	result = Tcl_GetIndexFromObj(NULL, objv[1],
		tablePtr, "token", 0, &index);
	if (result == TCL_OK) {
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
	}
	return result;
    }

    if (objc < 5) {
	Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1);
	return TCL_ERROR;
    }

    if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
	return TCL_ERROR;
    }

    argv = (const char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetString(objv[i]);
    }
    argv[objc-4] = NULL;

    /*
     * Tcl_GetIndexFromObj assumes that the table is statically-allocated so
     * that its address is different for each index object. If we accidently
     * allocate a table at the same address as that cached in the index
     * object, clear out the object's cached state.
     */

    if (objv[3]->typePtr != NULL
	    && !strcmp("index", objv[3]->typePtr->name)) {
	indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
	if (indexRep->tablePtr == (void *) argv) {
	    objv[3]->typePtr->freeIntRepProc(objv[3]);
	    objv[3]->typePtr = NULL;
	}
    }

    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
	    argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
    ckfree((char *) argv);
    if (result == TCL_OK) {
	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
    }
    return result;
}

static int
TestdoubleobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int varIndex;
    double doubleValue;
    const char *index, *subCmd, *string;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    index = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    subCmd = Tcl_GetString(objv[1]);
    if (strcmp(subCmd, "set") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetString(objv[3]);
	if (Tcl_GetDouble(interp, string, &doubleValue) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * If the object currently bound to the variable with index varIndex
	 * has ref count 1 (i.e. the object is unshared) we can modify that
	 * object directly. Otherwise, if RC>1 (i.e. the object is shared), we
	 * must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue);
	} else {
	    SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "mult10") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
				 &doubleValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue * 10.0);
	} else {
	    SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue * 10.0));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "div10") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
		&doubleValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue / 10.0);
	} else {
	    SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue / 10.0));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": must be set, get, mult10, or div10", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static int
TestbignumobjCmd(
    ClientData clientData,	/* unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Argument count */
    Tcl_Obj *const objv[])	/* Argument vector */
{
    const char *const subcmds[] = {
	"set",	    "get",	"mult10",	"div10", NULL
    };
    enum options {
	BIGNUM_SET, BIGNUM_GET,	BIGNUM_MULT10,	BIGNUM_DIV10
    };
    int index, varIndex;
    const char *string;
    mp_int bignumValue, newValue;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (index) {
    case BIGNUM_SET:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "var value");
	    return TCL_ERROR;
	}
	string = Tcl_GetString(objv[3]);
	if (mp_init(&bignumValue) != MP_OKAY) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("error in mp_init", -1));
	    return TCL_ERROR;
	}
	if (mp_read_radix(&bignumValue, string, 10) != MP_OKAY) {
	    mp_clear(&bignumValue);
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("error in mp_read_radix", -1));
	    return TCL_ERROR;
	}

	/*
	 * If the object currently bound to the variable with index varIndex
	 * has ref count 1 (i.e. the object is unshared) we can modify that
	 * object directly.  Otherwise, if RC>1 (i.e. the object is shared),
	 * we must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
	} else {
	    SetVarToObj(varIndex, Tcl_NewBignumObj(&bignumValue));
	}
	break;

    case BIGNUM_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	break;

    case BIGNUM_MULT10:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
		&bignumValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (mp_init(&newValue) != MP_OKAY
		|| (mp_mul_d(&bignumValue, 10, &newValue) != MP_OKAY)) {
	    mp_clear(&bignumValue);
	    mp_clear(&newValue);
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("error in mp_mul_d", -1));
	    return TCL_ERROR;
	}
	mp_clear(&bignumValue);
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
	} else {
	    SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
	}
//.........这里部分代码省略.........

	/* ARGSUSED */
int
Tcl_ThreadObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int option;
    static const char *threadOptions[] = {
	"create", "exit", "id", "join", "names",
	"send", "wait", "errorproc", NULL
    };
    enum options {
	THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES,
	THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
	    &option) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Make sure the initial thread is on the list before doing anything.
     */

    if (tsdPtr->interp == NULL) {
	Tcl_MutexLock(&threadMutex);
	tsdPtr->interp = interp;
	ListUpdateInner(tsdPtr);
	Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
	Tcl_MutexUnlock(&threadMutex);
    }

    switch ((enum options)option) {
    case THREAD_CREATE: {
	char *script;
	int joinable, len;

	if (objc == 2) {
	    /*
	     * Neither joinable nor special script
	     */

	    joinable = 0;
	    script = "testthread wait";		/* Just enter event loop */
	} else if (objc == 3) {
	    /*
	     * Possibly -joinable, then no special script, no joinable, then
	     * its a script.
	     */

	    script = Tcl_GetStringFromObj(objv[2], &len);

	    if ((len > 1) &&
		    (script [0] == '-') && (script [1] == 'j') &&
		    (0 == strncmp (script, "-joinable", (size_t) len))) {
		joinable = 1;
		script = "testthread wait";	/* Just enter event loop */
	    } else {
		/*
		 * Remember the script
		 */

		joinable = 0;
	    }
	} else if (objc == 4) {
	    /*
	     * Definitely a script available, but is the flag -joinable?
	     */

	    script = Tcl_GetStringFromObj(objv[2], &len);

	    joinable = ((len > 1) &&
		    (script [0] == '-') && (script [1] == 'j') &&
		    (0 == strncmp(script, "-joinable", (size_t) len)));

	    script = Tcl_GetString(objv[3]);
	} else {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
	    return TCL_ERROR;
	}
	return TclCreateThread(interp, script, joinable);
    }
    case THREAD_EXIT:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	ListRemove(NULL);
	Tcl_ExitThread(0);
	return TCL_OK;
    case THREAD_ID:
	if (objc == 2) {
//.........这里部分代码省略.........