Tcl Source Code

/* 
 * tclEvent.c --
 *
 *	This file implements some general event related interfaces including
 *	background errors, exit handlers, and the "vwait" and "update"
 *	command procedures. 
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclEvent.c,v 1.1.2.10 1999/04/03 01:35:19 welch Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The data structure below is used to report background errors.  One

}

/*
 *----------------------------------------------------------------------
 *
 * 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:

	 * In particular, the testexithandler command sets up something
	 * that writes to standard output, which gets closed.
	 * Note that there is no thread-local storage after this call.
	 */
    
	Tcl_FinalizeThread();








	/*
	 * Now finalize the Tcl execution environment.  Note that this
	 * must be done after the exit handlers, because there are
	 * order dependencies.
	 */

	TclFinalizeCompExecEnv();

	/*
	 * Free synchronization objects.  There really should only be one
	 * thread alive at this moment.
	 */

	TclFinalizeSynchronization();

	/*
	 * We defer unloading of packages until very late 
	 * to avoid memory access issues.  Both exit callbacks and
	 * synchronization variables may be stored in packages.
	 */

	TclFinalizeLoad();

	/*
	 * There shouldn't be any malloc'ed memory after this.
	 */

	TclFinalizeMemorySubsystem();
	inFinalize = 0;
    }

/* 
 * tclLoad.c --
 *
 *	This file provides the generic portion (those that are the same
 *	on all platforms) of Tcl's dynamic loading facilities.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclLoad.c,v 1.1.2.5 1999/04/03 01:35:19 welch Exp $
 */

#include "tclInt.h"

/*
 * The following structure describes a package that has been loaded
 * either dynamically (with the "load" command) or statically (as

 */

void
TclFinalizeLoad()
{
    LoadedPackage *pkgPtr;

    /*
     * No synchronization here because there should just be
     * one thread alive at this point.  Logically, 
     * packageMutex should be grabbed at this point, but
     * the Mutexes get finalized before the call to this routine.
     * The only subsystem left alive at this point is the
     * memory allocator.
     */

    while (firstPackagePtr != NULL) {
	pkgPtr = firstPackagePtr;
	firstPackagePtr = pkgPtr->nextPtr;
	if (pkgPtr->fileName[0] != '\0') {
	    TclpUnloadFile(pkgPtr->clientData);
	}
	ckfree(pkgPtr->fileName);
	ckfree(pkgPtr->packageName);
	ckfree((char *) pkgPtr);
    }

}

/* 
 * tclThreadTest.c --
 *
 *	This file implements the testthread command.  Eventually this
 *	should be tclThreadCmd.c
 *	Some of this code is based on work done by Richard Hipp on behalf of
 *	Conservation Through Innovation, Limited, with their permission.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclThreadTest.c,v 1.1.2.8 1999/04/03 01:35:19 welch Exp $
 */

#include "tclInt.h"

#ifdef TCL_THREADS
/*
 * Each thread has an single instance of the following structure.  There

    /* 
     * Block on the results and then get them.
     */

    Tcl_ResetResult(interp);
    Tcl_MutexLock(&threadMutex);
    while (resultPtr->result == NULL) {
        Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
    }

    /*
     * Unlink result from the result list.
     */

    if (resultPtr->prevPtr) {
	resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
    } else {
	resultList = resultPtr->nextPtr;
    }
    if (resultPtr->nextPtr) {
	resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
    }
    resultPtr->eventPtr = NULL;
    resultPtr->nextPtr = NULL;
    resultPtr->prevPtr = NULL;

    Tcl_MutexUnlock(&threadMutex);

    if (resultPtr->code != TCL_OK) {
	if (resultPtr->errorCode) {
	    Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
	    ckfree(resultPtr->errorCode);
	}
	if (resultPtr->errorInfo) {
	    Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
	    ckfree(resultPtr->errorInfo);
	}
    }
    Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
    TclFinalizeCondition(&resultPtr->done);
    code = resultPtr->code;













    ckfree((char *) resultPtr);

    return code;
}


/*