tcl/tkコードリーディング

TclInitSubsystems

2011-11-10T22:18:07+09:00

* 概要 Tcl内部のサブシステムの初期化 [[generic/tclEvent.c>tcl/generic/tclEvent.c]] * 引数無し * 戻り値無し * 処理　&color(green){inFinalizeが0でなければTclPanicを呼び出す} 　if (inFinalize != 0) { 　　[[Tcl_Panic]]("TclInitSubsystems called while finalizing"); 　} 　&color(green){subsystemsInitialized が0の時初期化を行う} 　if (subsystemsInitialized == 0) { 　　&color(green){TclInitLockでLockに使用する変数の初期化を行い、initLockを使ってクリティカルセクションに入る。} 　　[[TclpInitLock]](); if (subsystemsInitialized == 0) { /* * Have to set this bit here to avoid deadlock with the routines * below us that call into TclInitSubsystems. */ subsystemsInitialized = 1; /* * Initialize locks used by the memory allocators before anything * interesting happens so we can use the allocators in the * implementation of self-initializing locks. */ TclInitThreadStorage(); /* Creates master hash table for * thread local storage */ #if USE_TCLALLOC TclInitAlloc(); /* Process wide mutex init */ #endif #ifdef TCL_MEM_DEBUG TclInitDbCkalloc(); /* Process wide mutex init */ #endif TclpInitPlatform(); /* Creates signal handler(s) */ TclInitDoubleConversion(); /* Initializes constants for * converting to/from double. */ TclInitObjSubsystem(); /* Register obj types, create * mutexes. */ TclInitIOSubsystem(); /* Inits a tsd key (noop). */ TclInitEncodingSubsystem(); /* Process wide encoding init. */ TclpSetInterfaces(); TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ } TclpInitUnlock(); } TclInitNotifier(); } * ソース TclInitSubsystems(void) { if (inFinalize != 0) { Tcl_Panic("TclInitSubsystems called while finalizing"); } if (subsystemsInitialized == 0) { /* * Double check inside the mutex. There are definitly calls back into * this routine from some of the functions below. */ TclpInitLock(); if (subsystemsInitialized == 0) { /* * Have to set this bit here to avoid deadlock with the routines * below us that call into TclInitSubsystems. */ subsystemsInitialized = 1; /* * Initialize locks used by the memory allocators before anything * interesting happens so we can use the allocators in the * implementation of self-initializing locks. */ TclInitThreadStorage(); /* Creates master hash table for * thread local storage */ #if USE_TCLALLOC TclInitAlloc(); /* Process wide mutex init */ #endif #ifdef TCL_MEM_DEBUG TclInitDbCkalloc(); /* Process wide mutex init */ #endif TclpInitPlatform(); /* Creates signal handler(s) */ TclInitDoubleConversion(); /* Initializes constants for * converting to/from double. */ TclInitObjSubsystem(); /* Register obj types, create * mutexes. */ TclInitIOSubsystem(); /* Inits a tsd key (noop). */ TclInitEncodingSubsystem(); /* Process wide encoding init. */ TclpSetInterfaces(); TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ } TclpInitUnlock(); } TclInitNotifier(); }

tcl/win/tclWinThrd.c

2011-11-10T22:16:16+09:00

* 概要 * include #include "tclWinInt.h" #include * 変数宣言 /* * This is the master lock used to serialize access to other serialization * data structures. */ static CRITICAL_SECTION masterLock; static int init = 0; #define MASTER_LOCK TclpMasterLock() #define MASTER_UNLOCK TclpMasterUnlock() /* * This is the master lock used to serialize initialization and finalization * of Tcl as a whole. */ static CRITICAL_SECTION initLock; /* * allocLock is used by Tcl's version of malloc for synchronization. For * obvious reasons, cannot use any dyamically allocated storage. */ #ifdef TCL_THREADS static struct Tcl_Mutex_ { CRITICAL_SECTION crit; } allocLock; static Tcl_Mutex allocLockPtr = &allocLock; static int allocOnce = 0; #endif /* TCL_THREADS */ /* * The joinLock serializes Create- and ExitThread. This is necessary to * prevent a race where a new joinable thread exits before the creating thread * had the time to create the necessary data structures in the emulation * layer. */ static CRITICAL_SECTION joinLock; /* * Condition variables are implemented with a combination of a per-thread * Windows Event and a per-condition waiting queue. The idea is that each * thread has its own Event that it waits on when it is doing a ConditionWait; * it uses the same event for all condition variables because it only waits on * one at a time. Each condition variable has a queue of waiting threads, and * a mutex used to serialize access to this queue. * * Special thanks to David Nichols and Jim Davidson for advice on the * Condition Variable implementation. */ /* * The per-thread event and queue pointers. */ #ifdef TCL_THREADS typedef struct ThreadSpecificData { HANDLE condEvent; /* Per-thread condition event */ struct ThreadSpecificData *nextPtr; /* Queue pointers */ struct ThreadSpecificData *prevPtr; int flags; /* See flags below */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #endif /* TCL_THREADS */ /* * State bits for the thread. * WIN_THREAD_UNINIT Uninitialized. Must be zero because of the way * ThreadSpecificData is created. * WIN_THREAD_RUNNING Running, not waiting. * WIN_THREAD_BLOCKED Waiting, or trying to wait. */ #define WIN_THREAD_UNINIT 0x0 #define WIN_THREAD_RUNNING 0x1 #define WIN_THREAD_BLOCKED 0x2 /* * The per condition queue pointers and the Mutex used to serialize access to * the queue. */ typedef struct WinCondition { CRITICAL_SECTION condLock; /* Lock to serialize queuing on the * condition. */ struct ThreadSpecificData *firstPtr; /* Queue pointers */ struct ThreadSpecificData *lastPtr; } WinCondition; /* * Additions by AOL for specialized thread memory allocator. */ #ifdef USE_THREAD_ALLOC static int once; static DWORD tlsKey; typedef struct allocMutex { Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; #endif /* USE_THREAD_ALLOC */ * 関数 [[TclpThreadCreate]] [[Tcl_JoinThread]] [[TclpThreadExit]] [[Tcl_GetCurrentThread]] &tt(){[DONE]}[[[TclpInitLock]] [[TclpInitUnlock]] [[TclpMasterLock]] [[TclpMasterUnlock]] [[Tcl_GetAllocMutex]] [[TclFinalizeLock]] [[FinalizeConditionEvent]] [[Tcl_MutexLock]] [[Tcl_MutexUnlock]] [[TclpFinalizeMutex]] [[Tcl_ConditionWait]] [[Tcl_ConditionNotify]] [[FinalizeConditionEvent]] [[TclpFinalizeCondition]] [[TclpNewAllocMutex]] [[TclpFreeAllocMutex]] [[TclpGetAllocCache]] [[TclpSetAllocCache]] [[TclpFreeAllocCache]]

TclpInitLock

2011-11-10T22:14:31+09:00

* 概要 Win32APIを使って、joinLock, initLock, masterLock の変数を初期化する。 initLockを使ってクリティカルセクションに入って関数を抜ける。 [[tcl/win/tclWinThrd.c]] * 引数無し * 戻り値無し。 * 処理　&color(green){initが0でないとき、初期化処理を行う} 　if (!init) { 　　&color(green){initを1に} 　　init = 1; 　　&color(green){joinLock, initLock, masterLock を InitializeCriticalSection で初期化する。InitializeCriticalSectionはWindows API} 　　[[InitializeCriticalSection>http://msdn.microsoft.com/ja-jp/library/cc429223.aspx]](&joinLock); 　　[[InitializeCriticalSection>http://msdn.microsoft.com/ja-jp/library/cc429223.aspx]](&initLock); 　　[[InitializeCriticalSection>http://msdn.microsoft.com/ja-jp/library/cc429223.aspx]](&masterLock); 　} 　&color(green){initLockを使ってクリティカルセクションに入る。} 　[[EnterCriticalSection>http://msdn.microsoft.com/ja-jp/library/cc429095.aspx]](&initLock); * ソース /* *---------------------------------------------------------------------- * * TclpInitLock * * This procedure is used to grab a lock that serializes initialization * and finalization of Tcl. On some platforms this may also initialize * the mutex used to serialize creation of more mutexes and thread local * storage keys. * * Results: * None. * * Side effects: * Acquire the initialization mutex. * *---------------------------------------------------------------------- */ void TclpInitLock(void) { if (!init) { /* * There is a fundamental race here that is solved by creating the * first Tcl interpreter in a single threaded environment. Once the * interpreter has been created, it is safe to create more threads * that create interpreters in parallel. */ init = 1; InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); InitializeCriticalSection(&masterLock); } EnterCriticalSection(&initLock); }

tcl 8.5.10のファイル一覧

2011-11-10T21:58:50+09:00

compat/dirent.h compat/dirent2.h compat/dlfcn.h compat/fixstrtod.c compat/float.h compat/gettod.c compat/limits.h compat/memcmp.c compat/opendir.c compat/stdlib.h compat/string.h compat/strncasecmp.c compat/strstr.c compat/strtod.c compat/strtol.c compat/strtoul.c compat/unistd.h compat/waitpid.c generic/regc_color.c generic/regc_cvec.c generic/regc_lex.c generic/regc_locale.c generic/regc_nfa.c generic/regcomp.c generic/regcustom.h generic/rege_dfa.c generic/regerror.c generic/regerrs.h generic/regex.h generic/regexec.c generic/regfree.c generic/regfronts.c generic/regguts.h generic/tcl.h generic/tclAlloc.c generic/tclAsync.c [[generic/tclBasic.c>tcl/generic/tclBasic.c]] generic/tclBinary.c generic/tclCkalloc.c generic/tclClock.c generic/tclCmdAH.c generic/tclCmdIL.c generic/tclCmdMZ.c generic/tclCompCmds.c generic/tclCompExpr.c generic/tclCompile.c generic/tclCompile.h generic/tclConfig.c generic/tclDate.c generic/tclDecls.h generic/tclDictObj.c generic/tclEncoding.c generic/tclEnv.c [[generic/tclEvent.c>tcl/generic/tclEvent.c]] generic/tclExecute.c generic/tclFCmd.c generic/tclFileName.c generic/tclFileSystem.h generic/tclGet.c generic/tclHash.c generic/tclHistory.c generic/tclIO.c generic/tclIO.h generic/tclIOCmd.c generic/tclIOGT.c generic/tclIORChan.c generic/tclIOSock.c generic/tclIOUtil.c generic/tclIndexObj.c generic/tclInt.h generic/tclIntDecls.h generic/tclIntPlatDecls.h [[generic/tclInterp.c>tcl/generic/tclInterp.c]] generic/tclLink.c generic/tclListObj.c generic/tclLiteral.c generic/tclLoad.c generic/tclLoadNone.c generic/tclMain.c generic/tclNamesp.c generic/tclNotify.c generic/tclObj.c [[generic/tclPanic.c>tcl/generic/tclPanic.c]] generic/tclParse.c generic/tclPathObj.c generic/tclPipe.c generic/tclPkg.c generic/tclPkgConfig.c generic/tclPlatDecls.h generic/tclPort.h generic/tclPosixStr.c generic/tclPreserve.c generic/tclProc.c generic/tclRegexp.c generic/tclRegexp.h generic/tclResolve.c generic/tclResult.c generic/tclScan.c generic/tclStrToD.c generic/tclStringObj.c generic/tclStubInit.c generic/tclStubLib.c generic/tclTest.c generic/tclTestObj.c generic/tclTestProcBodyObj.c generic/tclThread.c generic/tclThreadAlloc.c generic/tclThreadJoin.c generic/tclThreadStorage.c generic/tclThreadTest.c generic/tclTimer.c generic/tclTomMath.h generic/tclTomMathDecls.h generic/tclTomMathInt.h generic/tclTomMathInterface.c generic/tclTrace.c generic/tclUniData.c generic/tclUtf.c generic/tclUtil.c generic/tclVar.c generic/tommath.h libtommath/bn_fast_s_mp_mul_digs.c libtommath/bn_fast_s_mp_sqr.c libtommath/bn_mp_add.c libtommath/bn_mp_add_d.c libtommath/bn_mp_and.c libtommath/bn_mp_clamp.c libtommath/bn_mp_clear.c libtommath/bn_mp_clear_multi.c libtommath/bn_mp_cmp.c libtommath/bn_mp_cmp_d.c libtommath/bn_mp_cmp_mag.c libtommath/bn_mp_copy.c libtommath/bn_mp_count_bits.c libtommath/bn_mp_div.c libtommath/bn_mp_div_2.c libtommath/bn_mp_div_2d.c libtommath/bn_mp_div_3.c libtommath/bn_mp_div_d.c libtommath/bn_mp_exch.c libtommath/bn_mp_expt_d.c libtommath/bn_mp_grow.c libtommath/bn_mp_init.c libtommath/bn_mp_init_copy.c libtommath/bn_mp_init_multi.c libtommath/bn_mp_init_set.c libtommath/bn_mp_init_set_int.c libtommath/bn_mp_init_size.c libtommath/bn_mp_karatsuba_mul.c libtommath/bn_mp_karatsuba_sqr.c libtommath/bn_mp_lshd.c libtommath/bn_mp_mod.c libtommath/bn_mp_mod_2d.c libtommath/bn_mp_mul.c libtommath/bn_mp_mul_2.c libtommath/bn_mp_mul_2d.c libtommath/bn_mp_mul_d.c libtommath/bn_mp_neg.c libtommath/bn_mp_or.c libtommath/bn_mp_radix_size.c libtommath/bn_mp_radix_smap.c libtommath/bn_mp_read_radix.c libtommath/bn_mp_rshd.c libtommath/bn_mp_set.c libtommath/bn_mp_set_int.c libtommath/bn_mp_shrink.c libtommath/bn_mp_sqr.c libtommath/bn_mp_sqrt.c libtommath/bn_mp_sub.c libtommath/bn_mp_sub_d.c libtommath/bn_mp_to_unsigned_bin.c libtommath/bn_mp_to_unsigned_bin_n.c libtommath/bn_mp_toom_mul.c libtommath/bn_mp_toom_sqr.c libtommath/bn_mp_toradix_n.c libtommath/bn_mp_unsigned_bin_size.c libtommath/bn_mp_xor.c libtommath/bn_mp_zero.c libtommath/bn_reverse.c libtommath/bn_s_mp_add.c libtommath/bn_s_mp_mul_digs.c libtommath/bn_s_mp_sqr.c libtommath/bn_s_mp_sub.c libtommath/bncore.c libtommath/tommath.h libtommath/tommath_class.h libtommath/tommath_superclass.h macosx/tclMacOSXBundle.c macosx/tclMacOSXFCmd.c macosx/tclMacOSXNotify.c tools/man2tcl.c unix/tclAppInit.c unix/tclLoadAix.c unix/tclLoadDl.c unix/tclLoadDyld.c unix/tclLoadNext.c unix/tclLoadOSF.c unix/tclLoadShl.c unix/tclUnixChan.c unix/tclUnixCompat.c unix/tclUnixEvent.c unix/tclUnixFCmd.c unix/tclUnixFile.c unix/tclUnixInit.c unix/tclUnixNotfy.c unix/tclUnixPipe.c unix/tclUnixPort.h unix/tclUnixSock.c unix/tclUnixTest.c unix/tclUnixThrd.c unix/tclUnixThrd.h unix/tclUnixTime.c unix/tclXtNotify.c unix/tclXtTest.c win/cat.c win/nmakehlp.c win/stub16.c win/tclAppInit.c win/tclWin32Dll.c win/tclWinChan.c win/tclWinConsole.c win/tclWinDde.c win/tclWinError.c win/tclWinFCmd.c win/tclWinFile.c win/tclWinInit.c win/tclWinInt.h win/tclWinLoad.c win/tclWinNotify.c win/tclWinPipe.c win/tclWinPort.h win/tclWinReg.c win/tclWinSerial.c win/tclWinSock.c win/tclWinTest.c [[win/tclWinThrd.c>tcl/win/tclWinThrd.c]] win/tclWinThrd.h win/tclWinTime.c

Tcl_Panic

2011-11-10T21:47:16+09:00

* 概要 tclStubsPtr->tcl_Panicの呼び出し [tcl/generic/tclDecls.h] *ソース #ifndef Tcl_Panic #define Tcl_Panic \ (tclStubsPtr->tcl_Panic) /* 2 */

tcl/generic/tclEvent.c

2011-11-10T21:36:32+09:00

* 概要 * inlude "tclInt.h" * 変数宣言 /* * The data structure below is used to report background errors. One such * structure is allocated for each error; it holds information about the * interpreter and the error until an idle handler command can be invoked. */ typedef struct BgError { [[Tcl_Obj]] *errorMsg; /* Copy of the error message (the interp's * result when the error occurred). */ Tcl_Obj *returnOpts; /* Active return options when the error * occurred */ struct BgError *nextPtr; /* Next in list of all pending error reports * for this interpreter, or NULL for end of * list. */ } BgError; /* * One of the structures below is associated with the "tclBgError" assoc data * for each interpreter. It keeps track of the head and tail of the list of * pending background errors for the interpreter. */ typedef struct ErrAssocData { [[Tcl_Interp]] *interp; /* Interpreter in which error occurred. */ Tcl_Obj *cmdPrefix; /* First word(s) of the handler command */ BgError *firstBgPtr; /* First in list of all background errors * waiting to be processed for this * interpreter (NULL if none). */ BgError *lastBgPtr; /* Last in list of all background errors * waiting to be processed for this * interpreter (NULL if none). */ } ErrAssocData; /* * For each exit handler created with a call to Tcl_Create(Late)ExitHandler there is * a structure of the following type: */ typedef struct ExitHandler { Tcl_ExitProc *proc; /* Function to call when process exits. */ [[ClientData]] clientData; /* One word of information to pass to proc. */ struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this * application, or NULL for end of list. */ } ExitHandler; /* * There is both per-process and per-thread exit handlers. The first list is * controlled by a mutex. The other is in thread local storage. */ static ExitHandler *firstExitPtr = NULL; /* First in list of all exit handlers for * application. */ static ExitHandler *firstLateExitPtr = NULL; /* First in list of all late exit handlers for * application. */ TCL_DECLARE_MUTEX(exitMutex) /* * This variable is set to 1 when Tcl_Finalize is called, and at the end of * its work, it is reset to 0. The variable is checked by TclInExit() to allow * different behavior for exit-time processing, e.g. in closing of files and * pipes. */ static int inFinalize = 0; static int subsystemsInitialized = 0; /* * This variable contains the application wide exit handler. It will be * called by Tcl_Exit instead of the C-runtime exit if this variable is set * to a non-NULL value. */ static Tcl_ExitProc *appExitPtr = NULL; typedef struct ThreadSpecificData { ExitHandler *firstExitPtr; /* First in list of all exit handlers for this * thread. */ int inExit; /* True when this thread is exiting. This is * used as a hack to decide to close the * standard channels. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #ifdef TCL_THREADS typedef struct { Tcl_ThreadCreateProc *proc; /* Main() function of the thread */ ClientData clientData; /* The one argument to Main() */ } ThreadClientData; static Tcl_ThreadCreateType NewThreadProc(ClientData clientData); #endif /* TCL_THREADS */ * 関数 [[BgErrorDeleteProc]] [[HandleBgErrors]] [[VwaitVarProc]] [[Tcl_BackgroundError]] [[TclBackgroundException]] [[HandleBgErrors]] [[TclDefaultBgErrorHandlerObjCmd]] [[TclSetBgErrorHandler]] [[TclGetBgErrorHandler]] [[BgErrorDeleteProc]] [[TclCreateLateExitHandler]] [[Tcl_DeleteExitHandler]] [[TclDeleteLateExitHandler]] [[Tcl_CreateThreadExitHandler]] [[Tcl_DeleteThreadExitHandler]] [[Tcl_SetExitProc]] [[Tcl_Exit]] [[TclInitSubsystems]] [[Tcl_Finalize]] [[Tcl_FinalizeThread]] [[TclInExit]] [[TclInThreadExit]] [[Tcl_VwaitObjCmd]] [[Tcl_UpdateObjCmd]] [[NewThreadProc]] [[Tcl_CreateThread]]

Tcl_CreateInterp

2011-11-10T21:26:35+09:00

* 概要 TCLインタープリタの生成 [[tcl/generic/tclBasic.c>tcl/generic/tclBasic.c]] * 引数無し * 戻り値 [[Tcl_Interp]]* 生成したTCLインタープリタへのポインタ０ * 処理　変数宣言　[[Interp]] *iPtr; 　[[Tcl_Interp]] *interp; 　[[Command]] *cmdPtr; 　const [[BuiltinFuncDef]] *builtinFuncPtr; 　const [[OpCmdInfo]] *opcmdInfoPtr; 　const [[CmdInfo]] *cmdInfoPtr; 　[[Tcl_Namespace]] *mathfuncNSPtr, *mathopNSPtr; 　union { 　　char c[sizeof(short)]; 　　short s; 　} order; 　[[ByteCodeStats]] *statsPtr; 　char mathFuncName[32]; 　[[CallFrame]] *framePtr; 　int result; 　[[TclInitSubsystems]](); /* * Panic if someone updated the CallFrame structure without also updating * the Tcl_CallFrame structure (or vice versa). */ if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) { /*NOTREACHED*/ [[Tcl_Panic]]("Tcl_CallFrame must not be smaller than CallFrame"); } /* * Initialize support for namespaces and create the global namespace * (whose name is ""; an alias is "::"). This also initializes the Tcl * object type table and other object management code. */ iPtr = (Interp *) ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; iPtr->result = iPtr->resultSpace; iPtr->freeProc = NULL; iPtr->errorLine = 0; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); iPtr->globalNsPtr = NULL; iPtr->hiddenCmdTablePtr = NULL; iPtr->interpInfo = NULL; iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; iPtr->framePtr = NULL; /* Initialise as soon as :: is available */ iPtr->varFramePtr = NULL; /* Initialise as soon as :: is available */ /* * TIP #280 - Initialize the arrays used to extend the ByteCode and * Proc structures. */ iPtr->cmdFramePtr = NULL; iPtr->linePBodyPtr = ([[Tcl_HashTable]] *) ckalloc(sizeof(Tcl_HashTable)); iPtr->lineBCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); iPtr->lineLAPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable)); iPtr->lineLABCPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable)); Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); iPtr->scriptCLLocPtr = NULL; iPtr->activeVarTracePtr = NULL; iPtr->returnOpts = NULL; iPtr->errorInfo = NULL; TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo"); Tcl_IncrRefCount(iPtr->eiVar); iPtr->errorCode = NULL; TclNewLiteralStringObj(iPtr->ecVar, "::errorCode"); Tcl_IncrRefCount(iPtr->ecVar); iPtr->returnLevel = 1; iPtr->returnCode = TCL_OK; iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; iPtr->appendResult = NULL; iPtr->appendAvl = 0; iPtr->appendUsed = 0; Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; /* TIP #268 */ if (getenv("TCL_PKG_PREFER_LATEST") == NULL) { iPtr->packagePrefer = PKG_PREFER_STABLE; } else { iPtr->packagePrefer = PKG_PREFER_LATEST; } iPtr->cmdCount = 0; TclInitLiteralTable(&(iPtr->literalTable)); iPtr->compileEpoch = 0; iPtr->compiledProcPtr = NULL; iPtr->resolverPtr = NULL; iPtr->evalFlags = 0; iPtr->scriptFile = NULL; iPtr->flags = 0; iPtr->tracePtr = NULL; iPtr->tracesForbiddingInline = 0; iPtr->activeCmdTracePtr = NULL; iPtr->activeInterpTracePtr = NULL; iPtr->assocData = NULL; iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */ iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); iPtr->resultSpace[0] = 0; iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ #ifdef TCL_INTERP_DEBUG_FRAME iPtr->flags |= INTERP_DEBUG_FRAME; #else if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) { iPtr->flags |= INTERP_DEBUG_FRAME; } #endif /* * Initialise the tables for variable traces and searches *before* * creating the global ns - so that the trace on errorInfo can be * recorded. */ Tcl_InitHashTable(&iPtr->varTraces, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(&iPtr->varSearches, TCL_ONE_WORD_KEYS); iPtr->globalNsPtr = NULL; /* Force creation of global ns below. */ iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "", NULL, NULL); if (iPtr->globalNsPtr == NULL) { Tcl_Panic("Tcl_CreateInterp: can't create global namespace"); } /* * Initialise the rootCallframe. It cannot be allocated on the stack, as * it has to be in place before TclCreateExecEnv tries to use a variable. */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ framePtr = (CallFrame *) ckalloc(sizeof(CallFrame)); result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0); if (result != TCL_OK) { Tcl_Panic("Tcl_CreateInterp: failed to push the root stack frame"); } framePtr->objc = 0; iPtr->framePtr = framePtr; iPtr->varFramePtr = framePtr; iPtr->rootFramePtr = framePtr; /* * Initialize support for code compilation and execution. We call * TclCreateExecEnv after initializing namespaces since it tries to * reference a Tcl variable (it links to the Tcl "tcl_traceExec" * variable). */ iPtr->execEnvPtr = TclCreateExecEnv(interp); /* * TIP #219, Tcl Channel Reflection API support. */ iPtr->chanMsg = NULL; /* * Initialize the compilation and execution statistics kept for this * interpreter. */ #ifdef TCL_COMPILE_STATS statsPtr = &(iPtr->stats); statsPtr->numExecutions = 0; statsPtr->numCompilations = 0; statsPtr->numByteCodesFreed = 0; (void) memset(statsPtr->instructionCount, 0, sizeof(statsPtr->instructionCount)); statsPtr->totalSrcBytes = 0.0; statsPtr->totalByteCodeBytes = 0.0; statsPtr->currentSrcBytes = 0.0; statsPtr->currentByteCodeBytes = 0.0; (void) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount)); (void) memset(statsPtr->byteCodeCount, 0, sizeof(statsPtr->byteCodeCount)); (void) memset(statsPtr->lifetimeCount, 0, sizeof(statsPtr->lifetimeCount)); statsPtr->currentInstBytes = 0.0; statsPtr->currentLitBytes = 0.0; statsPtr->currentExceptBytes = 0.0; statsPtr->currentAuxBytes = 0.0; statsPtr->currentCmdMapBytes = 0.0; statsPtr->numLiteralsCreated = 0; statsPtr->totalLitStringBytes = 0.0; statsPtr->currentLitStringBytes = 0.0; (void) memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount)); #endif /* TCL_COMPILE_STATS */ /* * Initialise the stub table pointer. */ iPtr->stubTable = &tclStubs; /* * Initialize the ensemble error message rewriting support. */ iPtr->ensembleRewrite.sourceObjs = NULL; iPtr->ensembleRewrite.numRemovedObjs = 0; iPtr->ensembleRewrite.numInsertedObjs = 0; /* * TIP#143: Initialise the resource limit support. */ TclInitLimitSupport(interp); /* * Initialise the thread-specific data ekeko. */ #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) iPtr->allocCache = TclpGetAllocCache(); #else iPtr->allocCache = NULL; #endif iPtr->pendingObjDataPtr = NULL; iPtr->asyncReadyPtr = TclGetAsyncReadyPtr(); /* * Insure that the stack checking mechanism for this interp is * initialized. */ GetCStackParams(iPtr); /* * Create the core commands. Do it here, rather than calling * Tcl_CreateCommand, because it's faster (there's no need to check for a * pre-existing command by the same name). If a command has a Tcl_CmdProc * but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to * TclInvokeStringCommand. This is an object-based wrapper function that * extracts strings, calls the string function, and creates an object for * the result. Similarly, if a command has a Tcl_ObjCmdProc but no * Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand. */ for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { int isNew; [[Tcl_HashEntry]] *hPtr; if ((cmdInfoPtr->objProc == NULL) && (cmdInfoPtr->compileProc == NULL)) { Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc"); } hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { cmdPtr = (Command *) ckalloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; cmdPtr->compileProc = cmdInfoPtr->compileProc; cmdPtr->proc = TclInvokeObjectCommand; cmdPtr->clientData = cmdPtr; cmdPtr->objProc = cmdInfoPtr->objProc; cmdPtr->objClientData = NULL; cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; Tcl_SetHashValue(hPtr, cmdPtr); } } /* * Create the "chan", "dict", "info" and "string" ensembles. Note that all * these commands (and their subcommands that are not present in the * global namespace) are wholly safe. */ TclInitChanCmd(interp); TclInitDictCmd(interp); TclInitInfoCmd(interp); TclInitStringCmd(interp); /* * Register "clock" subcommands. These *do* go through * Tcl_CreateObjCommand, since they aren't in the global namespace and * involve ensembles. */ TclClockInit(interp); /* * Register the built-in functions. This is empty now that they are * implemented as commands in the ::tcl::mathfunc namespace. */ /* * Register the default [interp bgerror] handler. */ Tcl_CreateObjCommand(interp, "::tcl::Bgerror", TclDefaultBgErrorHandlerObjCmd, NULL, NULL); /* * Create an unsupported command for debugging bytecode. */ Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble", Tcl_DisassembleObjCmd, NULL, NULL); #ifdef USE_DTRACE /* * Register the tcl::dtrace command. */ Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL); #endif /* USE_DTRACE */ /* * Register the builtin math functions. */ mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL); if (mathfuncNSPtr == NULL) { Tcl_Panic("Can't create math function namespace"); } strcpy(mathFuncName, "::tcl::mathfunc::"); #define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */ for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL; builtinFuncPtr++) { strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL); Tcl_Export(interp, mathfuncNSPtr, builtinFuncPtr->name, 0); } /* * Register the mathematical "operator" commands. [TIP #174] */ mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL); #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ if (mathopNSPtr == NULL) { Tcl_Panic("can't create math operator namespace"); } (void) Tcl_Export(interp, mathopNSPtr, "*", 1); strcpy(mathFuncName, "::tcl::mathop::"); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) ckalloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; occdPtr->expected = opcmdInfoPtr->expected; strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name); cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName, opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData); if (cmdPtr == NULL) { Tcl_Panic("failed to create math operator %s", opcmdInfoPtr->name); } else if (opcmdInfoPtr->compileProc != NULL) { cmdPtr->compileProc = opcmdInfoPtr->compileProc; } } /* * Do Multiple/Safe Interps Tcl init stuff */ TclInterpInit(interp); TclSetupEnv(interp); /* * TIP #59: Make embedded configuration information available. */ TclInitEmbeddedConfigurationInformation(interp); /* * Compute the byte order of this machine. */ order.s = 1; Tcl_SetVar2(interp, "tcl_platform", "byteOrder", ((order.c[0] == 1) ? "littleEndian" : "bigEndian"), TCL_GLOBAL_ONLY); Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize", Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY); /* TIP #291 */ Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize", Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY); /* * Set up other variables such as tcl_version and tcl_library */ Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, "tcl_precision", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, TclPrecTraceProc, NULL); TclpSetVariables(interp); #ifdef TCL_THREADS /* * The existence of the "threaded" element of the tcl_platform array * indicates that this particular Tcl shell has been compiled with threads * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can * introspect on the interpreter level of thread safety. */ Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY); #endif /* * Register Tcl's version number. * TIP #268: Full patchlevel instead of just major.minor */ Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); #ifdef Tcl_InitStubs #undef Tcl_InitStubs #endif Tcl_InitStubs(interp, TCL_VERSION, 1); if (TclTommath_Init(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } return interp; } * ソース /* *---------------------------------------------------------------------- * * Tcl_CreateInterp -- * * Create a new TCL command interpreter. * * Results: * The return value is a token for the interpreter, which may be used in * calls to functions like Tcl_CreateCmd, Tcl_Eval, or Tcl_DeleteInterp. * * Side effects: * The command interpreter is initialized with the built-in commands and * with the variables documented in tclvars(n). * *---------------------------------------------------------------------- */ Tcl_Interp * Tcl_CreateInterp(void) { Interp *iPtr; Tcl_Interp *interp; Command *cmdPtr; const BuiltinFuncDef *builtinFuncPtr; const OpCmdInfo *opcmdInfoPtr; const CmdInfo *cmdInfoPtr; Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr; union { char c[sizeof(short)]; short s; } order; #ifdef TCL_COMPILE_STATS ByteCodeStats *statsPtr; #endif /* TCL_COMPILE_STATS */ char mathFuncName[32]; CallFrame *framePtr; int result; TclInitSubsystems(); /* * Panic if someone updated the CallFrame structure without also updating * the Tcl_CallFrame structure (or vice versa). */ if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) { /*NOTREACHED*/ Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } /* * Initialize support for namespaces and create the global namespace * (whose name is ""; an alias is "::"). This also initializes the Tcl * object type table and other object management code. */ iPtr = (Interp *) ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; iPtr->result = iPtr->resultSpace; iPtr->freeProc = NULL; iPtr->errorLine = 0; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); iPtr->globalNsPtr = NULL; iPtr->hiddenCmdTablePtr = NULL; iPtr->interpInfo = NULL; iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; iPtr->framePtr = NULL; /* Initialise as soon as :: is available */ iPtr->varFramePtr = NULL; /* Initialise as soon as :: is available */ /* * TIP #280 - Initialize the arrays used to extend the ByteCode and * Proc structures. */ iPtr->cmdFramePtr = NULL; iPtr->linePBodyPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); iPtr->lineBCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); iPtr->lineLAPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable)); iPtr->lineLABCPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable)); Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); iPtr->scriptCLLocPtr = NULL; iPtr->activeVarTracePtr = NULL; iPtr->returnOpts = NULL; iPtr->errorInfo = NULL; TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo"); Tcl_IncrRefCount(iPtr->eiVar); iPtr->errorCode = NULL; TclNewLiteralStringObj(iPtr->ecVar, "::errorCode"); Tcl_IncrRefCount(iPtr->ecVar); iPtr->returnLevel = 1; iPtr->returnCode = TCL_OK; iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; iPtr->appendResult = NULL; iPtr->appendAvl = 0; iPtr->appendUsed = 0; Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; /* TIP #268 */ if (getenv("TCL_PKG_PREFER_LATEST") == NULL) { iPtr->packagePrefer = PKG_PREFER_STABLE; } else { iPtr->packagePrefer = PKG_PREFER_LATEST; } iPtr->cmdCount = 0; TclInitLiteralTable(&(iPtr->literalTable)); iPtr->compileEpoch = 0; iPtr->compiledProcPtr = NULL; iPtr->resolverPtr = NULL; iPtr->evalFlags = 0; iPtr->scriptFile = NULL; iPtr->flags = 0; iPtr->tracePtr = NULL; iPtr->tracesForbiddingInline = 0; iPtr->activeCmdTracePtr = NULL; iPtr->activeInterpTracePtr = NULL; iPtr->assocData = NULL; iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */ iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); iPtr->resultSpace[0] = 0; iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ #ifdef TCL_INTERP_DEBUG_FRAME iPtr->flags |= INTERP_DEBUG_FRAME; #else if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) { iPtr->flags |= INTERP_DEBUG_FRAME; } #endif /* * Initialise the tables for variable traces and searches *before* * creating the global ns - so that the trace on errorInfo can be * recorded. */ Tcl_InitHashTable(&iPtr->varTraces, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(&iPtr->varSearches, TCL_ONE_WORD_KEYS); iPtr->globalNsPtr = NULL; /* Force creation of global ns below. */ iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "", NULL, NULL); if (iPtr->globalNsPtr == NULL) { Tcl_Panic("Tcl_CreateInterp: can't create global namespace"); } /* * Initialise the rootCallframe. It cannot be allocated on the stack, as * it has to be in place before TclCreateExecEnv tries to use a variable. */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ framePtr = (CallFrame *) ckalloc(sizeof(CallFrame)); result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0); if (result != TCL_OK) { Tcl_Panic("Tcl_CreateInterp: failed to push the root stack frame"); } framePtr->objc = 0; iPtr->framePtr = framePtr; iPtr->varFramePtr = framePtr; iPtr->rootFramePtr = framePtr; /* * Initialize support for code compilation and execution. We call * TclCreateExecEnv after initializing namespaces since it tries to * reference a Tcl variable (it links to the Tcl "tcl_traceExec" * variable). */ iPtr->execEnvPtr = TclCreateExecEnv(interp); /* * TIP #219, Tcl Channel Reflection API support. */ iPtr->chanMsg = NULL; /* * Initialize the compilation and execution statistics kept for this * interpreter. */ #ifdef TCL_COMPILE_STATS statsPtr = &(iPtr->stats); statsPtr->numExecutions = 0; statsPtr->numCompilations = 0; statsPtr->numByteCodesFreed = 0; (void) memset(statsPtr->instructionCount, 0, sizeof(statsPtr->instructionCount)); statsPtr->totalSrcBytes = 0.0; statsPtr->totalByteCodeBytes = 0.0; statsPtr->currentSrcBytes = 0.0; statsPtr->currentByteCodeBytes = 0.0; (void) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount)); (void) memset(statsPtr->byteCodeCount, 0, sizeof(statsPtr->byteCodeCount)); (void) memset(statsPtr->lifetimeCount, 0, sizeof(statsPtr->lifetimeCount)); statsPtr->currentInstBytes = 0.0; statsPtr->currentLitBytes = 0.0; statsPtr->currentExceptBytes = 0.0; statsPtr->currentAuxBytes = 0.0; statsPtr->currentCmdMapBytes = 0.0; statsPtr->numLiteralsCreated = 0; statsPtr->totalLitStringBytes = 0.0; statsPtr->currentLitStringBytes = 0.0; (void) memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount)); #endif /* TCL_COMPILE_STATS */ /* * Initialise the stub table pointer. */ iPtr->stubTable = &tclStubs; /* * Initialize the ensemble error message rewriting support. */ iPtr->ensembleRewrite.sourceObjs = NULL; iPtr->ensembleRewrite.numRemovedObjs = 0; iPtr->ensembleRewrite.numInsertedObjs = 0; /* * TIP#143: Initialise the resource limit support. */ TclInitLimitSupport(interp); /* * Initialise the thread-specific data ekeko. */ #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) iPtr->allocCache = TclpGetAllocCache(); #else iPtr->allocCache = NULL; #endif iPtr->pendingObjDataPtr = NULL; iPtr->asyncReadyPtr = TclGetAsyncReadyPtr(); /* * Insure that the stack checking mechanism for this interp is * initialized. */ GetCStackParams(iPtr); /* * Create the core commands. Do it here, rather than calling * Tcl_CreateCommand, because it's faster (there's no need to check for a * pre-existing command by the same name). If a command has a Tcl_CmdProc * but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to * TclInvokeStringCommand. This is an object-based wrapper function that * extracts strings, calls the string function, and creates an object for * the result. Similarly, if a command has a Tcl_ObjCmdProc but no * Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand. */ for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { int isNew; Tcl_HashEntry *hPtr; if ((cmdInfoPtr->objProc == NULL) && (cmdInfoPtr->compileProc == NULL)) { Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc"); } hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { cmdPtr = (Command *) ckalloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; cmdPtr->compileProc = cmdInfoPtr->compileProc; cmdPtr->proc = TclInvokeObjectCommand; cmdPtr->clientData = cmdPtr; cmdPtr->objProc = cmdInfoPtr->objProc; cmdPtr->objClientData = NULL; cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; Tcl_SetHashValue(hPtr, cmdPtr); } } /* * Create the "chan", "dict", "info" and "string" ensembles. Note that all * these commands (and their subcommands that are not present in the * global namespace) are wholly safe. */ TclInitChanCmd(interp); TclInitDictCmd(interp); TclInitInfoCmd(interp); TclInitStringCmd(interp); /* * Register "clock" subcommands. These *do* go through * Tcl_CreateObjCommand, since they aren't in the global namespace and * involve ensembles. */ TclClockInit(interp); /* * Register the built-in functions. This is empty now that they are * implemented as commands in the ::tcl::mathfunc namespace. */ /* * Register the default [interp bgerror] handler. */ Tcl_CreateObjCommand(interp, "::tcl::Bgerror", TclDefaultBgErrorHandlerObjCmd, NULL, NULL); /* * Create an unsupported command for debugging bytecode. */ Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble", Tcl_DisassembleObjCmd, NULL, NULL); #ifdef USE_DTRACE /* * Register the tcl::dtrace command. */ Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL); #endif /* USE_DTRACE */ /* * Register the builtin math functions. */ mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL); if (mathfuncNSPtr == NULL) { Tcl_Panic("Can't create math function namespace"); } strcpy(mathFuncName, "::tcl::mathfunc::"); #define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */ for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL; builtinFuncPtr++) { strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL); Tcl_Export(interp, mathfuncNSPtr, builtinFuncPtr->name, 0); } /* * Register the mathematical "operator" commands. [TIP #174] */ mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL); #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ if (mathopNSPtr == NULL) { Tcl_Panic("can't create math operator namespace"); } (void) Tcl_Export(interp, mathopNSPtr, "*", 1); strcpy(mathFuncName, "::tcl::mathop::"); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) ckalloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; occdPtr->expected = opcmdInfoPtr->expected; strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name); cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName, opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData); if (cmdPtr == NULL) { Tcl_Panic("failed to create math operator %s", opcmdInfoPtr->name); } else if (opcmdInfoPtr->compileProc != NULL) { cmdPtr->compileProc = opcmdInfoPtr->compileProc; } } /* * Do Multiple/Safe Interps Tcl init stuff */ TclInterpInit(interp); TclSetupEnv(interp); /* * TIP #59: Make embedded configuration information available. */ TclInitEmbeddedConfigurationInformation(interp); /* * Compute the byte order of this machine. */ order.s = 1; Tcl_SetVar2(interp, "tcl_platform", "byteOrder", ((order.c[0] == 1) ? "littleEndian" : "bigEndian"), TCL_GLOBAL_ONLY); Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize", Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY); /* TIP #291 */ Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize", Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY); /* * Set up other variables such as tcl_version and tcl_library */ Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, "tcl_precision", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, TclPrecTraceProc, NULL); TclpSetVariables(interp); #ifdef TCL_THREADS /* * The existence of the "threaded" element of the tcl_platform array * indicates that this particular Tcl shell has been compiled with threads * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can * introspect on the interpreter level of thread safety. */ Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY); #endif /* * Register Tcl's version number. * TIP #268: Full patchlevel instead of just major.minor */ Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); #ifdef Tcl_InitStubs #undef Tcl_InitStubs #endif Tcl_InitStubs(interp, TCL_VERSION, 1); if (TclTommath_Init(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } return interp; }

