1/*
2 * tclLoadDld.c --
3 *
4 *	This procedure provides a version of the TclLoadFile that
5 *	works with the "dld_link" and "dld_get_func" library procedures
6 *	for dynamic loading.  It has been tested on Linux 1.1.95 and
7 *	dld-3.2.7.  This file probably isn't needed anymore, since it
8 *	makes more sense to use "dl_open" etc.
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: tclLoadDld.c,v 1.12 2002/10/10 12:25:53 vincentdarley Exp $
16 */
17
18#include "tclInt.h"
19#include "dld.h"
20
21/*
22 * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined
23 * and this argument to dlopen must always be 1.
24 */
25
26#ifndef RTLD_NOW
27#   define RTLD_NOW 1
28#endif
29
30/*
31 *----------------------------------------------------------------------
32 *
33 * TclpDlopen --
34 *
35 *	Dynamically loads a binary code file into memory and returns
36 *	a handle to the new code.
37 *
38 * Results:
39 *	A standard Tcl completion code.  If an error occurs, an error
40 *	message is left in the interp's result.
41 *
42 * Side effects:
43 *	New code suddenly appears in memory.
44 *
45 *----------------------------------------------------------------------
46 */
47
48int
49TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
50    Tcl_Interp *interp;		/* Used for error reporting. */
51    Tcl_Obj *pathPtr;		/* Name of the file containing the desired
52				 * code (UTF-8). */
53    Tcl_LoadHandle *loadHandle;	/* Filled with token for dynamically loaded
54				 * file which will be passed back to
55				 * (*unloadProcPtr)() to unload the file. */
56    Tcl_FSUnloadFileProc **unloadProcPtr;
57				/* Filled with address of Tcl_FSUnloadFileProc
58				 * function which should be used for
59				 * this file. */
60{
61    static int firstTime = 1;
62    int returnCode;
63    char *fileName;
64    CONST char *native;
65
66    /*
67     *  The dld package needs to know the pathname to the tcl binary.
68     *  If that's not known, return an error.
69     */
70
71    if (firstTime) {
72	if (tclExecutableName == NULL) {
73	    Tcl_SetResult(interp,
74		    "don't know name of application binary file, so can't initialize dynamic loader",
75		    TCL_STATIC);
76	    return TCL_ERROR;
77	}
78	returnCode = dld_init(tclExecutableName);
79	if (returnCode != 0) {
80	    Tcl_AppendResult(interp,
81		    "initialization failed for dynamic loader: ",
82		    dld_strerror(returnCode), (char *) NULL);
83	    return TCL_ERROR;
84	}
85	firstTime = 0;
86    }
87
88    fileName = Tcl_GetString(pathPtr);
89
90    /*
91     * First try the full path the user gave us.  This is particularly
92     * important if the cwd is inside a vfs, and we are trying to load
93     * using a relative path.
94     */
95    native = Tcl_FSGetNativePath(pathPtr);
96    returnCode = dld_link(native);
97
98    if (returnCode != 0) {
99	Tcl_DString ds;
100	native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
101	returnCode = dld_link(native);
102	Tcl_DStringFree(&ds);
103    }
104
105    if (returnCode != 0) {
106	Tcl_AppendResult(interp, "couldn't load file \"",
107			 fileName, "\": ",
108			 dld_strerror(returnCode), (char *) NULL);
109	return TCL_ERROR;
110    }
111    *loadHandle = (Tcl_LoadHandle) strcpy(
112	    (char *) ckalloc((unsigned) (strlen(fileName) + 1)), fileName);
113    *unloadProcPtr = &TclpUnloadFile;
114    return TCL_OK;
115}
116
117/*
118 *----------------------------------------------------------------------
119 *
120 * TclpFindSymbol --
121 *
122 *	Looks up a symbol, by name, through a handle associated with
123 *	a previously loaded piece of code (shared library).
124 *
125 * Results:
126 *	Returns a pointer to the function associated with 'symbol' if
127 *	it is found.  Otherwise returns NULL and may leave an error
128 *	message in the interp's result.
129 *
130 *----------------------------------------------------------------------
131 */
132Tcl_PackageInitProc*
133TclpFindSymbol(interp, loadHandle, symbol)
134    Tcl_Interp *interp;
135    Tcl_LoadHandle loadHandle;
136    CONST char *symbol;
137{
138    return (Tcl_PackageInitProc *) dld_get_func(symbol);
139}
140
141/*
142 *----------------------------------------------------------------------
143 *
144 * TclpUnloadFile --
145 *
146 *	Unloads a dynamically loaded binary code file from memory.
147 *	Code pointers in the formerly loaded file are no longer valid
148 *	after calling this function.
149 *
150 * Results:
151 *	None.
152 *
153 * Side effects:
154 *	Code removed from memory.
155 *
156 *----------------------------------------------------------------------
157 */
158
159void
160TclpUnloadFile(loadHandle)
161    Tcl_LoadHandle loadHandle;	/* loadHandle returned by a previous call
162				 * to TclpDlopen().  The loadHandle is
163				 * a token that represents the loaded
164				 * file. */
165{
166    char *fileName;
167
168    handle = (char *) loadHandle;
169    dld_unlink_by_file(handle, 0);
170    ckfree(handle);
171}
172
173/*
174 *----------------------------------------------------------------------
175 *
176 * TclGuessPackageName --
177 *
178 *	If the "load" command is invoked without providing a package
179 *	name, this procedure is invoked to try to figure it out.
180 *
181 * Results:
182 *	Always returns 0 to indicate that we couldn't figure out a
183 *	package name;  generic code will then try to guess the package
184 *	from the file name.  A return value of 1 would have meant that
185 *	we figured out the package name and put it in bufPtr.
186 *
187 * Side effects:
188 *	None.
189 *
190 *----------------------------------------------------------------------
191 */
192
193int
194TclGuessPackageName(fileName, bufPtr)
195    CONST char *fileName;	/* Name of file containing package (already
196				 * translated to local form if needed). */
197    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
198				 * package name to this if possible. */
199{
200    return 0;
201}
202