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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25