TIP#100 implementation largely based on work by Georgios Petasis.

12 files changed, 1242 insertions, 27 deletions

diff --git a/ChangeLog b/ChangeLog
index d0bcae7..b4e2f2c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2004-02-24  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	IMPLEMENTATION OF TIP#100 FROM GEORGIOS PETASIS
+	* generic/tclLoad.c (Tcl_UnloadObjCmd): Implementation.
+	* tests/unload.test:			Test suite.
+	* unix/dltest/pkgua.c:			Helper for test suite.
+	* doc/unload.n:				Documentation.
+	Also assorted changes (mostly small) to several other files.
+
 2004-02-23  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* generic/regc_locale.c (cclass): Buffer was having its size reset
diff --git a/doc/load.n b/doc/load.n
index 5f404e1..cb125cc 100644
--- a/doc/load.n
+++ b/doc/load.n
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: load.n,v 1.7 2002/07/01 18:24:39 jenglish Exp $
+'\" RCS: @(#) $Id: load.n,v 1.8 2004/02/24 22:58:45 dkf Exp $
 '\" 
 .so man.macros
 .TH load n 7.5 Tcl "Tcl Built-In Commands"
@@ -73,7 +73,12 @@ in an application.  If a given \fIfileName\fR is loaded into multiple
 interpreters, then the first \fBload\fR will load the code and
 call the initialization procedure;  subsequent \fBload\fRs will
 call the initialization procedure without loading the code again.
-It is not possible to unload or reload a package.
+.VS 8.5
+For Tcl versions lower than 8.5, it is not possible to unload or reload a
+package. From version 8.5 however, the \fBunload\fR command allows the unloading
+of libraries loaded with \fBload\fR, for libraries that are aware of the
+Tcl's unloading mechanism.
+.VE 8.5
 .PP
 The \fBload\fR command also supports packages that are statically
 linked with the application, if those packages have been registered
diff --git a/doc/unload.n b/doc/unload.n
new file mode 100644
index 0000000..4fc41dd
--- /dev/null
+++ b/doc/unload.n
@@ -0,0 +1,151 @@
+'\"
+'\" Copyright (c) 2003 George Petasis, petasis@iit.demokritos.gr.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" RCS: @(#) $Id: unload.n,v 1.1 2004/02/24 22:58:45 dkf Exp $
+'\" 
+.so man.macros
+.TH unload n 8.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+unload \- Unload machine code.
+.SH SYNOPSIS
+\fBunload \fR?\fIswitches\fR? \fIfileName\fR
+.br
+\fBunload \fR?\fIswitches\fR? \fIfileName packageName\fR
+.br
+\fBunload \fR?\fIswitches\fR? \fIfileName packageName interp\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command tries to unload shared libraries previously loaded
+with \fBload\fR from the application's address space.  \fIfileName\fR
+is the name of the file containing the library file to be unload;  it
+must be the same as the filename provided to \fBload\fR for
+loading the library.
+\fIpackageName\fR is the name of the package, and is used to
+compute the name of the unload procedure.
+\fIinterp\fR is the path name of the interpreter from which to unload
+the package (see the \fBinterp\fR manual entry for details);
+if \fIinterp\fR is omitted, it defaults to the
+interpreter in which the \fBunload\fR command was invoked.
+.LP
+If the initial arguments to \fBunload\fR start with \fB\-\fR then
+they are treated as switches.  The following switches are
+currently supported:
+.TP
+\fB\-nocomplain\fR
+Supresses all error messages. If this switch is given \fBunload\fR will
+never report an error.
+.TP
+\fB\-keeplibrary\fR
+This switch will prevent \fBunload\fR from issuing the operating system call
+that will unload the library from the process. 
+.TP
+\fB\-\|\-\fR
+Marks the end of switches.  The argument following this one will
+be treated as a \fIfileName\fR even if it starts with a \fB\-\fR.
+.PP
+When a file containing a shared library is loaded through the
+\fBload\fR command, Tcl associates two reference counts to the library
+file. The first counter shows how many times the library has been
+loaded into normal (trusted) interpreters while the second describes how many
+times the library has been loaded into safe interpreters. As a file containing
+a shared library can be loaded only once by Tcl (with the first \fBload\fR
+call on the file), these counters track how many interpreters use the library.
+Each subsequent call to \fBload\fR after the first, simply increaments the
+proper reference count.
+.PP
+\fBunload\fR works in the opposite direction. As a first step, \fBunload\fR
+will check whether the library is unloadable: an unloadable library exports
+a special unload procedure. The name of the unload procedure is determined by
+\fIpackageName\fR and whether or not the target interpreter
+is a safe one.  For normal interpreters the name of the initialization
+procedure will have the form \fIpkg\fB_Unload\fR, where \fIpkg\fR
+is the same as \fIpackageName\fR except that the first letter is
+converted to upper case and all other letters
+are converted to lower case.  For example, if \fIpackageName\fR is
+\fBfoo\fR or \fBFOo\fR, the initialization procedure's name will
+be \fBFoo_Unload\fR.
+If the target interpreter is a safe interpreter, then the name
+of the initialization procedure will be \fIpkg\fB_SafeUnload\fR
+instead of \fIpkg\fB_Unload\fR.
+.PP
+If \fBunload\fR determines that a library is not unloadable (or unload
+functionality has been disabled during compilation), an error will be returned.
+If the library is unloadable, then \fBunload\fR will call the unload
+procedure. If the unload procedure returns TCL_OK, \fBunload\fR will proceed
+and decrease the proper reference count (depending on the target interpreter
+type). When both reference counts have reached 0, the library will be
+detached from the process.
+.PP
+The unload procedure must match the following prototype:
+.CS
+typedef int Tcl_PackageUnloadProc(Tcl_Interp *\fIinterp\fR, int \fIflags\fR);
+.CE
+The \fIinterp\fR argument identifies the interpreter from which the
+library is to be unloaded.  The unload procedure must return
+\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
+successfully;  in the event of an error it should set the interpreter's result
+to point to an error message.  In this case, the result of the
+\fBunload\fR command will be the result returned by the unload procedure.
+.CE
+The \fIflags\fR argument can be either \fBTCL_UNLOAD_DETACH_FROM_INTERPRETER\fR
+or \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR. In case the library will remain
+attached to the process after the unload procedure returns (i.e. because
+the library is used by other interpreters),
+\fBTCL_UNLOAD_DETACH_FROM_INTERPRETER\fR will be defined. However, if the
+library is used only by the target interpreter and the library will be
+detached from the application as soon as the unload procedure returns,
+the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR. 
+.PP
+The \fBunload\fR command cannot unload libraries that are statically
+linked with the application.
+If \fIfileName\fR is an empty string, then \fIpackageName\fR must
+be specified.
+.PP
+If \fIpackageName\fR is omitted or specified as an empty string,
+Tcl tries to guess the name of the package.
+This may be done differently on different platforms.
+The default guess, which is used on most UNIX platforms, is to
+take the last element of \fIfileName\fR, strip off the first
+three characters if they are \fBlib\fR, and use any following
+.VS
+alphabetic and underline characters as the module name.
+.VE
+For example, the command \fBunload libxyz4.2.so\fR uses the module
+name \fBxyz\fR and the command \fBunload bin/last.so {}\fR uses the
+module name \fBlast\fR.
+
+.SH "PORTABILITY ISSUES"
+.TP
+\fBUnix\fR\0\0\0\0\0
+.
+Not all unix operating systems support library unloading. Under such
+an operating system \fBunload\fR returns an error (unless -nocomplain has
+been specified).
+.TP
+\fBMacintosh\fR\0\0\0\0\0
+.
+<Somebody to comment on this?>
+
+.SH BUGS
+.PP
+If the same file is \fBload\fRed by different \fIfileName\fRs, it will
+be loaded into the process's address space multiple times.  The
+behavior of this varies from system to system (some systems may
+detect the redundant loads, others may not). In case a library has been
+silently detached by the operating system (and as a result Tcl thinks the
+library is still loaded), it may be dangerous to use
+\fBunload\fR on such a library (as the library will be completely detached
+from the application while some interpreters will continue to use it).
+
+.SH "SEE ALSO"
+info sharedlibextension, load, safe(n)
+
+.SH KEYWORDS
+binary code, unloading, safe interpreter, shared library
diff --git a/generic/tcl.h b/generic/tcl.h
index 83ad1bd..e53fcf0 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.170 2004/01/09 20:55:26 davygrvy Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.171 2004/02/24 22:58:45 dkf Exp $
  */
 
 #ifndef _TCL
