/* 
 * 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.4 1999/12/01 00:08:28 hobbs Exp $
 * RCS: @(#) $Id: tclLoad.c,v 1.5 2001/07/31 19:12:06 vincentdarley Exp $
 */

#include "tclInt.h"

/*
 * The following structure describes a package that has been loaded
 * either dynamically (with the "load" command) or statically (as
 * indicated by a call to TclGetLoadedPackages).  All such packages
 * are linked together into a single list for the process.  Packages
 * are never unloaded, so these structures are never freed.
 * are never unloaded, until the application exits, when 
 * TclFinalizeLoad is called, and these structures are freed.
 */

typedef struct LoadedPackage {
    char *fileName;		/* Name of the file from which the
				 * package was loaded.  An empty string
				 * means the package is loaded statically.
				 * Malloc-ed. */
    char *packageName;		/* Name of package prefix for the package,
				 * properly capitalized (first letter UC,
				 * others LC), no "_", as in "Net". 
				 * Malloc-ed. */
    ClientData clientData;	/* Token for the loaded file which should be
				 * passed to TclpUnloadFile() when the file
				 * passed to (*unLoadProcPtr)() when the file
				 * is no longer needed.  If fileName is NULL,
				 * then this field is irrelevant. */
    Tcl_PackageInitProc *initProc;
				/* Initialization procedure to call to
				 * incorporate this package into a trusted
				 * interpreter. */
    Tcl_PackageInitProc *safeInitProc;
				/* Initialization procedure to call to
				 * incorporate this package into a safe
				 * interpreter (one that will execute
				 * untrusted scripts).   NULL means the
				 * package can't be used in unsafe
				 * interpreters. */
    Tcl_FSUnloadFileProc *unLoadProcPtr;
				/* Procedure to use to unload this package.
				 * If NULL, then we do not attempt to unload
				 * the package.  If fileName is NULL, then
				 * this field is irrelevant. */
    struct LoadedPackage *nextPtr;
				/* Next in list of all packages loaded into
				 * this application process.  NULL means
				 * end of list. */
} LoadedPackage;

/*

    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tcl_Interp *target;
    LoadedPackage *pkgPtr, *defaultPtr;
    Tcl_DString pkgName, tmp, initName, safeInitName, fileName;
    Tcl_DString pkgName, tmp, initName, safeInitName;
    Tcl_PackageInitProc *initProc, *safeInitProc;
    InterpPackage *ipFirstPtr, *ipPtr;
    int code, namesMatch, filesMatch;
    char *p, *tempString, *fullFileName, *packageName;
    char *p, *fullFileName, *packageName;
    ClientData clientData;
    Tcl_FSUnloadFileProc *unLoadProcPtr = NULL;
    Tcl_UniChar ch;
    int offset;

    if ((objc < 2) || (objc > 4)) {
        Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
	return TCL_ERROR;
    }
    tempString = Tcl_GetString(objv[1]);
    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
    fullFileName = Tcl_TranslateFileName(interp, tempString, &fileName);
    if (fullFileName == NULL) {
	return TCL_ERROR;
    }
    fullFileName = Tcl_GetString(objv[1]);
    
    Tcl_DStringInit(&pkgName);
    Tcl_DStringInit(&initName);
    Tcl_DStringInit(&safeInitName);
    Tcl_DStringInit(&tmp);

    packageName = NULL;
    if (objc >= 3) {

	/*
	 * Call platform-specific code to load the package and find the
	 * two initialization procedures.
	 */

	Tcl_MutexLock(&packageMutex);
	code = TclpLoadFile(interp, fullFileName, Tcl_DStringValue(&initName),
	code = Tcl_FSLoadFile(interp, objv[1], Tcl_DStringValue(&initName),
		Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc,
		&clientData);
		&clientData,&unLoadProcPtr);
	Tcl_MutexUnlock(&packageMutex);
	if (code != TCL_OK) {
	    goto done;
	}
	if (initProc == NULL) {
	    Tcl_AppendResult(interp, "couldn't find procedure ",
		    Tcl_DStringValue(&initName), (char *) NULL);
	    if (unLoadProcPtr != NULL) {
	    TclpUnloadFile(clientData);
		(*unLoadProcPtr)(clientData);
	    }
	    code = TCL_ERROR;
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */

	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));
	pkgPtr->clientData	= clientData;
	pkgPtr->unLoadProcPtr	= unLoadProcPtr;
	pkgPtr->initProc	= initProc;
	pkgPtr->safeInitProc	= safeInitProc;
	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		= firstPackagePtr;
	firstPackagePtr		= pkgPtr;
	Tcl_MutexUnlock(&packageMutex);
    }

	TclTransferResult(target, code, interp);
    }

    done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&initName);
    Tcl_DStringFree(&safeInitName);
    Tcl_DStringFree(&fileName);
    Tcl_DStringFree(&tmp);
    return code;
}

/*
 *----------------------------------------------------------------------
 *

	/*
	 * Some Unix dlls are poorly behaved - registering things like
	 * atexit calls that can't be unregistered.  If you unload
	 * such dlls, you get a core on exit because it wants to
	 * call a function in the dll after it's been unloaded.
	 */
	if (pkgPtr->fileName[0] != '\0') {
	    Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
	    if (unLoadProcPtr != NULL) {
	    TclpUnloadFile(pkgPtr->clientData);
	        (*unLoadProcPtr)(pkgPtr->clientData);
	    }
	}
#endif
	ckfree(pkgPtr->fileName);
	ckfree(pkgPtr->packageName);
	ckfree((char *) pkgPtr);
    }
}