1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
|
/*
* tclLoadNext.c --
*
* This procedure provides a version of the TclLoadFile that works with
* NeXTs rld_* dynamic loading. This file provided by Pedja Bogdanovich.
*
* 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.
*/
#include "tclInt.h"
#include <mach-o/rld.h>
#include <streams/streams.h>
/*
*----------------------------------------------------------------------
*
* TclpDlopen --
*
* Dynamically loads a binary code file into memory and returns a handle
* to the new code.
*
* 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
TclpDlopen(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Obj *pathPtr, /* Name of the file containing the desired
* code (UTF-8). */
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
Tcl_FSUnloadFileProc **unloadProcPtr)
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
{
struct mach_header *header;
char *fileName;
char *files[2];
CONST char *native;
int result = 1;
NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE);
fileName = Tcl_GetString(pathPtr);
/*
* First try the full path the user gave us. This is particularly
* important if the cwd is inside a vfs, and we are trying to load using a
* relative path.
*/
native = Tcl_FSGetNativePath(pathPtr);
files = {native,NULL};
result = rld_load(errorStream, &header, files, NULL);
if (!result) {
/*
* Let the OS loader examine the binary search path for whatever
* string the user gave us which hopefully refers to a file on the
* binary path
*/
Tcl_DString ds;
native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
files = {native,NULL};
result = rld_load(errorStream, &header, files, NULL);
Tcl_DStringFree(&ds);
}
if (!result) {
char *data;
int len, maxlen;
NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ",
data, NULL);
NXCloseMemory(errorStream, NX_FREEBUFFER);
return TCL_ERROR;
}
NXCloseMemory(errorStream, NX_FREEBUFFER);
*loadHandle = (Tcl_LoadHandle)1; /* A dummy non-NULL value */
*unloadProcPtr = &TclpUnloadFile;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclpFindSymbol --
*
* Looks up a symbol, by name, through a handle associated with a
* previously loaded piece of code (shared library).
*
* Results:
* Returns a pointer to the function associated with 'symbol' if it is
* found. Otherwise returns NULL and may leave an error message in the
* interp's result.
*
*----------------------------------------------------------------------
*/
Tcl_PackageInitProc *
TclpFindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
CONST char *symbol)
{
Tcl_PackageInitProc *proc = NULL;
if (symbol) {
char sym[strlen(symbol) + 2];
sym[0] = '_';
sym[1] = 0;
strcat(sym, symbol);
rld_lookup(NULL, sym, (unsigned long *)&proc);
}
return proc;
}
/*
*----------------------------------------------------------------------
*
* 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:
* Does nothing. Can anything be done?
*
*----------------------------------------------------------------------
*/
void
TclpUnloadFile(
Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
* TclpDlopen(). The loadHandle is a token
* that represents the loaded file. */
{
}
/*
*----------------------------------------------------------------------
*
* 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(
CONST 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;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|