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.8 1999/03/13 03:09:33 surles Exp $
 */

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

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

	 * 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();

/*
 * tclInt.h --
 *
 *	Declarations of things used internally by the Tcl interpreter.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclInt.h,v 1.1.2.15 1999/03/24 04:25:14 stanton Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Common include files needed by most of the Tcl source files are

EXTERN void		TclFinalizeCondition _ANSI_ARGS_((
			    Tcl_Condition *condPtr));
EXTERN void		TclFinalizeCompilation _ANSI_ARGS_((void));
EXTERN void		TclFinalizeEncodingSubsystem _ANSI_ARGS_((void));
EXTERN void		TclFinalizeEnvironment _ANSI_ARGS_((void));
EXTERN void		TclFinalizeExecution _ANSI_ARGS_((void));
EXTERN void		TclFinalizeIOSubsystem _ANSI_ARGS_((void));

EXTERN void		TclFinalizeMemorySubsystem _ANSI_ARGS_((void));
EXTERN void		TclFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutex));
EXTERN void		TclFinalizeNotifier _ANSI_ARGS_((void));
EXTERN void		TclFinalizeSynchronization _ANSI_ARGS_((void));
EXTERN void		TclFinalizeThreadData _ANSI_ARGS_((void));
EXTERN void		TclFindEncodings _ANSI_ARGS_((CONST char *argv0));
EXTERN Proc *		TclFindProc _ANSI_ARGS_((Interp *iPtr,

/* 
 * 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.3 1998/12/10 21:21:49 stanton Exp $
 */

#include "tclInt.h"

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

/*
 * Prototypes for procedures that are private to this file:
 */

static void		LoadCleanupProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp));
static void		LoadExitProc _ANSI_ARGS_((ClientData clientData));

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LoadObjCmd --
 *
 *	This procedure is invoked to process the "load" Tcl command.

	    code = TCL_ERROR;
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */
	if (firstPackagePtr == NULL) {
	    Tcl_CreateExitHandler(LoadExitProc, (ClientData) NULL);
	}
	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
	pkgPtr->fileName	= (char *) ckalloc((unsigned)
		(strlen(fullFileName) + 1));
	strcpy(pkgPtr->fileName, fullFileName);
	pkgPtr->packageName	= (char *) ckalloc((unsigned)
		(Tcl_DStringLength(&pkgName) + 1));
	strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));

	if ((pkgPtr->initProc == initProc)
		&& (pkgPtr->safeInitProc == safeInitProc)
		&& (strcmp(pkgPtr->packageName, pkgName) == 0)) {
	    Tcl_MutexUnlock(&packageMutex);
	    return;
	}
    }
    if (firstPackagePtr == NULL) {
	Tcl_CreateExitHandler(LoadExitProc, (ClientData) NULL);
    }
    Tcl_MutexUnlock(&packageMutex);

    pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
    pkgPtr->fileName		= (char *) ckalloc((unsigned) 1);
    pkgPtr->fileName[0]		= 0;
    pkgPtr->packageName		= (char *) ckalloc((unsigned)
	    (strlen(pkgName) + 1));

	ipPtr = nextPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * LoadExitProc --
 *
 *	This procedure is invoked just before the application exits.
 *	It frees all of the LoadedPackage structures.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is freed.
 *
 *----------------------------------------------------------------------
 */

static void
LoadExitProc(clientData)
    ClientData clientData;		/* Not used. */
{
    LoadedPackage *pkgPtr;

    Tcl_MutexLock(&packageMutex);
    while (firstPackagePtr != NULL) {
	pkgPtr = firstPackagePtr;
	firstPackagePtr = pkgPtr->nextPtr;