@@ -697,6 +697,8 @@ typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData));
 typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData,
 	Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv));
 typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
+typedef int (Tcl_PackageUnloadProc) _ANSI_ARGS_((Tcl_Interp *interp,
+                                                 int flags));
 typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(CONST char *, format));
 typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
         Tcl_Channel chan, char *address, int port));
@@ -1627,6 +1629,11 @@ typedef struct Tcl_GlobTypeData {
 #define TCL_GLOB_PERM_W			(1<<3)
 #define TCL_GLOB_PERM_X			(1<<4)
 
+/*
+ * Flags for the unload callback procedure
+ */
+#define TCL_UNLOAD_DETACH_FROM_INTERPRETER   (1<<0)
+#define TCL_UNLOAD_DETACH_FROM_PROCESS       (1<<1)
 
 /*
  * Typedefs for the various filesystem operations:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2334d53..7c5e460 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.96 2004/01/18 16:19:04 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.97 2004/02/24 22:58:46 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -166,6 +166,8 @@ static CmdInfo builtInCmds[] = {
         TclCompileSwitchCmd,		1},
     {"trace",		(Tcl_CmdProc *) NULL,	Tcl_TraceObjCmd,
         (CompileProc *) NULL,		1},
+    {"unload",		(Tcl_CmdProc *) NULL,	Tcl_UnloadObjCmd,
+        (CompileProc *) NULL,		1},
     {"unset",		(Tcl_CmdProc *) NULL,	Tcl_UnsetObjCmd,	
         (CompileProc *) NULL,		1},
     {"uplevel",		(Tcl_CmdProc *) NULL,	Tcl_UplevelObjCmd,	
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6825d08..27dbc89 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * 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.143 2004/01/21 19:59:33 vincentdarley Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.144 2004/02/24 22:58:46 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -2005,6 +2005,8 @@ EXTERN int	Tcl_TimeObjCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_TraceObjCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_UnloadObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_UnsetObjCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_UpdateObjCmd _ANSI_ARGS_((ClientData clientData,
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 2227e6e..5be526c 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -9,7 +9,7 @@
  * 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.10 2004/02/21 12:48:50 dkf Exp $
+ * RCS: @(#) $Id: tclLoad.c,v 1.11 2004/02/24 22:58:48 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -47,6 +47,18 @@ typedef struct LoadedPackage {
 				 * untrusted scripts).   NULL means the
 				 * package can't be used in unsafe
 				 * interpreters. */
+    Tcl_PackageUnloadProc *unloadProc;
+                                /* Finalisation procedure to unload a package
+                                 * from a trusted interpreter.  NULL means
+                                 * that the package cannot be unloaded. */
+    Tcl_PackageUnloadProc *safeUnloadProc;
+                                /* Finalisation procedure to unload a package
+                                 * from a safe interpreter.  NULL means
+                                 * that the package cannot be unloaded. */
+    int interpRefCount;         /* How many times the package has been loaded
+                                   in trusted interpreters. */
+    int safeInterpRefCount;     /* How many times the package has been loaded
+                                   in safe interpreters. */
     Tcl_FSUnloadFileProc *unLoadProcPtr;
 				/* Procedure to use to unload this package.
 				 * If NULL, then we do not attempt to unload
@@ -119,10 +131,14 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 {
     Tcl_Interp *target;
     LoadedPackage *pkgPtr, *defaultPtr;
-    Tcl_DString pkgName, tmp, initName, safeInitName;
-    Tcl_PackageInitProc *initProc, *safeInitProc;
+    Tcl_DString pkgName, tmp, initName, safeInitName,
+                              unloadName, safeUnloadName;
+    Tcl_PackageInitProc *initProc, *safeInitProc, *unloadProc, *safeUnloadProc;
     InterpPackage *ipFirstPtr, *ipPtr;
     int code, namesMatch, filesMatch;
+    CONST char *symbols[4];
+    Tcl_PackageInitProc **procPtrs[4];
+    ClientData clientData;
     char *p, *fullFileName, *packageName;
     Tcl_LoadHandle loadHandle;
     Tcl_FSUnloadFileProc *unLoadProcPtr = NULL;
@@ -141,6 +157,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
     Tcl_DStringInit(&pkgName);
     Tcl_DStringInit(&initName);
     Tcl_DStringInit(&safeInitName);
+    Tcl_DStringInit(&unloadName);
+    Tcl_DStringInit(&safeUnloadName);
     Tcl_DStringInit(&tmp);
 
     packageName = NULL;
@@ -332,21 +350,33 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 	Tcl_DStringAppend(&initName, "_Init", 5);
 	Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1);
 	Tcl_DStringAppend(&safeInitName, "_SafeInit", 9);
+        Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1);
+	Tcl_DStringAppend(&unloadName, "_Unload", 7);
+        Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1);
+	Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11);
 
 	/*
 	 * Call platform-specific code to load the package and find the
 	 * two initialization procedures.
 	 */
 
+        symbols[0] = Tcl_DStringValue(&initName);
+        symbols[1] = Tcl_DStringValue(&safeInitName);
+        symbols[2] = Tcl_DStringValue(&unloadName);
+        symbols[3] = Tcl_DStringValue(&safeUnloadName);
+        procPtrs[0] = &initProc;
+        procPtrs[1] = &safeInitProc;
+        procPtrs[2] = &unloadProc;
+        procPtrs[3] = &safeUnloadProc;
 	Tcl_MutexLock(&packageMutex);
-	code = Tcl_FSLoadFile(interp, objv[1], Tcl_DStringValue(&initName),
-		Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc,
-		&loadHandle,&unLoadProcPtr);
+	code = TclLoadFile(interp, objv[1], 4, symbols, procPtrs,
+		&loadHandle, &clientData, &unLoadProcPtr);
 	Tcl_MutexUnlock(&packageMutex);
+        loadHandle = (Tcl_LoadHandle) clientData;
 	if (code != TCL_OK) {
 	    goto done;
 	}
-	if (initProc == NULL) {
+	if (procPtrs[0] /* initProc */ == NULL) {
 	    Tcl_AppendResult(interp, "couldn't find procedure ",
 		    Tcl_DStringValue(&initName), (char *) NULL);
 	    if (unLoadProcPtr != NULL) {
@@ -361,19 +391,23 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 	 */
 
 	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
-	pkgPtr->fileName	= (char *) ckalloc((unsigned)
+	pkgPtr->fileName	   = (char *) ckalloc((unsigned)
 		(strlen(fullFileName) + 1));
 	strcpy(pkgPtr->fileName, fullFileName);
-	pkgPtr->packageName	= (char *) ckalloc((unsigned)
+	pkgPtr->packageName	   = (char *) ckalloc((unsigned)
 		(Tcl_DStringLength(&pkgName) + 1));
 	strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));
-	pkgPtr->loadHandle	= loadHandle;
-	pkgPtr->unLoadProcPtr	= unLoadProcPtr;
-	pkgPtr->initProc	= initProc;
-	pkgPtr->safeInitProc	= safeInitProc;
+	pkgPtr->loadHandle	   = loadHandle;
+	pkgPtr->unLoadProcPtr	   = unLoadProcPtr;
+	pkgPtr->initProc	   = *procPtrs[0];
+	pkgPtr->safeInitProc	   = *procPtrs[1];
+        pkgPtr->unloadProc         = (Tcl_PackageUnloadProc*) *procPtrs[2];
+        pkgPtr->safeUnloadProc     = (Tcl_PackageUnloadProc*) *procPtrs[3];
+        pkgPtr->interpRefCount     = 0;
+        pkgPtr->safeInterpRefCount = 0;
 	Tcl_MutexLock(&packageMutex);
-	pkgPtr->nextPtr		= firstPackagePtr;
-	firstPackagePtr		= pkgPtr;
+	pkgPtr->nextPtr		   = firstPackagePtr;
+	firstPackagePtr		   = pkgPtr;
 	Tcl_MutexUnlock(&packageMutex);
     }
 
@@ -404,6 +438,16 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
      */
 
     if (code == TCL_OK) {
+        /*
+         * Update the proper reference count.
+         */
+        Tcl_MutexLock(&packageMutex);
+        if (Tcl_IsSafe(target)) {
+            ++pkgPtr->safeInterpRefCount;
+        } else {
+            ++pkgPtr->interpRefCount;
+        }
+        Tcl_MutexUnlock(&packageMutex);
 	/*
 	 * Refetch ipFirstPtr: loading the package may have introduced
 	 * additional static packages at the head of the linked list!
@@ -424,6 +468,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
     Tcl_DStringFree(&pkgName);
     Tcl_DStringFree(&initName);
     Tcl_DStringFree(&safeInitName);
+    Tcl_DStringFree(&unloadName);
+    Tcl_DStringFree(&safeUnloadName);
     Tcl_DStringFree(&tmp);
     return code;
 }
@@ -431,6 +477,435 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_UnloadObjCmd --
+ *
+ *	This procedure is invoked to process the "unload" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UnloadObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Interp *target;		/* Which interpreter to unload from. */
+    LoadedPackage *pkgPtr;
+    LoadedPackage *defaultPtr;
+    Tcl_DString pkgName;
+    Tcl_DString tmp;
+    Tcl_PackageUnloadProc *unloadProc;
+    InterpPackage *ipFirstPtr;
+    InterpPackage *ipPtr;
+    int i;
+    int index;
+    int code;
+    int complain = 1;
+    int keepLibrary = 0;
+    int trustedRefCount = -1;
+    int safeRefCount = -1;
+    char *fullFileName = "";
+    char *packageName;
+    static CONST char *options[] = {
+	"-nocomplain", "-keeplibrary", "--", NULL
+    };
+    enum options {
+	UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST
+    };
+
+    for (i = 1; i < objc; i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+		&index) != TCL_OK) {
+	    fullFileName = Tcl_GetString(objv[i]);
+	    if (fullFileName[0] == '-') {
+		/*
+		 * It looks like the command contains an option so signal
+		 * an error
+		 */
+
+		return TCL_ERROR;
+	    } else {
+		/*
+		 * This clearly isn't an option; assume it's the
+		 * filename.  We must clear the error.
+		 */
+
+		Tcl_ResetResult(interp);
+		break;
+	    }
+	}
+	switch (index) {
+	case UNLOAD_NOCOMPLAIN:		/* -nocomplain */
+	    complain = 0;
+	    break;
+	case UNLOAD_KEEPLIB:		/* -keeplibrary */
+	    keepLibrary = 1;
+	    break;
+	case UNLOAD_LAST:		/* -- */
+	    i++;
+	    goto endOfForLoop;
+	}
+    }
+    endOfForLoop:
+    if ((objc-i < 1) || (objc-i > 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?switches? fileName ?packageName? ?interp?");
+	return TCL_ERROR;
+    }
+    if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    
+    fullFileName = Tcl_GetString(objv[i]);
+    Tcl_DStringInit(&pkgName);
+    Tcl_DStringInit(&tmp);
+
+    packageName = NULL;
+    if (objc - i >= 2) {
+	packageName = Tcl_GetString(objv[i+1]);
+	if (packageName[0] == '\0') {
+	    packageName = NULL;
+	}
+    }
+    if ((fullFileName[0] == 0) && (packageName == NULL)) {
+	Tcl_SetResult(interp,
+		"must specify either file name or package name",
+		TCL_STATIC);
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Figure out which interpreter we're going to load the package into.
+     */
+
+    target = interp;
+    if (objc - i == 3) {
+	char *slaveIntName;
+	slaveIntName = Tcl_GetString(objv[i+2]);
+	target = Tcl_GetSlave(interp, slaveIntName);
+	if (target == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Scan through the packages that are currently loaded to see if the
+     * package we want is already loaded.  We'll use a loaded package if
+     * it meets any of the following conditions:
+     *  - Its name and file match the once we're looking for.
+     *  - Its file matches, and we weren't given a name.
+     *  - Its name matches, the file name was specified as empty, and there
+     *    is only no statically loaded package with the same name.
+     */
+
+    Tcl_MutexLock(&packageMutex);
+
+    defaultPtr = NULL;
+    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
+	int namesMatch, filesMatch;
+
+	if (packageName == NULL) {
+	    namesMatch = 0;
+	} else {
+	    Tcl_DStringSetLength(&pkgName, 0);
+	    Tcl_DStringAppend(&pkgName, packageName, -1);
+	    Tcl_DStringSetLength(&tmp, 0);
+	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
+	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
+	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
+	    if (strcmp(Tcl_DStringValue(&tmp),
+		    Tcl_DStringValue(&pkgName)) == 0) {
+		namesMatch = 1;
+	    } else {
+		namesMatch = 0;
+	    }
+	}
+	Tcl_DStringSetLength(&pkgName, 0);
+
+	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
+	if (filesMatch && (namesMatch || (packageName == NULL))) {
+	    break;
+	}
+	if (namesMatch && (fullFileName[0] == 0)) {
+	    defaultPtr = pkgPtr;
+	}
+	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
+	    break;
+	}
+    }
+    Tcl_MutexUnlock(&packageMutex);
+    if (fullFileName[0] == 0) {
+	/*
+	 * It's an error to try unload a static package.
+	 */
+
+	Tcl_AppendResult(interp, "package \"", packageName,
+		"\" is loaded statically and cannot be unloaded",
+		(char *) NULL);
+	code = TCL_ERROR;
+	goto done;
+    }
+    if (pkgPtr == NULL) {
+	/*
+	 * The DLL pointed by the provided filename has never been
+	 * loaded.
+	 */
+
+	Tcl_AppendResult(interp, "file \"", fullFileName,
+		"\" has never been loaded", (char *) NULL);
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Scan through the list of packages already loaded in the target
+     * interpreter.  If the package we want is already loaded there,
+     * then we should proceed with unloading.
+     */
+
+    code = TCL_ERROR;
+    if (pkgPtr != NULL) {
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
+		(Tcl_InterpDeleteProc **) NULL);
+	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+	    if (ipPtr->pkgPtr == pkgPtr) {
+		code = TCL_OK;
+		break;
+	    }
+	}
+    }
+    if (code != TCL_OK) {
+	/*
+	 * The package has not been loaded in this interpreter.
+	 */
+	Tcl_AppendResult(interp, "file \"", fullFileName,
+		"\" has never been loaded in this interpreter", (char *) NULL);
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Ensure that the DLL can be unloaded. If it is a trusted
+     * interpreter, pkgPtr->unloadProc must not be NULL for the DLL to
+     * be unloadable. If the interpreter is a safe one,
+     * pkgPtr->safeUnloadProc must be non-NULL.
+     */
+
+    if (Tcl_IsSafe(target)) {
+	if (pkgPtr->safeUnloadProc == NULL) {
+	    Tcl_AppendResult(interp, "file \"", fullFileName,
+		    "\" cannot be unloaded under a safe interpreter",
+		    (char *) NULL);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+	unloadProc = pkgPtr->safeUnloadProc;
+    } else {
+	if (pkgPtr->unloadProc == NULL) {
+	    Tcl_AppendResult(interp, "file \"", fullFileName,
+		    "\" cannot be unloaded under a trusted interpreter",
+		    (char *) NULL);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+	unloadProc = pkgPtr->unloadProc;
+    }
+
+    /*
+     * We are ready to unload the package. First, evaluate the unload
+     * procedure. If this fails, we cannot proceed with unload.  Also,
+     * we must specify the proper flag to pass to the unload callback.
+     * TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback
+     * should only remove itself from the interpreter; the library
+     * will be unloaded in a future call of unload. In case the
+     * library will be unloaded just after the callback returns,
+     * TCL_UNLOAD_DETACH_FROM_PROCESS is passed.
+     */
+
+    code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
+    if (!keepLibrary) {
+	Tcl_MutexLock(&packageMutex);
+	trustedRefCount = pkgPtr->interpRefCount;
+	safeRefCount = pkgPtr->safeInterpRefCount;
+	Tcl_MutexUnlock(&packageMutex);
+
+	if (Tcl_IsSafe(target)) {
+	    --safeRefCount;
+	} else {
+	    --trustedRefCount;
+	}
+
+	if (safeRefCount <= 0 && trustedRefCount <= 0) {
+	    code = TCL_UNLOAD_DETACH_FROM_PROCESS;
+	}
+    }
+    code = (*unloadProc)(target, code);
+    if (code != TCL_OK) {
+	TclTransferResult(target, code, interp);
+	goto done;
+    }
+
+    /*
+     * The unload procedure executed fine.  Examine the reference
+     * count to see if we unload the DLL.
+     */
+
+    Tcl_MutexLock(&packageMutex);
+    if (Tcl_IsSafe(target)) {
+	--pkgPtr->safeInterpRefCount;
+	/*
+	 * Do not let counter get negative
+	 */
+	if (pkgPtr->safeInterpRefCount < 0) {
+	    pkgPtr->safeInterpRefCount = 0;
+	}
+    } else {
+	--pkgPtr->interpRefCount;
+	/*
+	 * Do not let counter get negative
+	 */
+	if (pkgPtr->interpRefCount < 0) {
+	    pkgPtr->interpRefCount = 0;
+	}
+    }
+    trustedRefCount = pkgPtr->interpRefCount;
+    safeRefCount = pkgPtr->safeInterpRefCount;
+    Tcl_MutexUnlock(&packageMutex);
+
+    code = TCL_OK;
+    if (pkgPtr->safeInterpRefCount <= 0 && pkgPtr->interpRefCount <= 0
+	    && !keepLibrary) {
+	/*
+	 * Unload the shared library from the application memory...
+	 */
+
+#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+	/*
+	 * 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) {
+		Tcl_MutexLock(&packageMutex);
+		(*unLoadProcPtr)(pkgPtr->loadHandle);
+
+		/*
+		 * Remove this library from the loaded library cache.
+		 */
+
+		defaultPtr = pkgPtr;
+		if (defaultPtr == firstPackagePtr) {
+		    firstPackagePtr = pkgPtr->nextPtr;
+		} else {
+		    for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
+			    pkgPtr = pkgPtr->nextPtr) {
+			if (pkgPtr->nextPtr == defaultPtr) {
+			    pkgPtr->nextPtr = defaultPtr->nextPtr;
+			    break;
+			}
+		    }
+		}
+
+		/*
+		 * Remove this library from the interpreter's library
+		 * cache.
+		 */
+
+		ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
+			"tclLoad", (Tcl_InterpDeleteProc **) NULL);
+		ipPtr = ipFirstPtr;
+		if (ipPtr->pkgPtr == defaultPtr) {
+		    ipFirstPtr = ipFirstPtr->nextPtr;
+		} else {
+		    InterpPackage *ipPrevPtr;
+
+		    for (ipPrevPtr = ipPtr; ipPtr != NULL;
+			    ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
+			if (ipPtr->pkgPtr == pkgPtr) {
+			    ipPrevPtr->nextPtr = ipPtr->nextPtr;
+			    break;
+			}
+		    }
+		}
+		Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
+			(ClientData) ipFirstPtr);
+		ckfree(defaultPtr->fileName);
+		ckfree(defaultPtr->packageName);
+		ckfree((char *) defaultPtr);
+		ckfree((char *) ipPtr);
+		Tcl_MutexUnlock(&packageMutex);
+	    } else {
+		Tcl_AppendResult(interp, "file \"", fullFileName,
+			"\" cannot be unloaded: filesystem does not support unloading",
+			(char *) NULL);
+		code = TCL_ERROR;
+	    }
+	}
+#else
+	Tcl_AppendResult(interp, "file \"", fullFileName,
+		"\" cannot be unloaded: unloading disabled", (char *) NULL);
+	code = TCL_ERROR;
+#endif
+    }
+
+    done:
+    Tcl_DStringFree(&pkgName);
+    Tcl_DStringFree(&tmp);
+    if (!complain && code!=TCL_OK) {
+	code = TCL_OK;
+	Tcl_ResetResult(interp);
+    }
+    if (code == TCL_OK) {
+#if 0
+	/*
+	 * Result of [unload] was not documented in TIP#100, so force
+	 * to be the empty string by commenting this out.  DKF.
+	 */
+
+	Tcl_Obj *resultObjPtr, *objPtr[2];
+
+	/*
+	 * Our result is the two reference counts.
+	 */
+
+	objPtr[0] = Tcl_NewIntObj(trustedRefCount);
+	objPtr[1] = Tcl_NewIntObj(safeRefCount);
+	if (objPtr[0] == NULL || objPtr[1] == NULL) {
+	    if (objPtr[0]) {
+		Tcl_DecrRefCount(objPtr[0]);
+	    }
+	    if (objPtr[1]) {
+		Tcl_DecrRefCount(objPtr[1]);
+	    }
+	} else {
+	    resultObjPtr = Tcl_NewListObj(2, objPtr);
+	    if (resultObjPtr != NULL) {
+		Tcl_SetObjResult(interp, resultObjPtr);
+	    }
+	}
+#endif
+    }
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_StaticPackage --
  *
  *	This procedure is invoked to indicate that a particular
diff --git a/tests/unload.test b/tests/unload.test
new file mode 100644
index 0000000..00d6970
--- /dev/null
+++ b/tests/unload.test
@@ -0,0 +1,223 @@
+# Commands covered:  unload
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2003-2004 by Georgios Petasis
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: unload.test,v 1.1 2004/02/24 22:58:48 dkf Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2
+    namespace import -force ::tcltest::*
+}
+
+# Figure out what extension is used for shared libraries on this
+# platform.
+
+if {$tcl_platform(platform) == "macintosh"} {
+    puts "can't run dynamic library tests on macintosh machines"
+    ::tcltest::cleanupTests
+    return
+}
+
+# Tests require the existence of one of the DLLs in the dltest directory.
+set ext [info sharedlibextension]
+set testDir [file join [file dirname [info nameofexecutable]] dltest]
+set x [file join $testDir pkgua$ext]
+set dll "[file tail $x]Required"
+::tcltest::testConstraint $dll [file readable $x]
+
+# Tests also require that this DLL has not already been loaded.
+set loaded "[file tail $x]Loaded"
+set alreadyLoaded [info loaded]
+::tcltest::testConstraint $loaded \
+	[expr {![string match *pkgua* $alreadyLoaded]}]
+
+set alreadyTotalLoaded [info loaded]
+
+# Certain tests require the 'teststaticpkg' command from tcltest
+::tcltest::testConstraint teststaticpkg \
+	[string compare {} [info commands teststaticpkg]]
+
+# Basic tests: parameter testing...
+test unload-1.1 {basic errors} {} {
+    list [catch {unload} msg] $msg
+} "1 {wrong \# args: should be \"unload ?switches? fileName ?packageName? ?interp?\"}"
+test unload-1.2 {basic errors} {} {
+    list [catch {unload a b c d} msg] $msg
+} "1 {wrong \# args: should be \"unload ?switches? fileName ?packageName? ?interp?\"}"
+test unload-1.3 {basic errors} {} {
+    list [catch {unload a b foobar} msg] $msg
+} {1 {could not find interpreter "foobar"}}
+test unload-1.4 {basic errors} {} {
+    list [catch {unload {}} msg] $msg
+} {1 {must specify either file name or package name}}
+test unload-1.5 {basic errors} {} {
+    list [catch {unload {} {}} msg] $msg
+} {1 {must specify either file name or package name}}
+test unload-1.6 {basic errors} {} {
+    list [catch {unload {} Unknown} msg] $msg
+} {1 {package "Unknown" is loaded statically and cannot be unloaded}}
+test unload-1.7 {-nocomplain switch} {} {
+    list [unload -nocomplain {} Unknown]
+} {{}}
+
+set pkgua_loaded {}
+set pkgua_detached {}
+set pkgua_unloaded {}
+# Tests for loading/unloading in trusted (non-safe) interpreters...
+test unload-2.1 {basic loading of non-unloadable package, with guess for package name} [list $dll $loaded] {
+    load [file join $testDir pkga$ext]
+    list [pkga_eq abc def] [lsort [info commands pkga_*]]
+} {0 {pkga_eq pkga_quote}}
+test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] {
+    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
+	    [load [file join $testDir pkgua$ext]] \
+	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
+	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
+} {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}}
+test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} [list $dll $loaded] {
+    list [catch {unload [file join $testDir pkga$ext]} msg] \
+	    [string map [list [file join $testDir pkga$ext] file] $msg]
+} {1 {file "file" cannot be unloaded under a trusted interpreter}}
+test unload-2.4 {basic unloading of unloadable package, with guess for package name} [list $dll $loaded] {
+    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
+	    [unload [file join $testDir pkgua$ext]] \
+	    [info commands pkgua_*] \
+	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
+} {. {} {} {} {} . . .}
+test unload-2.5 {reloading of unloaded package, with guess for package name} [list $dll $loaded] {
+    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
+	    [load [file join $testDir pkgua$ext]] \
+	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
+	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
+} {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
+test unload-2.6 {basic unloading of re-loaded package, with guess for package name} [list $dll $loaded] {
+    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
+	    [unload [file join $testDir pkgua$ext]] \
+	    [info commands pkgua_*] \
+	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
+} {.. . . {} {} .. .. ..}
+
+# Tests for loading/unloading in safe interpreters...
+interp create -safe child
+child eval {
+    set pkgua_loaded {}
+    set pkgua_detached {}
+    set pkgua_unloaded {}
+}
+test unload-3.1 {basic loading of non-unloadable package in a safe interpreter, with package name conversion} \
+	[list $dll $loaded] {
+    load [file join $testDir pkgb$ext] pKgB child
+    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
+         [catch {pkgb_sub 12 10} msg2] $msg2
+} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
+test unload-3.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \
+	[list $dll $loaded] {
+    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
+	    [load [file join $testDir pkgua$ext] pKgUA child] \
+	    [child eval pkgua_eq abc def] \
+	    [lsort [child eval info commands pkgua_*]] \
+	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
+} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
+test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} \
+	[list $dll $loaded] {
+    list [catch {unload [file join $testDir pkga$ext] {} child} msg] \
+         [string map [list [file join $testDir pkga$ext] file] $msg]
+} {1 {file "file" has never been loaded in this interpreter}}
+test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} \
+	[list $dll $loaded] {
+    list [catch {unload [file join $testDir pkgb$ext] {} child} msg] \
+         [string map [list [file join $testDir pkgb$ext] file] $msg]
+} {1 {file "file" cannot be unloaded under a safe interpreter}}
+test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} \
+	[list $dll $loaded] {
+    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
+	    [unload [file join $testDir pkgua$ext] {} child] \
+	    [child eval info commands pkgua_*] \
+	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
+} {{. {} {}} {} {} {. . .}}
+test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} \
+	[list $dll $loaded] {
+    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
+	    [load [file join $testDir pkgua$ext] {} child] \
+	    [child eval pkgua_eq abc def] \
+	    [lsort [child eval info commands pkgua_*]] \
+	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
+} {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
+test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} \
+	[list $dll $loaded] {
+    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
+	    [unload [file join $testDir pkgua$ext] pKgUa child] \
+	    [child eval info commands pkgua_*] \
+	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
+} {{.. . .} {} {} {.. .. ..}}
+
+# Tests for loading/unloading of a package among multiple interpreters...
+interp create child-trusted
+child-trusted eval {
+    set pkgua_loaded {}
+    set pkgua_detached {}
+    set pkgua_unloaded {}
+}
+## Load package in main trusted interpreter...
+test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} \
+	[list $dll $loaded] {
+    list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
+	    [load [file join $testDir pkgua$ext]] \
+	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
+	    [list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
+} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
+## Load package in child-safe interpreter...
+test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \
+	[list $dll $loaded] {
+    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
+	    [load [file join $testDir pkgua$ext] pKgUA child] \
+	    [child eval pkgua_eq abc def] \
+	    [lsort [child eval info commands pkgua_*]] \
+	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
+} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
+## Load package in child-trusted interpreter...
+test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} \
+	[list $dll $loaded] {
+    list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
+	    [load [file join $testDir pkgua$ext] pkguA child-trusted] \
+	    [child-trusted eval pkgua_eq abc def] \
+	    [lsort [child-trusted eval info commands pkgua_*]] \
+	    [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
+} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
+## Unload the package from the main trusted interpreter...
+test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} \
+	[list $dll $loaded] {
+    list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
+	    [unload [file join $testDir pkgua$ext]] \
+	    [info commands pkgua_*] \
+	    [list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
+} {{... .. ..} {} {} {... ... ..}}
+## Unload the package from the child safe interpreter...
+test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
+	[list $dll $loaded] {
+    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
+	    [unload [file join $testDir pkgua$ext] {} child] \
+	    [child eval info commands pkgua_*] \
+	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
+} {{... .. ..} {} {} {... ... ..}}
+## Unload the package from the child trusted interpreter...
+test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
+	[list $dll $loaded] {
+    list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
+	    [unload [file join $testDir pkgua$ext] {} child-trusted] \
+	    [child-trusted eval info commands pkgua_*] \
+	    [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
+} {{. {} {}} {} {} {. . .}}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 1de7db7..81d931f 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.133 2003/10/21 00:23:34 kennykb Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.134 2004/02/24 22:58:48 dkf Exp $
 
 VERSION 		= @TCL_VERSION@
 MAJOR_VERSION		= @TCL_MAJOR_VERSION@
@@ -90,7 +90,8 @@ CFLAGS_OPTIMIZE		= @CFLAGS_OPTIMIZE@
 #CFLAGS			= $(CFLAGS_DEBUG)
 #CFLAGS			= $(CFLAGS_OPTIMIZE)
 #CFLAGS			= $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
-CFLAGS			= @CFLAGS@ @CFLAGS_DEFAULT@ -DTCL_DBGX=$(TCL_DBGX)
+CFLAGS			= @CFLAGS@ @CFLAGS_DEFAULT@ -DTCL_DBGX=$(TCL_DBGX) \
+                          -DTCL_UNLOAD_DLLS=1
 
 # Flags to pass to the linker
 LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in
index bd30298..953ed18 100644
--- a/unix/dltest/Makefile.in
+++ b/unix/dltest/Makefile.in
@@ -1,7 +1,7 @@
 # This Makefile is used to create several test cases for Tcl's load
 # command.  It also illustrates how to take advantage of configuration
 # exported by Tcl to set up Makefiles for shared libraries.
-# RCS: @(#) $Id: Makefile.in,v 1.12 2003/04/03 22:13:00 mdejong Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.13 2004/02/24 22:58:48 dkf Exp $
 
 TCL_DBGX =		@TCL_DBGX@
 CC = @CC@
@@ -21,7 +21,7 @@ CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
 CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
 	${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}
 
-all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX}
+all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX}
 	@touch ../dltest.marker
 
 pkga${SHLIB_SUFFIX}: $(SRC_DIR)/pkga.c
