shared_source/c_tcl_base_7_5_w_mods/tclwinload.c

/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwinload.c,v 1.1.1.1 2001/06/13 04:49:20 dtashley Exp $ */

/* 
 * tclWinLoad.c --
 *
 *      This procedure provides a version of the TclLoadFile that
 *      works with the Windows "LoadLibrary" and "GetProcAddress"
 *      API for dynamic loading.
 *
 * 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.
 *
 * RCS: @(#) $Id: tclwinload.c,v 1.1.1.1 2001/06/13 04:49:20 dtashley Exp $
 */

#include "tclWinInt.h"


/*
 *----------------------------------------------------------------------
 *
 * TclpLoadFile --
 *
 *      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 the interp's result.
 *
 * Side effects:
 *      New code suddenly appears in memory.
 *
 *----------------------------------------------------------------------
 */

int
TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
    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. */
    ClientData *clientDataPtr;  /* Filled with token for dynamically loaded
                                 * file which will be passed back to 
                                 * TclpUnloadFile() to unload the file. */
{
    HINSTANCE handle;
    TCHAR *nativeName;
    Tcl_DString ds;

    nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
    handle = (*tclWinProcs->loadLibraryProc)(nativeName);
    Tcl_DStringFree(&ds);

    *clientDataPtr = (ClientData) handle;
    
    if (handle == NULL) {
        DWORD lastError = GetLastError();
#if 0
        /*
         * It would be ideal if the FormatMessage stuff worked better,
         * but unfortunately it doesn't seem to want to...
         */
        LPTSTR lpMsgBuf;
        char *buf;
        int size;
        size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
                FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
                (LPTSTR) &lpMsgBuf, 0, NULL);
        buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
        sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
#endif
        Tcl_AppendResult(interp, "couldn't load library \"",
                fileName, "\": ", (char *) NULL);
        /*
         * Check for possible DLL errors.  This doesn't work quite right,
         * because Windows seems to only return ERROR_MOD_NOT_FOUND for
         * just about any problem, but it's better than nothing.  It'd be
         * even better if there was a way to get what DLLs
         */
        switch (lastError) {
            case ERROR_MOD_NOT_FOUND:
            case ERROR_DLL_NOT_FOUND:
                Tcl_AppendResult(interp, "this library or a dependent library",
                        " could not be found in library path", (char *)
                        NULL);
                break;
            case ERROR_INVALID_DLL:
                Tcl_AppendResult(interp, "this library or a dependent library",
                        " is damaged", (char *) NULL);
                break;
            case ERROR_DLL_INIT_FAILED:
                Tcl_AppendResult(interp, "the library initialization",
                        " routine failed", (char *) NULL);
                break;
            default:
                TclWinConvertError(lastError);
                Tcl_AppendResult(interp, Tcl_PosixError(interp),
                        (char *) NULL);
        }
        return TCL_ERROR;
    }

    /*
     * For each symbol, check for both Symbol and _Symbol, since Borland
     * generates C symbols with a leading '_' by default.
     */

    *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
    if (*proc1Ptr == NULL) {
        Tcl_DStringAppend(&ds, "_", 1);
        sym1 = Tcl_DStringAppend(&ds, sym1, -1);
        *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
        Tcl_DStringFree(&ds);
    }
    
    *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
    if (*proc2Ptr == NULL) {
        Tcl_DStringAppend(&ds, "_", 1);
        sym2 = Tcl_DStringAppend(&ds, sym2, -1);
        *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
        Tcl_DStringFree(&ds);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpUnloadFile --
 *
 *      Unloads a dynamically loaded binary code file from memory.
 *      Code pointers in the formerly loaded file are no longer valid
 *      after calling this function.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Code removed from memory.
 *
 *----------------------------------------------------------------------
 */

void
TclpUnloadFile(clientData)
    ClientData clientData;      /* ClientData returned by a previous call
                                 * to TclpLoadFile().  The clientData is 
                                 * a token that represents the loaded 
                                 * file. */
{
    HINSTANCE handle;

    handle = (HINSTANCE) clientData;
    FreeLibrary(handle);
}

/*
 *----------------------------------------------------------------------
 *
 * 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;
}


/* $History: tclwinload.c $
 * 
 * *****************  Version 1  *****************
 * User: Dtashley     Date: 1/02/01    Time: 12:40a
 * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
 * Initial check-in.
 */ 

/* End of TCLWINLOAD.C */
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 */