ByteCodeStats

2011-11-09T18:42:57+09:00

* 概要バイトコードコンパイラとインタープリタの統計情報 [[tcl/generic/tclInt.h]] * ソース /* * The following structure defines for each Tcl interpreter various * statistics-related information about the bytecode compiler and * interpreter's operation in that interpreter. */ #ifdef TCL_COMPILE_STATS typedef struct ByteCodeStats { long numExecutions; /* Number of ByteCodes executed. */ long numCompilations; /* Number of ByteCodes created. */ long numByteCodesFreed; /* Number of ByteCodes destroyed. */ long instructionCount[256]; /* Number of times each instruction was * executed. */ double totalSrcBytes; /* Total source bytes ever compiled. */ double totalByteCodeBytes; /* Total bytes for all ByteCodes. */ double currentSrcBytes; /* Src bytes for all current ByteCodes. */ double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */ long srcCount[32]; /* Source size distribution: # of srcs of * size [2**(n-1)..2**n), n in [0..32). */ long byteCodeCount[32]; /* ByteCode size distribution. */ long lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ double currentInstBytes; /* Instruction bytes-current ByteCodes. */ double currentLitBytes; /* Current literal bytes. */ double currentExceptBytes; /* Current exception table bytes. */ double currentAuxBytes; /* Current auxiliary information bytes. */ double currentCmdMapBytes; /* Current src<->code map bytes. */ long numLiteralsCreated; /* Total literal objects ever compiled. */ double totalLitStringBytes; /* Total string bytes in all literals. */ double currentLitStringBytes; /* String bytes in current literals. */ long literalCount[32]; /* Distribution of literal string sizes. */ } ByteCodeStats; #endif /* TCL_COMPILE_STATS */

