/[dtapublic]/projs/trunk/shared_source/tcl_base/tclwinload.c
ViewVC logotype

Contents of /projs/trunk/shared_source/tcl_base/tclwinload.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 42 - (show annotations) (download)
Fri Oct 14 01:50:00 2016 UTC (8 years, 1 month ago) by dashley
File MIME type: text/plain
File size: 6216 byte(s)
Move shared source code to commonize.
1 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwinload.c,v 1.1.1.1 2001/06/13 04:49:20 dtashley Exp $ */
2
3 /*
4 * tclWinLoad.c --
5 *
6 * This procedure provides a version of the TclLoadFile that
7 * works with the Windows "LoadLibrary" and "GetProcAddress"
8 * API for dynamic loading.
9 *
10 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
11 *
12 * See the file "license.terms" for information on usage and redistribution
13 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14 *
15 * RCS: @(#) $Id: tclwinload.c,v 1.1.1.1 2001/06/13 04:49:20 dtashley Exp $
16 */
17
18 #include "tclWinInt.h"
19
20
21 /*
22 *----------------------------------------------------------------------
23 *
24 * TclpLoadFile --
25 *
26 * Dynamically loads a binary code file into memory and returns
27 * the addresses of two procedures within that file, if they
28 * are defined.
29 *
30 * Results:
31 * A standard Tcl completion code. If an error occurs, an error
32 * message is left in the interp's result.
33 *
34 * Side effects:
35 * New code suddenly appears in memory.
36 *
37 *----------------------------------------------------------------------
38 */
39
40 int
41 TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
42 Tcl_Interp *interp; /* Used for error reporting. */
43 char *fileName; /* Name of the file containing the desired
44 * code. */
45 char *sym1, *sym2; /* Names of two procedures to look up in
46 * the file's symbol table. */
47 Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
48 /* Where to return the addresses corresponding
49 * to sym1 and sym2. */
50 ClientData *clientDataPtr; /* Filled with token for dynamically loaded
51 * file which will be passed back to
52 * TclpUnloadFile() to unload the file. */
53 {
54 HINSTANCE handle;
55 TCHAR *nativeName;
56 Tcl_DString ds;
57
58 nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
59 handle = (*tclWinProcs->loadLibraryProc)(nativeName);
60 Tcl_DStringFree(&ds);
61
62 *clientDataPtr = (ClientData) handle;
63
64 if (handle == NULL) {
65 DWORD lastError = GetLastError();
66 #if 0
67 /*
68 * It would be ideal if the FormatMessage stuff worked better,
69 * but unfortunately it doesn't seem to want to...
70 */
71 LPTSTR lpMsgBuf;
72 char *buf;
73 int size;
74 size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
75 FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
76 (LPTSTR) &lpMsgBuf, 0, NULL);
77 buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
78 sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
79 #endif
80 Tcl_AppendResult(interp, "couldn't load library \"",
81 fileName, "\": ", (char *) NULL);
82 /*
83 * Check for possible DLL errors. This doesn't work quite right,
84 * because Windows seems to only return ERROR_MOD_NOT_FOUND for
85 * just about any problem, but it's better than nothing. It'd be
86 * even better if there was a way to get what DLLs
87 */
88 switch (lastError) {
89 case ERROR_MOD_NOT_FOUND:
90 case ERROR_DLL_NOT_FOUND:
91 Tcl_AppendResult(interp, "this library or a dependent library",
92 " could not be found in library path", (char *)
93 NULL);
94 break;
95 case ERROR_INVALID_DLL:
96 Tcl_AppendResult(interp, "this library or a dependent library",
97 " is damaged", (char *) NULL);
98 break;
99 case ERROR_DLL_INIT_FAILED:
100 Tcl_AppendResult(interp, "the library initialization",
101 " routine failed", (char *) NULL);
102 break;
103 default:
104 TclWinConvertError(lastError);
105 Tcl_AppendResult(interp, Tcl_PosixError(interp),
106 (char *) NULL);
107 }
108 return TCL_ERROR;
109 }
110
111 /*
112 * For each symbol, check for both Symbol and _Symbol, since Borland
113 * generates C symbols with a leading '_' by default.
114 */
115
116 *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
117 if (*proc1Ptr == NULL) {
118 Tcl_DStringAppend(&ds, "_", 1);
119 sym1 = Tcl_DStringAppend(&ds, sym1, -1);
120 *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
121 Tcl_DStringFree(&ds);
122 }
123
124 *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
125 if (*proc2Ptr == NULL) {
126 Tcl_DStringAppend(&ds, "_", 1);
127 sym2 = Tcl_DStringAppend(&ds, sym2, -1);
128 *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
129 Tcl_DStringFree(&ds);
130 }
131 return TCL_OK;
132 }
133
134 /*
135 *----------------------------------------------------------------------
136 *
137 * TclpUnloadFile --
138 *
139 * Unloads a dynamically loaded binary code file from memory.
140 * Code pointers in the formerly loaded file are no longer valid
141 * after calling this function.
142 *
143 * Results:
144 * None.
145 *
146 * Side effects:
147 * Code removed from memory.
148 *
149 *----------------------------------------------------------------------
150 */
151
152 void
153 TclpUnloadFile(clientData)
154 ClientData clientData; /* ClientData returned by a previous call
155 * to TclpLoadFile(). The clientData is
156 * a token that represents the loaded
157 * file. */
158 {
159 HINSTANCE handle;
160
161 handle = (HINSTANCE) clientData;
162 FreeLibrary(handle);
163 }
164
165 /*
166 *----------------------------------------------------------------------
167 *
168 * TclGuessPackageName --
169 *
170 * If the "load" command is invoked without providing a package
171 * name, this procedure is invoked to try to figure it out.
172 *
173 * Results:
174 * Always returns 0 to indicate that we couldn't figure out a
175 * package name; generic code will then try to guess the package
176 * from the file name. A return value of 1 would have meant that
177 * we figured out the package name and put it in bufPtr.
178 *
179 * Side effects:
180 * None.
181 *
182 *----------------------------------------------------------------------
183 */
184
185 int
186 TclGuessPackageName(fileName, bufPtr)
187 char *fileName; /* Name of file containing package (already
188 * translated to local form if needed). */
189 Tcl_DString *bufPtr; /* Initialized empty dstring. Append
190 * package name to this if possible. */
191 {
192 return 0;
193 }
194
195
196 /* $History: tclwinload.c $
197 *
198 * ***************** Version 1 *****************
199 * User: Dtashley Date: 1/02/01 Time: 12:40a
200 * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
201 * Initial check-in.
202 */
203
204 /* End of TCLWINLOAD.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25