tclevent.c

tcl是工具命令语言

	ckfree(errPtr->errorMsg);
	ckfree(errPtr->errorInfo);
	ckfree(errPtr->errorCode);
	ckfree((char *) errPtr);
    }
    Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
    Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateExitHandler --
 *
 *	Arrange for a given procedure to be invoked just before the
 *	application exits.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Proc will be invoked with clientData as argument when the
 *	application exits.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateExitHandler(proc, clientData)
    Tcl_ExitProc *proc;		/* Procedure to invoke. */
    ClientData clientData;	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr;

    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstExitPtr;
    firstExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteExitHandler --
 *
 *	This procedure cancels an existing exit handler matching proc
 *	and clientData, if such a handler exits.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there is an exit handler corresponding to proc and clientData
 *	then it is cancelled;  if no such handler exists then nothing
 *	happens.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteExitHandler(proc, clientData)
    Tcl_ExitProc *proc;		/* Procedure that was previously registered. */
    ClientData clientData;	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;

    Tcl_MutexLock(&exitMutex);
    for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    ckfree((char *) exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateThreadExitHandler --
 *
 *	Arrange for a given procedure to be invoked just before the
 *	current thread exits.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Proc will be invoked with clientData as argument when the
 *	application exits.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateThreadExitHandler(proc, clientData)
    Tcl_ExitProc *proc;		/* Procedure to invoke. */
    ClientData clientData;	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    exitPtr->nextPtr = tsdPtr->firstExitPtr;
    tsdPtr->firstExitPtr = exitPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteThreadExitHandler --
 *
 *	This procedure cancels an existing exit handler matching proc
 *	and clientData, if such a handler exits.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there is an exit handler corresponding to proc and clientData
 *	then it is cancelled;  if no such handler exists then nothing
 *	happens.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteThreadExitHandler(proc, clientData)
    Tcl_ExitProc *proc;		/* Procedure that was previously registered. */
    ClientData clientData;	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		tsdPtr->firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    ckfree((char *) exitPtr);
	    return;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Exit --
 *
 *	This procedure is called to terminate the application.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	All existing exit handlers are invoked, then the application
 *	ends.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Exit(status)
    int status;			/* Exit status for application;  typically
				 * 0 for normal return, 1 for error return. */
{
    Tcl_Finalize();
    TclpExit(status);
}

/*
 *-------------------------------------------------------------------------
 * 
 * TclSetLibraryPath --
 *
 *	Set the path that will be used for searching for init.tcl and 
 *	encodings when an interp is being created.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Changing the library path will affect what directories are
 *	examined when looking for encodings for all interps from that
 *	point forward.
 *
 *	The refcount of the new library path is incremented and the 
 *	refcount of the old path is decremented.
 *
 *-------------------------------------------------------------------------
 */

void
TclSetLibraryPath(pathPtr)
    Tcl_Obj *pathPtr;		/* A Tcl list object whose elements are
				 * the new library path. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (pathPtr != NULL) {
	Tcl_IncrRefCount(pathPtr);
    }
    if (tsdPtr->tclLibraryPath != NULL) {
	Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
    }
    tsdPtr->tclLibraryPath = pathPtr;

    /*
     *  No mutex locking is needed here as up the stack we're within
     *  TclpInitLock().
     */
    tclLibraryPathStr = Tcl_GetStringFromObj(pathPtr, NULL);
}

/*
 *-------------------------------------------------------------------------
 *
 * TclGetLibraryPath --
 *
 *	Return a Tcl list object whose elements are the library path.
 *	The caller should not modify the contents of the returned object.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

Tcl_Obj *
TclGetLibraryPath()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->tclLibraryPath == NULL) {
	/*
	 * Grab the shared string and place it into a new thread specific
	 * Tcl_Obj.
	 */
	tsdPtr->tclLibraryPath = Tcl_NewStringObj(tclLibraryPathStr, -1);

	/* take ownership */
	Tcl_IncrRefCount(tsdPtr->tclLibraryPath);
    }
    return tsdPtr->tclLibraryPath;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclInitSubsystems --
 *
 *	Initialize various subsytems in Tcl.  This should be called the
 *	first time an interp is created, or before any of the subsystems
 *	are used.  This function ensures an order for the initialization 
 *	of subsystems:
 *
 *	1. that cannot be initialized in lazy order because they are 
 *	mutually dependent.
 *
 *	2. so that they can be finalized in a known order w/o causing
 *	the subsequent re-initialization of a subsystem in the act of
 *	shutting down another.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Varied, see the respective initialization routines.
 *
 *-------------------------------------------------------------------------
 */

void
TclInitSubsystems(argv0)
    CONST char *argv0;		/* Name of executable from argv[0] to main()
				 * in native multi-byte encoding. */
{
    ThreadSpecificData *tsdPtr;

    if (inFinalize != 0) {
	panic("TclInitSubsystems called while finalizing");
    }

    /*
     * Grab the thread local storage pointer before doing anything because
     * the initialization routines will be registering exit handlers.
     * We use this pointer to detect if this is the first time this
     * thread has created an interpreter.
     */

    tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);

    if (subsystemsInitialized == 0) {
	/* 
	 * Double check inside the mutex.  There are definitly calls
	 * back into this routine from some of the procedures 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;

	    tclExecutableName = NULL;

	    /*
	     * Initialize locks used by the memory allocators before anything
	     * interesting happens so we can use the allocators in the
	     * implementation of self-initializing locks.
	     */
#if USE_TCLALLOC
	    TclInitAlloc(); /* process wide mutex init */
#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc(); /* process wide mutex init */
#endif

	    TclpInitPlatform(); /* creates signal handler(s) */
    	    TclInitObjSubsystem(); /* register obj types, create mutexes */
	    TclInitIOSubsystem(); /* inits a tsd key (noop) */
	    TclInitEncodingSubsystem(); /* process wide encoding init */
    	    TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */
	}
	TclpInitUnlock();
    }

    if (tsdPtr == NULL) {
	/*
	 * First time this thread has created an interpreter.
	 * We fetch the key again just in case no exit handlers were
	 * registered by this point.
	 */

	(void) TCL_TSD_INIT(&dataKey);
	TclInitNotifier();
     }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Finalize --
 *
 *	Shut down Tcl.  First calls registered exit handlers, then
 *	carefully shuts down various subsystems.
 *	Called by Tcl_Exit or when the Tcl shared library is being 
 *	unloaded.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Varied, see the respective finalization routines.
 *