@@ -44,6 +44,10 @@ pkge${SHLIB_SUFFIX}: $(SRC_DIR)/pkge.c
 	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c
 	${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${SHLIB_LD_LIBS}
 
+pkgua${SHLIB_SUFFIX}: $(SRC_DIR)/pkgua.c
+	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c
+	${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}
+
 clean:
 	rm -f *.o *${SHLIB_SUFFIX} config.cache config.log config.status
 	rm -f lib.exp ../dltest.marker
diff --git a/unix/dltest/README b/unix/dltest/README
index 12aa8be..3d85a9c 100644
--- a/unix/dltest/README
+++ b/unix/dltest/README
@@ -1,6 +1,6 @@
 This directory contains several files for testing Tcl's dynamic
-loading capabilities.  If shared libraries are supported then
-the build system in the parent directory will create
+loading/unloading capabilities.  If shared libraries are supported
+then the build system in the parent directory will create
 the shared libs and load them into the tcltest executable.
 
-RCS: @(#) $Id: README,v 1.3 2001/12/19 11:03:20 mdejong Exp $
+RCS: @(#) $Id: README,v 1.4 2004/02/24 22:58:48 dkf Exp $
diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c
new file mode 100644
index 0000000..b4c9b6d
--- /dev/null
+++ b/unix/dltest/pkgua.c
@@ -0,0 +1,336 @@
+/* 
+ * pkgua.c --
+ *
+ *	This file contains a simple Tcl package "pkgua" that is intended
+ *	for testing the Tcl dynamic unloading facilities.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 2004 Georgios Petasis
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: pkgua.c,v 1.1 2004/02/24 22:58:48 dkf Exp $
+ */
+
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int    PkguaEqObjCmd _ANSI_ARGS_((ClientData clientData,
+		Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+static int    PkguaQuoteObjCmd _ANSI_ARGS_((ClientData clientData,
+		Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+
+/*
+ * In the following hash table we are going to store a struct that
+ * holds all the command tokens created by Tcl_CreateObjCommand in an
+ * interpreter, indexed by the interpreter. In this way, we can find
+ * which command tokens we have registered in a specific interpreter,
+ * in order to unload them. We need to keep the various command tokens
+ * we have registered, as they are the only safe way to unregister our
+ * registered commands, even if they have been renamed.
+ *
+ * Note that this code is utterly single-threaded.
+ */
+
+static Tcl_HashTable interpTokenMap;
+static int interpTokenMapInitialised = 0;
+#define MAX_REGISTERED_COMMANDS 2
+
+
+static int
+PkguaInitTokensHashTable(void)
+{
+    if (interpTokenMapInitialised) {
+	return;
+    }
+    Tcl_InitHashTable(&interpTokenMap, TCL_ONE_WORD_KEYS);
+    interpTokenMapInitialised = 1;
+};
+
+static int
+PkguaFreeTokensHashTable(void)
+{
+    Tcl_HashSearch search;
+    Tcl_HashEntry *entryPtr;
+
+    for (entryPtr = Tcl_FirstHashEntry(&interpTokenMap, &search);
+	    entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+	Tcl_Free((char *) Tcl_GetHashValue(entryPtr));
+    }
+    interpTokenMapInitialised = 0;
+};
+
+static Tcl_Command *
+PkguaInterpToTokens(interp)
+    Tcl_Interp *interp;
+{
+    int newEntry;
+    Tcl_Command *cmdTokens;
+    Tcl_HashEntry *entryPtr =
+	    Tcl_CreateHashEntry(&interpTokenMap, (char *) interp, &newEntry);
+
+    if (newEntry) {
+	cmdTokens = (Tcl_Command *)
+		Tcl_Alloc(sizeof(Tcl_Command) * (MAX_REGISTERED_COMMANDS+1));
+	for (newEntry=0 ; newEntry<MAX_REGISTERED_COMMANDS+1 ; ++newEntry) {
+	    cmdTokens[newEntry] = NULL;
+	}
+	Tcl_SetHashValue(entryPtr, (ClientData) cmdTokens);
+    } else {
+	cmdTokens = (Tcl_Command *) Tcl_GetHashValue(entryPtr);
+    }
+    return cmdTokens;
+};
+
+static void
+PkguaDeleteTokens(interp)
+    Tcl_Interp *interp;
+{
+    Tcl_HashEntry *entryPtr =
+	    Tcl_FindHashEntry(&interpTokenMap, (char *) interp);
+
+    if (entryPtr) {
+	Tcl_Free((char *) Tcl_GetHashValue(entryPtr));
+	Tcl_DeleteHashEntry(entryPtr);
+    }
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PkguaEqObjCmd --
+ *
+ *	This procedure is invoked to process the "pkgua_eq" Tcl command.
+ *	It expects two arguments and returns 1 if they are the same,
+ *	0 if they are different.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PkguaEqObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj * CONST objv[];	/* Argument objects. */
+{
+    int result;
+    CONST char *str1, *str2;
+    int len1, len2, n;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv,  "string1 string2");
+	return TCL_ERROR;
+    }
+
+    str1 = Tcl_GetStringFromObj(objv[1], &len1);
+    str2 = Tcl_GetStringFromObj(objv[2], &len2);
+    if (len1 == len2) {
+	result = (Tcl_UtfNcmp(str1, str2, len1) == 0);
+    } else {
+	result = 0;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PkguaQuoteObjCmd --
+ *
+ *	This procedure is invoked to process the "pkgua_quote" Tcl command.
+ *	It expects one argument, which it returns as result.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PkguaQuoteObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj * CONST objv[];	/* Argument strings. */
+{
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value");
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, objv[1]);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgua_Init --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgua_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    int code, cmdIndex = 0;
+    Tcl_Command *cmdTokens;
+
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Initialise our Hash table, where we store the registered
+     * command tokens for each interpreter.
+     */
+
+    PkguaInitTokensHashTable();
+
+    code = Tcl_PkgProvide(interp, "Pkgua", "1.0");
+    if (code != TCL_OK) {
+	return code;
+    }
+
+    Tcl_SetVar(interp, "::pkgua_loaded", ".", TCL_APPEND_VALUE);
+
+    cmdTokens = PkguaInterpToTokens(interp);
+    cmdTokens[cmdIndex++] =
+	Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd,
+			     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    cmdTokens[cmdIndex++] =
+	Tcl_CreateObjCommand(interp, "pkgua_quote", PkguaQuoteObjCmd,
+			     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgua_SafeInit --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an unsafe interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgua_SafeInit(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    return Pkgua_Init(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgua_Unload --
+ *
+ *	This is a package unloading initialization procedure, which is
+ *	called by Tcl when this package is to be unloaded form an
+ *	interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgua_Unload(interp, flags)
+    Tcl_Interp *interp;		/* Interpreter from which the package is
+				 * to be unloaded. */
+    int flags;			/* Flags passed by the unloading mechanism */
+{
+    int code, cmdIndex;
+    Tcl_Command *cmdTokens = PkguaInterpToTokens(interp);
+
+    for (cmdIndex=0 ; cmdIndex<MAX_REGISTERED_COMMANDS ; cmdIndex++) {
+	if (cmdTokens[cmdIndex] == NULL) {
+	    continue;
+	}
+	code = Tcl_DeleteCommandFromToken(interp, cmdTokens[cmdIndex]);
+	if (code != TCL_OK) {
+	    return code;
+	}
+    }
+
+    PkguaDeleteTokens(interp);
+
+    Tcl_SetVar(interp, "::pkgua_detached", ".", TCL_APPEND_VALUE);
+
+    if (flags == TCL_UNLOAD_DETACH_FROM_PROCESS) {
+	/*
+	 * Tcl is ready to detach this library from the running
+	 * application. We should free all the memory that is not
+	 * related to any interpreter.
+	 */
+	PkguaFreeTokensHashTable();
+
+	Tcl_SetVar(interp, "::pkgua_unloaded", ".", TCL_APPEND_VALUE);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgua_SafeUnload --
+ *
+ *	This is a package unloading initialization procedure, which is
+ *	called by Tcl when this package is to be unloaded form an
+ *	interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgua_SafeUnload(interp, flags)
+    Tcl_Interp *interp;		/* Interpreter from which the package is
+				 * to be unloaded. */
+    int flags;			/* Flags passed by the unloading mechanism */
+{
+    return Pkgua_Unload(interp, flags);
+}