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	dashley	25	/* $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 */