URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
[/] [or1k/] [trunk/] [insight/] [tcl/] [unix/] [tclLoadDl.c] - Rev 1774
Go to most recent revision | Compare with Previous | Blame | View Log
/* * tclLoadDl.c -- * * This procedure provides a version of the TclLoadFile that * works with the "dlopen" and "dlsym" library procedures for * dynamic loading. * * Copyright (c) 1995 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: tclLoadDl.c,v 1.1.1.1 2002-01-16 10:25:37 markom Exp $ */ #include "tclInt.h" #ifdef NO_DLFCN_H # include "../compat/dlfcn.h" #else # include <dlfcn.h> #endif /* * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined * and this argument to dlopen must always be 1. The RTLD_GLOBAL * flag is needed on some systems (e.g. SCO and UnixWare) but doesn't * exist on others; if it doesn't exist, set it to 0 so it has no effect. */ #ifndef RTLD_NOW # define RTLD_NOW 1 #endif #ifndef RTLD_GLOBAL # define RTLD_GLOBAL 0 #endif /* *---------------------------------------------------------------------- * * TclLoadFile -- * * Dynamically loads a binary code file into memory and returns * the addresses of two procedures within that file, if they * are defined. * * Results: * A standard Tcl completion code. If an error occurs, an error * message is left in interp->result. *proc1Ptr and *proc2Ptr * are filled in with the addresses of the symbols given by * *sym1 and *sym2, or NULL if those symbols can't be found. * * Side effects: * New code suddenly appears in memory. * *---------------------------------------------------------------------- */ int TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr) Tcl_Interp *interp; /* Used for error reporting. */ char *fileName; /* Name of the file containing the desired * code. */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ Tcl_PackageInitProc **proc1Ptr, **proc2Ptr; /* Where to return the addresses corresponding * to sym1 and sym2. */ { VOID *handle; Tcl_DString newName; handle = dlopen(fileName, RTLD_NOW | RTLD_GLOBAL); if (handle == NULL) { Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", dlerror(), (char *) NULL); return TCL_ERROR; } /* * Some platforms still add an underscore to the beginning of symbol * names. If we can't find a name without an underscore, try again * with the underscore. */ *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, (char *) sym1); if (*proc1Ptr == NULL) { Tcl_DStringInit(&newName); Tcl_DStringAppend(&newName, "_", 1); Tcl_DStringAppend(&newName, sym1, -1); *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, Tcl_DStringValue(&newName)); Tcl_DStringFree(&newName); } *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, (char *) sym2); if (*proc2Ptr == NULL) { Tcl_DStringInit(&newName); Tcl_DStringAppend(&newName, "_", 1); Tcl_DStringAppend(&newName, sym2, -1); *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, Tcl_DStringValue(&newName)); Tcl_DStringFree(&newName); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package * name, this procedure is invoked to try to figure it out. * * Results: * Always returns 0 to indicate that we couldn't figure out a * package name; generic code will then try to guess the package * from the file name. A return value of 1 would have meant that * we figured out the package name and put it in bufPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclGuessPackageName(fileName, bufPtr) 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. */ { return 0; }
Go to most recent revision | Compare with Previous | Blame | View Log