Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/win/tclWinLoad.c @ 25

Last change on this file since 25 was 25, checked in by landauf, 16 years ago

added tcl to libs

File size: 6.6 KB
Line 
1/*
2 * tclWinLoad.c --
3 *
4 *      This function provides a version of the TclLoadFile that works with
5 *      the Windows "LoadLibrary" and "GetProcAddress" API for dynamic
6 *      loading.
7 *
8 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
9 *
10 * See the file "license.terms" for information on usage and redistribution of
11 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * RCS: @(#) $Id: tclWinLoad.c,v 1.20 2007/04/20 06:11:00 kennykb Exp $
14 */
15
16#include "tclWinInt.h"
17
18
19/*
20 *----------------------------------------------------------------------
21 *
22 * TclpDlopen --
23 *
24 *      Dynamically loads a binary code file into memory and returns a handle
25 *      to the new code.
26 *
27 * Results:
28 *      A standard Tcl completion code. If an error occurs, an error message
29 *      is left in the interp's result.
30 *
31 * Side effects:
32 *      New code suddenly appears in memory.
33 *
34 *----------------------------------------------------------------------
35 */
36
37int
38TclpDlopen(
39    Tcl_Interp *interp,         /* Used for error reporting. */
40    Tcl_Obj *pathPtr,           /* Name of the file containing the desired
41                                 * code (UTF-8). */
42    Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
43                                 * file which will be passed back to
44                                 * (*unloadProcPtr)() to unload the file. */
45    Tcl_FSUnloadFileProc **unloadProcPtr)
46                                /* Filled with address of Tcl_FSUnloadFileProc
47                                 * function which should be used for this
48                                 * file. */
49{
50    HINSTANCE handle;
51    CONST TCHAR *nativeName;
52
53    /*
54     * First try the full path the user gave us. This is particularly
55     * important if the cwd is inside a vfs, and we are trying to load using a
56     * relative path.
57     */
58
59    nativeName = Tcl_FSGetNativePath(pathPtr);
60    handle = (*tclWinProcs->loadLibraryProc)(nativeName);
61    if (handle == NULL) {
62        /*
63         * Let the OS loader examine the binary search path for whatever
64         * string the user gave us which hopefully refers to a file on the
65         * binary path.
66         */
67
68        Tcl_DString ds;
69        char *fileName = Tcl_GetString(pathPtr);
70
71        nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
72        handle = (*tclWinProcs->loadLibraryProc)(nativeName);
73        Tcl_DStringFree(&ds);
74    }
75
76    *loadHandle = (Tcl_LoadHandle) handle;
77
78    if (handle == NULL) {
79        DWORD lastError = GetLastError();
80
81#if 0
82        /*
83         * It would be ideal if the FormatMessage stuff worked better, but
84         * unfortunately it doesn't seem to want to...
85         */
86
87        LPTSTR lpMsgBuf;
88        char *buf;
89        int size;
90
91        size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
92                FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
93                (LPTSTR) &lpMsgBuf, 0, NULL);
94        buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
95        sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
96#endif
97
98        Tcl_AppendResult(interp, "couldn't load library \"",
99                Tcl_GetString(pathPtr), "\": ", NULL);
100
101        /*
102         * Check for possible DLL errors. This doesn't work quite right,
103         * because Windows seems to only return ERROR_MOD_NOT_FOUND for just
104         * about any problem, but it's better than nothing. It'd be even
105         * better if there was a way to get what DLLs
106         */
107
108        switch (lastError) {
109        case ERROR_MOD_NOT_FOUND:
110        case ERROR_DLL_NOT_FOUND:
111            Tcl_AppendResult(interp, "this library or a dependent library"
112                    " could not be found in library path", NULL);
113            break;
114        case ERROR_PROC_NOT_FOUND:
115            Tcl_AppendResult(interp, "A function specified in the import"
116                    " table could not be resolved by the system.  Windows"
117                    " is not telling which one, I'm sorry.", NULL);
118            break;
119        case ERROR_INVALID_DLL:
120            Tcl_AppendResult(interp, "this library or a dependent library"
121                    " is damaged", NULL);
122            break;
123        case ERROR_DLL_INIT_FAILED:
124            Tcl_AppendResult(interp, "the library initialization"
125                    " routine failed", NULL);
126            break;
127        default:
128            TclWinConvertError(lastError);
129            Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
130        }
131        return TCL_ERROR;
132    } else {
133        *unloadProcPtr = &TclpUnloadFile;
134    }
135    return TCL_OK;
136}
137
138/*
139 *----------------------------------------------------------------------
140 *
141 * TclpFindSymbol --
142 *
143 *      Looks up a symbol, by name, through a handle associated with a
144 *      previously loaded piece of code (shared library).
145 *
146 * Results:
147 *      Returns a pointer to the function associated with 'symbol' if it is
148 *      found. Otherwise returns NULL and may leave an error message in the
149 *      interp's result.
150 *
151 *----------------------------------------------------------------------
152 */
153
154Tcl_PackageInitProc *
155TclpFindSymbol(
156    Tcl_Interp *interp,
157    Tcl_LoadHandle loadHandle,
158    CONST char *symbol)
159{
160    Tcl_PackageInitProc *proc = NULL;
161    HINSTANCE handle = (HINSTANCE)loadHandle;
162
163    /*
164     * For each symbol, check for both Symbol and _Symbol, since Borland
165     * generates C symbols with a leading '_' by default.
166     */
167
168    proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
169    if (proc == NULL) {
170        Tcl_DString ds;
171
172        Tcl_DStringInit(&ds);
173        Tcl_DStringAppend(&ds, "_", 1);
174        symbol = Tcl_DStringAppend(&ds, symbol, -1);
175        proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
176        Tcl_DStringFree(&ds);
177    }
178    return proc;
179}
180
181/*
182 *----------------------------------------------------------------------
183 *
184 * TclpUnloadFile --
185 *
186 *      Unloads a dynamically loaded binary code file from memory. Code
187 *      pointers in the formerly loaded file are no longer valid after calling
188 *      this function.
189 *
190 * Results:
191 *      None.
192 *
193 * Side effects:
194 *      Code removed from memory.
195 *
196 *----------------------------------------------------------------------
197 */
198
199void
200TclpUnloadFile(
201    Tcl_LoadHandle loadHandle)  /* loadHandle returned by a previous call to
202                                 * TclpDlopen(). The loadHandle is a token
203                                 * that represents the loaded file. */
204{
205    HINSTANCE handle;
206
207    handle = (HINSTANCE) loadHandle;
208    FreeLibrary(handle);
209}
210
211/*
212 *----------------------------------------------------------------------
213 *
214 * TclGuessPackageName --
215 *
216 *      If the "load" command is invoked without providing a package name,
217 *      this function is invoked to try to figure it out.
218 *
219 * Results:
220 *      Always returns 0 to indicate that we couldn't figure out a package
221 *      name; generic code will then try to guess the package from the file
222 *      name. A return value of 1 would have meant that we figured out the
223 *      package name and put it in bufPtr.
224 *
225 * Side effects:
226 *      None.
227 *
228 *----------------------------------------------------------------------
229 */
230
231int
232TclGuessPackageName(
233    CONST char *fileName,       /* Name of file containing package (already
234                                 * translated to local form if needed). */
235    Tcl_DString *bufPtr)        /* Initialized empty dstring. Append package
236                                 * name to this if possible. */
237{
238    return 0;
239}
240
241/*
242 * Local Variables:
243 * mode: c
244 * c-basic-offset: 4
245 * fill-column: 78
246 * End:
247 */
Note: See TracBrowser for help on using the repository browser.