Interp

2011-11-09T18:41:18+09:00

* 概要 [[tcl/generic/tclInt.h]] * メンバー - char *result; 最後のコマンドが返した文字列。直接アクセスしてはいけない。 - [[Tcl_FreeProc]] *freeProc; 0の時文字列は静的にアロケートされている。 TCL_DYNAMIC のとき、ckallocでアロケートされているので、ckfreeで解放しないと行けない。他の値の時は、文字列を得るための手続きのアドレスをしめす。[[Tcl_Eval]]は、次のコマンドを実行する前にfreeしないといけない。 - int errorLine; TCL_ERROR が返ってきたとき、エラーの発生した行数。 - struct [[TclStubs]] *stubTable; サポートされない関数群 - [[TclHandle]] handle; void型のポインタ - [[Namespace]] *globalNsPtr; global ネームスペースへのポインタ - [[Tcl_HashTable]] *hiddenCmdTablePtr; hidden commaandをトラックするためのハッシュテーブル - [[ClientData]] interpInfo; intep basis上のmaster/slaveをトラックスのに使う。 - [[Tcl_HashTable]] unused2; 未使用 - int numLevels; 実行中にTcl_Evalがどれだけネストして呼ばれているかを保存する。 - int maxNestingDepth; ネストしている呼び出し回数の最大値 - [[CallFrame]] *framePtr; 全てのネストした手続きの中で一番上のスタックを指す - [[CallFrame]] *varFramePtr; 現在使用しているスタック。uplevelを使わない限り、framePtrと同じ - [[ActiveVarTrace]] *activeVarTracePtr; intepのアクティブトレースの先頭 - int returnCode; - [[CallFrame]] *rootFramePtr; グローバルフレームポインタ - [[Namespace]] *lookupNsPtr; Tcl_EvalObjvに対して次の TCL_EVAL_INVOKE にのみ使用するネームスペース - char *appendResult; Tcl_AppendResult　によって生成された結果用の保存スペース。Ckallokを使っている。 - int appendAvl; partialResult に多指定の有効な空間の合計 - int appendUsed; partialResult に対して保存しているnon-nullバイトの数 - [[Tcl_HashTable]] packageTable; このインタープリターで有効、もしくはロードされている全てのパッケージの記述。キーはパッケージネーム、値はパッケージへのポインタ。 - char *packageUnknown; パッケージテーブルに記載されていないコマンド。Ckallocされる。おそらくNULL - int cmdCount; インタープリターに呼ばれたコマンドの回数。 - int evalFlags; 次に Tcl_Evalを呼ぶときのフラグ - int unused1; 未使用 - [[LiteralTable]] literalTable; リテラルテーブル - int compileEpoch;　現在の "compilation epoch" を保存する。存在するバイトコードを無効にするためにインクリメントする。 - [[Proc]] *compiledProcPtr; 手続きがコンパイルされているとき、そのProc構造体へのポインタ。 - [[ResolverScheme]] *resolverPtr; - [[Tcl_Obj]] *scriptFile; ソースがネストしていないときはNULL、そうでなけばソースファイルへのポインタ。 - int flags;　フラグ - long randSeed; 乱数のSEED - [[Trace]] *tracePtr; このインタープリターへのトレースのリスト - [[Tcl_HashTable]] *assocData; インタープリターに関連つけられたハッシュテーブル - struct [[ExecEnv]] *execEnvPtr; Tcl バイトコードの実行用の環境 - [[Tcl_Obj]] *emptyObjPtr; 空文字列を保存しているオブジェクトへのポインタ - char resultSpace[TCL_RESULT_SIZE+1]; 小さい結果用の静的な空間 - [[Tcl_Obj]] *objResultPtr; 最後のコマンドが返した結果 - [[Tcl_ThreadId]] threadId; スレッドID - [[ActiveCommandTrace]] *activeCmdTracePtr; interpへのアクティブなコマンドトレースの先頭 - [[ActiveInterpTrace]] *activeInterpTracePtr; interpへのアクティブなトレースの先頭 - int tracesForbiddingInline; トレースの数 - [[Tcl_Obj]] *returnOpts; last [return] commandへのオプションを保持している辞書 - [[Tcl_Obj]] *errorInfo; - [[Tcl_Obj]] *eiVar; - [[Tcl_Obj]] *errorCode; - [[Tcl_Obj]] *ecVar; - int returnLevel; [return -level] parameter. - struct limit; リソースの限界 [[TIP#143>http://www.tcl.tk/cgi-bin/tct/tip/143.html]] - struct ensembleRewrite ensenblesから作られるデフォルトのエラー生成情報 [[TIP#112>http://www.tcl.tk/cgi-bin/tct/tip/112.html]] - [[Tcl_Obj]] *chanMsg; I/OシステムへのGlobal info [[TIP#219>http://www.tcl.tk/cgi-bin/tct/tip/219.html]] - [[CmdFrame]] *cmdFramePtr; 現時のコマンドのロケーション情報を含んでいるコマンドフレーム [[TIP#280>http://www.tcl.tk/cgi-bin/tct/tip/280.html]] - const [[CmdFrame]] *invokeCmdFramePtr; バイトコードのコンパイラによって起動されるコマンドフレーム - int invokeWord; コンパイルされたコマンドの中のワードインデックス - [[Tcl_HashTable]] *linePBodyPtr; bodyへのロケーション情報の手続きを記録しているテーブル? - [[Tcl_HashTable]] *lineBCPtr; - [[Tcl_HashTable]] *lineLABCPtr; - [[Tcl_HashTable]] *lineLAPtr; 実行スタック上の各引数を記録しているテーブル。 - [[ContLineLoc]] *scriptCLLocPtr; このテーブルは、スクリプトの見えない continuation linesを記録する。 - int packagePrefer; 現在のacvitve selection mode [[TIP#268>http://www.tcl.tk/cgi-bin/tct/tip/268.html]] - [[Tcl_HashTable]] varTraces; 変数のアクティブトレースリストのハッシュテーブル - [[Tcl_HashTable]] varSearches; 変数のアクティブサーチリストのハッシュテーブル - void *allocCache; - void *pendingObjDataPtr; キャッシュとペンディングオブジェクトへのポインタ - int *asyncReadyPtr; asyncReady indicator へのポインタ - int *stackBound; stackアドレスの限界へのポインタ - [[ByteCodeStats]] stats; コンパイルと実行の統計情報 * struct limit メンバー時間とコマンドの両方でチェックをしている。 [[TIP#143>http://www.tcl.tk/cgi-bin/tct/tip/143.html]] - int active; - int granularityTicker;　どのくらい頻繁にlimitをチェックしたかのカウンター - int exceeded; どっちのlimitが超えたかを表すフラグ - int cmdCount; コマンドの回数 - LimitHandler *cmdHandlers;　limitを超えたときに実行されるハンドラ - int cmdGranularity; - [[Tcl_Time]] time; 時間のlimit - LimitHandler *timeHandlers; limitを超えたときに実行されるハンドラ - int timeGranularity; - Tcl_TimerToken timeEvent; time-limitが超えたときのコールバック関数 - [[Tcl_HashTable]] callbacks; pairからデータへのマッピング。limitを超えたときのハンドラを、ここにインストールする？ * struct ensembleRewrite のメンバー [[TIP#112>http://www.tcl.tk/cgi-bin/tct/tip/112.html]] - [[Tcl_Obj]] *const *sourceObjs; *root* enssemble コマンドに実際に入力された引数 - int numRemovedObjs; ensemble processingの為に、取り除かれた引数の数 - int numInsertedObjs; ensambleによって挿入されたcurrent引数の数 * ソース /* *---------------------------------------------------------------- * This structure defines an interpreter, which is a collection of commands * plus other state information related to interpreting commands, such as * variable storage. Primary responsibility for this data structure is in * tclBasic.c, but almost every Tcl source file uses something in here. *---------------------------------------------------------------- */ typedef struct Interp { /* * Note: the first three fields must match exactly the fields in a * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the * other. * * The interpreter's result is held in both the string and the * objResultPtr fields. These fields hold, respectively, the result's * string or object value. The interpreter's result is always in the * result field if that is non-empty, otherwise it is in objResultPtr. * The two fields are kept consistent unless some C code sets * interp->result directly. Programs should not access result and * objResultPtr directly; instead, they should always get and set the * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and * Tcl_GetStringResult. See the SetResult man page for details. */ char *result; /* If the last command returned a string * result, this points to it. Should not be * accessed directly; see comment above. */ [[Tcl_FreeProc]] *freeProc; /* Zero means a string result is statically * allocated. TCL_DYNAMIC means string result * was allocated with ckalloc and should be * freed with ckfree. Other values give * address of procedure to invoke to free the * string result. Tcl_Eval must free it before * executing next command. */ int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ struct [[TclStubs]] *stubTable; /* Pointer to the exported Tcl stub table. On * previous versions of Tcl this is a pointer * to the objResultPtr or a pointer to a * buckets array in a hash table. We therefore * have to do some careful checking before we * can use this. */ [[TclHandle]] handle; /* Handle used to keep track of when this * interp is deleted. */ [[Namespace]] *globalNsPtr; /* The interpreter's global namespace. */ [[Tcl_HashTable]] *hiddenCmdTablePtr; /* Hash table used by tclBasic.c to keep track * of hidden commands on a per-interp * basis. */ [[ClientData]] interpInfo; /* Information used by tclInterp.c to keep * track of master/slave interps on a * per-interp basis. */ Tcl_HashTable unused2; /* No longer used (was mathFuncTable) */ /* * Information related to procedures and variables. See tclProc.c and * tclVar.c for usage. */ int numLevels; /* Keeps track of how many nested calls to * Tcl_Eval are in progress for this * interpreter. It's used to delay deletion of * the table until all Tcl_Eval invocations * are completed. */ int maxNestingDepth; /* If numLevels exceeds this value then Tcl * assumes that infinite recursion has * occurred and it generates an error. */ [[CallFrame]] *framePtr; /* Points to top-most in stack of all nested * procedure invocations. */ CallFrame *varFramePtr; /* Points to the call frame whose variables * are currently in use (same as framePtr * unless an "uplevel" command is * executing). */ [[ActiveVarTrace]] *activeVarTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ int returnCode; /* [return -code] parameter. */ CallFrame *rootFramePtr; /* Global frame pointer for this * interpreter. */ Namespace *lookupNsPtr; /* Namespace to use ONLY on the next * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ /* * Information used by Tcl_AppendResult to keep track of partial results. * See Tcl_AppendResult code for details. */ char *appendResult; /* Storage space for results generated by * Tcl_AppendResult. Ckalloc-ed. NULL means * not yet allocated. */ int appendAvl; /* Total amount of space available at * partialResult. */ int appendUsed; /* Number of non-null bytes currently stored * at partialResult. */ /* * Information about packages. Used only in tclPkg.c. */ Tcl_HashTable packageTable; /* Describes all of the packages loaded in or * available to this interpreter. Keys are * package names, values are (Package *) * pointers. */ char *packageUnknown; /* [[Command]] to invoke during "package require" * commands for packages that aren't described * in packageTable. Ckalloc'ed, may be * NULL. */ /* * Miscellaneous information: */ int cmdCount; /* Total number of times a command procedure * has been called for this interpreter. */ int evalFlags; /* Flags to control next call to [[Tcl_Eval]]. * Normally zero, but may be set before * calling Tcl_Eval. See below for valid * values. */ int unused1; /* No longer used (was termOffset) */ [[LiteralTable]] literalTable; /* Contains [[LiteralEntry]]'s describing all Tcl * objects holding literals of scripts * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ int compileEpoch; /* Holds the current "compilation epoch" for * this interpreter. This is incremented to * invalidate existing ByteCodes when, e.g., a * command with a compile procedure is * redefined. */ [[Proc]] *compiledProcPtr; /* If a procedure is being compiled, a pointer * to its Proc structure; otherwise, this is * NULL. Set by ObjInterpProc in tclProc.c and * used by tclCompile.c to process local * variables appropriately. */ [[ResolverScheme]] *resolverPtr; /* Linked list of name resolution schemes * added to this interpreter. Schemes are * added and removed by calling * Tcl_AddInterpResolvers and * Tcl_RemoveInterpResolver respectively. */ [[Tcl_Obj]] *scriptFile; /* NULL means there is no nested source * command active; otherwise this points to * pathPtr of the file being sourced. */ int flags; /* Various flag bits. See below. */ long randSeed; /* Seed used for rand() function. */ [[Trace]] *tracePtr; /* List of traces for this interpreter. */ Tcl_HashTable *assocData; /* Hash table for associating data with this * interpreter. Cleaned up when this * interpreter is deleted. */ struct [[ExecEnv]] *execEnvPtr; /* Execution environment for Tcl bytecode * execution. Contains a pointer to the Tcl * evaluation stack. */ Tcl_Obj *emptyObjPtr; /* Points to an object holding an empty * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ char resultSpace[TCL_RESULT_SIZE+1]; /* Static space holding small results. */ Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ Tcl_ThreadId threadId; /* ID of thread that owns the interpreter. */ [[ActiveCommandTrace]] *activeCmdTracePtr; /* First in list of active command traces for * interp, or NULL if no active traces. */ [[ActiveInterpTrace]] *activeInterpTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ int tracesForbiddingInline; /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode * compilation. */ /* * Fields used to manage extensible return options (TIP 90). */ Tcl_Obj *returnOpts; /* A dictionary holding the options to the * last [return] command. */ Tcl_Obj *errorInfo; /* errorInfo value (now as a Tcl_Obj). */ Tcl_Obj *eiVar; /* cached ref to ::errorInfo variable. */ Tcl_Obj *errorCode; /* errorCode value (now as a Tcl_Obj). */ Tcl_Obj *ecVar; /* cached ref to ::errorInfo variable. */ int returnLevel; /* [return -level] parameter. */ /* * Resource limiting framework support (TIP#143). */ struct { int active; /* Flag values defining which limits have been * set. */ int granularityTicker; /* Counter used to determine how often to * check the limits. */ int exceeded; /* Which limits have been exceeded, described * as flag values the same as the 'active' * field. */ int cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is * reached. */ int cmdGranularity; /* Mod factor used to determine how often to * evaluate the limit check. */ [[Tcl_Time]] time; /* Time limit for execution within the * interpreter. */ LimitHandler *timeHandlers; /* Handlers to execute when the limit is * reached. */ int timeGranularity; /* Mod factor used to determine how often to * evaluate the limit check. */ Tcl_TimerToken timeEvent; /* Handle for a timer callback that will occur * when the time-limit is exceeded. */ Tcl_HashTable callbacks;/* Mapping from (interp,type) pair to data * used to install a limit handler callback to * run in _this_ interp when the limit is * exceeded. */ } limit; /* * Information for improved default error generation from ensembles * (TIP#112). */ struct { Tcl_Obj *const *sourceObjs; /* What arguments were actually input into the * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ int numRemovedObjs; /* How many arguments have been stripped off * because of ensemble processing. */ int numInsertedObjs; /* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; /* * TIP #219: Global info for the I/O system. */ Tcl_Obj *chanMsg; /* Error message set by channel drivers, for * the propagation of arbitrary Tcl errors. * This information, if present (chanMsg not * NULL), takes precedence over a POSIX error * code returned by a channel operation. */ /* * Source code origin information (TIP #280). */ [[CmdFrame]] *cmdFramePtr; /* Points to the command frame containing the * location information for the current * command. */ const CmdFrame *invokeCmdFramePtr; /* Points to the command frame which is the * invoking context of the bytecode compiler. * NULL when the byte code compiler is not * active. */ int invokeWord; /* Index of the word in the command which * is getting compiled. */ Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically * defined procedure the location information * for its body. It is keyed by the address of * the Proc structure for a procedure. The * values are "struct CmdFrame*". */ Tcl_HashTable *lineBCPtr; /* This table remembers for each ByteCode * object the location information for its * body. It is keyed by the address of the * Proc structure for a procedure. The values * are "struct ExtCmdLoc*". (See * tclCompile.h) */ Tcl_HashTable *lineLABCPtr; Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a * command on the execution stack the index of * the argument in the command, and the * location data of the command. It is keyed * by the address of the Tcl_Obj containing * the argument. The values are "struct * CFWord*" (See tclBasic.c). This allows * commands like uplevel, eval, etc. to find * location information for their arguments, * if they are a proper literal argument to an * invoking command. Alt view: An index to the * CmdFrame stack keyed by command argument * holders. */ [[ContLineLoc]] *scriptCLLocPtr;/* This table points to the location data for * invisible continuation lines in the script, * if any. This pointer is set by the function * TclEvalObjEx() in file "tclBasic.c", and * used by function ...() in the same file. * It does for the eval/direct path of script * execution what CompileEnv.clLoc does for * the bytecode compiler. */ /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. */ int packagePrefer; /* Current package selection mode. */ /* * Hashtables for variable traces and searches. */ Tcl_HashTable varTraces; /* Hashtable holding the start of a variable's * active trace list; varPtr is the key. */ Tcl_HashTable varSearches; /* Hashtable holding the start of a variable's * active searches list; varPtr is the key. */ /* * The thread-specific data ekeko: cache pointers or values that * (a) do not change during the thread's lifetime * (b) require access to TSD to determine at runtime * (c) are accessed very often (e.g., at each command call) * * Note that these are the same for all interps in the same thread. They * just have to be initialised for the thread's master interp, slaves * inherit the value. * * They are used by the macros defined below. */ void *allocCache; void *pendingObjDataPtr; /* Pointer to the Cache and PendingObjData * structs for this interp's thread; see * tclObj.c and tclThreadAlloc.c */ int *asyncReadyPtr; /* Pointer to the asyncReady indicator for * this interp's thread; see tclAsync.c */ int *stackBound; /* Pointer to the limit stack address * allowable for invoking a new command * without "risking" a C-stack overflow; see * TclpCheckStackSpace in the platform's * directory. */ #ifdef TCL_COMPILE_STATS /* * Statistical information about the bytecode compiler and interpreter's * operation. */ [[ByteCodeStats]] stats; /* Holds compilation and execution statistics * for this interpreter. */ #endif /* TCL_COMPILE_STATS */ } Interp;

ContLineLoc

2011-11-09T18:16:20+09:00

* 概要 [[tcl/generic/tclInt.h]] * ソース /* * Structure to record the locations of invisible continuation lines in * literal scripts, as character offset from the beginning of the script. Both * compiler and direct evaluator use this information to adjust their line * counters when tracking through the script, because when it is invoked the * continuation line marker as a whole has been removed already, meaning that * the \n which was part of it is gone as well, breaking regular line * tracking. * * These structures are allocated and filled by both the function * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and * TclCompileScript(), both found in the file "tclCompile.c". Their memory is * released by the function TclFreeObj(), in the file "tclObj.c", and also by * the function TclThreadFinalizeObjects(), in the same file. */ #define CLL_END (-1) typedef struct ContLineLoc { int num; /* Number of entries in loc, not counting the * final -1 marker entry. */ int loc[1]; /* Table of locations, as character offsets. * The table is allocated as part of the * structure, extending behind the nominal end * of the structure. An entry containing the * value -1 is put after the last location, as * end-marker/sentinel. */ } ContLineLoc;