diff options
Diffstat (limited to 'unix/tclLoadDl.c')
| -rw-r--r-- | unix/tclLoadDl.c | 73 |
1 files changed, 48 insertions, 25 deletions
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index e38c280..9084089 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -6,8 +6,8 @@ * * 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. + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" @@ -33,6 +33,14 @@ #endif /* + * Static procedures defined within this file. + */ + +static void * FindSymbol(Tcl_Interp *interp, + Tcl_LoadHandle loadHandle, const char *symbol); +static void UnloadFile(Tcl_LoadHandle loadHandle); + +/* *--------------------------------------------------------------------------- * * TclpDlopen -- @@ -64,7 +72,8 @@ TclpDlopen( * file. */ { void *handle; - CONST char *native; + Tcl_LoadHandle newHandle; + const char *native; /* * First try the full path the user gave us. This is particularly @@ -85,7 +94,7 @@ TclpDlopen( */ Tcl_DString ds; - char *fileName = Tcl_GetString(pathPtr); + const char *fileName = Tcl_GetString(pathPtr); native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); /* @@ -107,16 +116,20 @@ TclpDlopen( Tcl_GetString(pathPtr), "\": ", errorStr, NULL); return TCL_ERROR; } + newHandle = ckalloc(sizeof(*newHandle)); + newHandle->clientData = handle; + newHandle->findSymbolProcPtr = &FindSymbol; + newHandle->unloadFileProcPtr = &UnloadFile; + *unloadProcPtr = &UnloadFile; + *loadHandle = newHandle; - *unloadProcPtr = &TclpUnloadFile; - *loadHandle = (Tcl_LoadHandle) handle; return TCL_OK; } /* *---------------------------------------------------------------------- * - * TclpFindSymbol -- + * FindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). @@ -129,16 +142,21 @@ TclpDlopen( *---------------------------------------------------------------------- */ -Tcl_PackageInitProc * -TclpFindSymbol( +static void * +FindSymbol( Tcl_Interp *interp, /* Place to put error messages. */ Tcl_LoadHandle loadHandle, /* Value from TcpDlopen(). */ - CONST char *symbol) /* Symbol to look up. */ + const char *symbol) /* Symbol to look up. */ { - CONST char *native; - Tcl_DString newName, ds; - VOID *handle = (VOID*)loadHandle; - Tcl_PackageInitProc *proc; + const char *native; /* Name of the library to be loaded, in + * system encoding */ + Tcl_DString newName, ds; /* Buffers for converting the name to + * system encoding and prepending an + * underscore*/ + void *handle = (void *) loadHandle->clientData; + /* Native handle to the loaded library */ + void *proc; /* Address corresponding to the resolved + * symbol */ /* * Some platforms still add an underscore to the beginning of symbol @@ -147,25 +165,29 @@ TclpFindSymbol( */ native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); - proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */ - native); + proc = dlsym(handle, native); /* INTL: Native. */ if (proc == NULL) { Tcl_DStringInit(&newName); Tcl_DStringAppend(&newName, "_", 1); native = Tcl_DStringAppend(&newName, native, -1); - proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */ - native); + proc = dlsym(handle, native); /* INTL: Native. */ Tcl_DStringFree(&newName); } Tcl_DStringFree(&ds); - + if (proc == NULL && interp != NULL) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\": ", + dlerror(), NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, + NULL); + } return proc; } /* *---------------------------------------------------------------------- * - * TclpUnloadFile -- + * UnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling @@ -180,16 +202,17 @@ TclpFindSymbol( *---------------------------------------------------------------------- */ -void -TclpUnloadFile( +static void +UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - void *handle; + void *handle = loadHandle->clientData; - handle = (void *) loadHandle; + fprintf(stderr, "dlclose???\n"); fflush(stderr); dlclose(handle); + ckfree(loadHandle); } /* @@ -214,7 +237,7 @@ TclpUnloadFile( int TclGuessPackageName( - CONST char *fileName, /* Name of file containing package (already + const char *fileName, /* Name of file containing package (already * translated to local form if needed). */ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package * name to this if possible. */ |