diff options
Diffstat (limited to 'unix')
| -rw-r--r-- | unix/tclLoadAout.c | 414 | ||||
| -rw-r--r-- | unix/tclLoadDl.c | 21 | ||||
| -rw-r--r-- | unix/tclLoadDld.c | 30 | ||||
| -rw-r--r-- | unix/tclLoadDyld.c | 27 | ||||
| -rw-r--r-- | unix/tclLoadNext.c | 67 | ||||
| -rw-r--r-- | unix/tclLoadOSF.c | 24 | ||||
| -rw-r--r-- | unix/tclLoadShl.c | 31 |
7 files changed, 371 insertions, 243 deletions
diff --git a/unix/tclLoadAout.c b/unix/tclLoadAout.c index 301dce9..d4ef456 100644 --- a/unix/tclLoadAout.c +++ b/unix/tclLoadAout.c @@ -14,7 +14,7 @@ * and Design Engineering (MADE) Initiative through ARPA contract * F33615-94-C-4400. * - * RCS: @(#) $Id: tclLoadAout.c,v 1.13 2002/07/18 16:26:04 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadAout.c,v 1.14 2002/10/10 12:25:53 vincentdarley Exp $ */ #include "tclInt.h" @@ -95,7 +95,7 @@ typedef Tcl_PackageInitProc * (* DictFn) _ANSI_ARGS_ ((CONST char * symbol)); * Prototypes for procedures referenced only in this file: */ -static int FindLibraries _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, +static int FindLibraries _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_DString * buf)); static void UnlinkSymbolTable _ANSI_ARGS_((void)); @@ -150,163 +150,165 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * function which should be used for * this file. */ { - char * inputSymbolTable; /* Name of the file containing the + char * inputSymbolTable; /* Name of the file containing the * symbol table from the last link. */ - Tcl_DString linkCommandBuf; /* Command to do the run-time relocation + Tcl_DString linkCommandBuf; /* Command to do the run-time relocation * of the module.*/ - char * linkCommand; - char relocatedFileName [L_tmpnam]; + char * linkCommand; + char relocatedFileName [L_tmpnam]; /* Name of the file holding the relocated */ /* text of the module */ - int relocatedFd; /* File descriptor of the file holding + int relocatedFd; /* File descriptor of the file holding * relocated text */ - struct exec relocatedHead; /* Header of the relocated text */ - unsigned long relocatedSize; /* Size of the relocated text */ - char * startAddress; /* Starting address of the module */ - int status; /* Status return from Tcl_ calls */ - char * p; - - /* Find the file that contains the symbols for the run-time link. */ - - if (SymbolTableFile != NULL) { - inputSymbolTable = SymbolTableFile; - } else if (tclExecutableName == NULL) { - Tcl_SetResult (interp, "can't find the tclsh executable", TCL_STATIC); - return TCL_ERROR; - } else { - inputSymbolTable = tclExecutableName; - } - - /* Construct the `ld' command that builds the relocated module */ - - tmpnam (relocatedFileName); - Tcl_DStringInit (&linkCommandBuf); - Tcl_DStringAppend (&linkCommandBuf, "exec ld -o ", -1); - Tcl_DStringAppend (&linkCommandBuf, relocatedFileName, -1); + struct exec relocatedHead; /* Header of the relocated text */ + unsigned long relocatedSize;/* Size of the relocated text */ + char * startAddress; /* Starting address of the module */ + int status; /* Status return from Tcl_ calls */ + char * p; + + /* Find the file that contains the symbols for the run-time link. */ + + if (SymbolTableFile != NULL) { + inputSymbolTable = SymbolTableFile; + } else if (tclExecutableName == NULL) { + Tcl_SetResult (interp, "can't find the tclsh executable", TCL_STATIC); + return TCL_ERROR; + } else { + inputSymbolTable = tclExecutableName; + } + + /* Construct the `ld' command that builds the relocated module */ + + tmpnam (relocatedFileName); + Tcl_DStringInit (&linkCommandBuf); + Tcl_DStringAppend (&linkCommandBuf, "exec ld -o ", -1); + Tcl_DStringAppend (&linkCommandBuf, relocatedFileName, -1); #if defined(__mips) || defined(mips) - Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1); + Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1); #endif - Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1); - TclGuessPackageName(Tcl_GetString(pathPtr), &linkCommandBuf); - Tcl_DStringAppend (&linkCommandBuf, " -A ", -1); - Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1); - Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1); - Tcl_DStringAppend (&linkCommandBuf, Tcl_GetString(pathPtr), -1); - Tcl_DStringAppend (&linkCommandBuf, " ", -1); - if (FindLibraries (interp, Tcl_GetString(pathPtr), &linkCommandBuf) != TCL_OK) { + Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1); + TclGuessPackageName(Tcl_GetString(pathPtr), &linkCommandBuf); + Tcl_DStringAppend (&linkCommandBuf, " -A ", -1); + Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1); + Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1); + Tcl_DStringAppend (&linkCommandBuf, Tcl_GetString(pathPtr), -1); + Tcl_DStringAppend (&linkCommandBuf, " ", -1); + + if (FindLibraries (interp, pathPtr, &linkCommandBuf) != TCL_OK) { + Tcl_DStringFree (&linkCommandBuf); + return TCL_ERROR; + } + + linkCommand = Tcl_DStringValue (&linkCommandBuf); + + /* Determine the starting address, and plug it into the command */ + + startAddress = (char *) (((unsigned long) sbrk (0) + + TCL_LOADSHIM + TCL_LOADALIGN - 1) + & (- TCL_LOADALIGN)); + p = strstr (linkCommand, "-T") + 3; + sprintf (p, "%08lx", (long) startAddress); + p [8] = ' '; + + /* Run the linker */ + + status = Tcl_Eval (interp, linkCommand); Tcl_DStringFree (&linkCommandBuf); - return TCL_ERROR; - } - linkCommand = Tcl_DStringValue (&linkCommandBuf); - - /* Determine the starting address, and plug it into the command */ - - startAddress = (char *) (((unsigned long) sbrk (0) - + TCL_LOADSHIM + TCL_LOADALIGN - 1) - & (- TCL_LOADALIGN)); - p = strstr (linkCommand, "-T") + 3; - sprintf (p, "%08lx", (long) startAddress); - p [8] = ' '; - - /* Run the linker */ - - status = Tcl_Eval (interp, linkCommand); - Tcl_DStringFree (&linkCommandBuf); - if (status != 0) { - return TCL_ERROR; - } - - /* Open the linker's result file and read the header */ - - relocatedFd = open (relocatedFileName, O_RDONLY); - if (relocatedFd < 0) { - goto ioError; - } - status= read (relocatedFd, (char *) & relocatedHead, sizeof relocatedHead); - if (status < sizeof relocatedHead) { - goto ioError; - } - - /* Check the magic number */ - - if (relocatedHead.a_magic != OMAGIC) { - Tcl_AppendResult (interp, "bad magic number in intermediate file \"", - relocatedFileName, "\"", (char *) NULL); - goto failure; - } - - /* Make sure that memory allocation is still consistent */ - - if ((unsigned long) sbrk (0) > (unsigned long) startAddress) { - Tcl_SetResult (interp, "can't load, memory allocation is inconsistent.", - TCL_STATIC); - goto failure; - } - - /* Make sure that the relocated module's size is reasonable */ - - relocatedSize = relocatedHead.a_text + relocatedHead.a_data - + relocatedHead.a_bss; - if (relocatedSize > TCL_LOADMAX) { - Tcl_SetResult (interp, "module too big to load", TCL_STATIC); - goto failure; - } - - /* Advance the break to protect the loaded module */ - - (void) brk (startAddress + relocatedSize); - - /* - * Seek to the start of the module's text. - * - * Note that this does not really work with large files (i.e. where - * lseek64 exists and is different to lseek), but anyone trying to - * dynamically load a binary that is larger than what can fit in - * addressable memory is in trouble anyway... - */ - + if (status != 0) { + return TCL_ERROR; + } + + /* Open the linker's result file and read the header */ + + relocatedFd = open (relocatedFileName, O_RDONLY); + if (relocatedFd < 0) { + goto ioError; + } + status= read (relocatedFd, (char *) & relocatedHead, sizeof relocatedHead); + if (status < sizeof relocatedHead) { + goto ioError; + } + + /* Check the magic number */ + + if (relocatedHead.a_magic != OMAGIC) { + Tcl_AppendResult (interp, "bad magic number in intermediate file \"", + relocatedFileName, "\"", (char *) NULL); + goto failure; + } + + /* Make sure that memory allocation is still consistent */ + + if ((unsigned long) sbrk (0) > (unsigned long) startAddress) { + Tcl_SetResult (interp, "can't load, memory allocation is inconsistent.", + TCL_STATIC); + goto failure; + } + + /* Make sure that the relocated module's size is reasonable */ + + relocatedSize = relocatedHead.a_text + relocatedHead.a_data + + relocatedHead.a_bss; + if (relocatedSize > TCL_LOADMAX) { + Tcl_SetResult (interp, "module too big to load", TCL_STATIC); + goto failure; + } + + /* Advance the break to protect the loaded module */ + + (void) brk (startAddress + relocatedSize); + + /* + * Seek to the start of the module's text. + * + * Note that this does not really work with large files (i.e. where + * lseek64 exists and is different to lseek), but anyone trying to + * dynamically load a binary that is larger than what can fit in + * addressable memory is in trouble anyway... + */ + #if defined(__mips) || defined(mips) - status = lseek (relocatedFd, - (off_t) N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o), - SEEK_SET); + status = lseek (relocatedFd, + (off_t) N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o), + SEEK_SET); #else - status = lseek (relocatedFd, (off_t) N_TXTOFF (relocatedHead), SEEK_SET); + status = lseek (relocatedFd, (off_t) N_TXTOFF (relocatedHead), SEEK_SET); #endif - if (status < 0) { - goto ioError; - } - - /* Read in the module's text and data */ - - relocatedSize = relocatedHead.a_text + relocatedHead.a_data; - if (read (relocatedFd, startAddress, relocatedSize) < relocatedSize) { - brk (startAddress); - ioError: - Tcl_AppendResult (interp, "error on intermediate file \"", - relocatedFileName, "\": ", Tcl_PosixError (interp), - (char *) NULL); - failure: - (void) unlink (relocatedFileName); - return TCL_ERROR; - } - - /* Close the intermediate file. */ - - (void) close (relocatedFd); - - /* Arrange things so that intermediate symbol tables eventually get - * deleted. */ - - if (SymbolTableFile != NULL) { - UnlinkSymbolTable (); - } else { - atexit (UnlinkSymbolTable); - } - SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1); - strcpy (SymbolTableFile, relocatedFileName); - - *loadHandle = startAddress; - return TCL_OK; + if (status < 0) { + goto ioError; + } + + /* Read in the module's text and data */ + + relocatedSize = relocatedHead.a_text + relocatedHead.a_data; + if (read (relocatedFd, startAddress, relocatedSize) < relocatedSize) { + brk (startAddress); + ioError: + Tcl_AppendResult (interp, "error on intermediate file \"", + relocatedFileName, "\": ", Tcl_PosixError (interp), + (char *) NULL); + failure: + (void) unlink (relocatedFileName); + return TCL_ERROR; + } + + /* Close the intermediate file. */ + + (void) close (relocatedFd); + + /* Arrange things so that intermediate symbol tables eventually get + * deleted. */ + + if (SymbolTableFile != NULL) { + UnlinkSymbolTable (); + } else { + atexit (UnlinkSymbolTable); + } + SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1); + strcpy (SymbolTableFile, relocatedFileName); + + *loadHandle = startAddress; + return TCL_OK; } /* @@ -352,68 +354,68 @@ TclpFindSymbol(interp, loadHandle, symbol) */ static int -FindLibraries (interp, fileName, buf) - Tcl_Interp * interp; /* Used for error reporting */ - char * fileName; /* Name of the load module */ - Tcl_DString * buf; /* Buffer where the -l an -L flags */ +FindLibraries (interp, pathPtr, buf) + Tcl_Interp * interp; /* Used for error reporting */ + Tcl_Obj * pathPtr; /* Name of the load module */ + Tcl_DString * buf; /* Buffer where the -l an -L flags */ { - FILE * f; /* The load module */ - int c = 0; /* Byte from the load module */ - char * p; - Tcl_DString ds; - CONST char *native; - - /* Open the load module */ + FILE * f; /* The load module */ + int c = 0; /* Byte from the load module */ + char * p; + CONST char *native; - native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); - f = fopen(native, "rb"); /* INTL: Native. */ - Tcl_DStringFree(&ds); + char *fileName = Tcl_GetString(pathPtr); - if (f == NULL) { - Tcl_AppendResult (interp, "couldn't open \"", fileName, "\": ", - Tcl_PosixError (interp), (char *) NULL); - return TCL_ERROR; - } - - /* Search for the library list in the load module */ - - p = "@LIBS: "; - while (*p != '\0' && (c = getc (f)) != EOF) { - if (c == *p) { - ++p; + /* Open the load module */ + + native = Tcl_FSGetNativePath(pathPtr); + f = fopen(native, "rb"); /* INTL: Native. */ + + if (f == NULL) { + Tcl_AppendResult (interp, "couldn't open \"", fileName, "\": ", + Tcl_PosixError (interp), (char *) NULL); + return TCL_ERROR; } - else { - p = "@LIBS: "; - if (c == *p) { - ++p; - } + + /* Search for the library list in the load module */ + + p = "@LIBS: "; + while (*p != '\0' && (c = getc (f)) != EOF) { + if (c == *p) { + ++p; + } + else { + p = "@LIBS: "; + if (c == *p) { + ++p; + } + } + } + + /* No library list -- this must be an ill-formed module */ + + if (c == EOF) { + Tcl_AppendResult (interp, "File \"", fileName, + "\" is not a Tcl load module.", (char *) NULL); + (void) fclose (f); + return TCL_ERROR; + } + + /* Accumulate the library list */ + + while ((c = getc (f)) != '\0' && c != EOF) { + char cc = c; + Tcl_DStringAppend (buf, &cc, 1); } - } - - /* No library list -- this must be an ill-formed module */ - - if (c == EOF) { - Tcl_AppendResult (interp, "File \"", fileName, - "\" is not a Tcl load module.", (char *) NULL); (void) fclose (f); - return TCL_ERROR; - } - - /* Accumulate the library list */ - - while ((c = getc (f)) != '\0' && c != EOF) { - char cc = c; - Tcl_DStringAppend (buf, &cc, 1); - } - (void) fclose (f); - - if (c == EOF) { - Tcl_AppendResult (interp, "Library directory in \"", fileName, - "\" ends prematurely.", (char *) NULL); - return TCL_ERROR; - } + + if (c == EOF) { + Tcl_AppendResult (interp, "Library directory in \"", fileName, + "\" ends prematurely.", (char *) NULL); + return TCL_ERROR; + } - return TCL_OK; + return TCL_OK; } /* @@ -437,9 +439,9 @@ FindLibraries (interp, fileName, buf) static void UnlinkSymbolTable () { - (void) unlink (SymbolTableFile); - ckfree (SymbolTableFile); - SymbolTableFile = NULL; + (void) unlink (SymbolTableFile); + ckfree (SymbolTableFile); + SymbolTableFile = NULL; } /* diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 2f1d4e2..1a51dd8 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadDl.c,v 1.12 2002/07/18 16:26:04 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadDl.c,v 1.13 2002/10/10 12:25:53 vincentdarley Exp $ */ #include "tclInt.h" @@ -69,8 +69,25 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) VOID *handle; CONST char *native; + /* + * 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); - handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); /* INTL: Native. */ + handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); + if (handle == NULL) { + /* + * 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; + char *fileName = Tcl_GetString(pathPtr); + native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); + handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); + Tcl_DStringFree(&ds); + } if (handle == NULL) { Tcl_AppendResult(interp, "couldn't load file \"", diff --git a/unix/tclLoadDld.c b/unix/tclLoadDld.c index 9603e7e..bc9bc8e 100644 --- a/unix/tclLoadDld.c +++ b/unix/tclLoadDld.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadDld.c,v 1.11 2002/07/18 16:26:04 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadDld.c,v 1.12 2002/10/10 12:25:53 vincentdarley Exp $ */ #include "tclInt.h" @@ -60,7 +60,8 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) { static int firstTime = 1; int returnCode; - char *fileName = Tcl_GetString(pathPtr); + char *fileName; + CONST char *native; /* * The dld package needs to know the pathname to the tcl binary. @@ -84,13 +85,30 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) firstTime = 0; } - if ((returnCode = dld_link(Tcl_GetString(pathPtr))) != 0) { + 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); + returnCode = dld_link(native); + + if (returnCode != 0) { + Tcl_DString ds; + native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); + returnCode = dld_link(native); + Tcl_DStringFree(&ds); + } + + if (returnCode != 0) { Tcl_AppendResult(interp, "couldn't load file \"", - Tcl_GetString(pathPtr), - "\": ", dld_strerror(returnCode), (char *) NULL); + fileName, "\": ", + dld_strerror(returnCode), (char *) NULL); return TCL_ERROR; } - *loadHandle = strcpy( + *loadHandle = (Tcl_LoadHandle) strcpy( (char *) ckalloc((unsigned) (strlen(fileName) + 1)), fileName); *unloadProcPtr = &TclpUnloadFile; return TCL_OK; diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index f203564..531a3c2 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadDyld.c,v 1.12 2002/07/24 13:51:18 das Exp $ + * RCS: @(#) $Id: tclLoadDyld.c,v 1.13 2002/10/10 12:25:53 vincentdarley Exp $ */ #include "tclInt.h" @@ -63,10 +63,30 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) const struct mach_header *dyld_lib; CONST char *native; + /* + * 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); dyld_lib = NSAddImage(native, - NSADDIMAGE_OPTION_WITH_SEARCHING | - NSADDIMAGE_OPTION_RETURN_ON_ERROR); + NSADDIMAGE_OPTION_WITH_SEARCHING | + NSADDIMAGE_OPTION_RETURN_ON_ERROR); + + if (!dyld_lib) { + /* + * 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; + char *fileName = Tcl_GetString(pathPtr); + native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); + dyld_lib = NSAddImage(native, + NSADDIMAGE_OPTION_WITH_SEARCHING | + NSADDIMAGE_OPTION_RETURN_ON_ERROR); + Tcl_DStringFree(&ds); + } if (!dyld_lib) { NSLinkEditErrors editError; @@ -75,6 +95,7 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) Tcl_AppendResult(interp, msg, (char *) NULL); return TCL_ERROR; } + dyldLoadHandle = (Tcl_DyldLoadHandle *) ckalloc(sizeof(Tcl_DyldLoadHandle)); if (!dyldLoadHandle) return TCL_ERROR; dyldLoadHandle->dyld_lib = dyld_lib; diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index 699cfb3..05df209 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadNext.c,v 1.10 2002/07/18 16:26:04 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadNext.c,v 1.11 2002/10/10 12:25:53 vincentdarley Exp $ */ #include "tclInt.h" @@ -48,25 +48,54 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * function which should be used for * this file. */ { - struct mach_header *header; - char *data; - int len, maxlen; - char *files[]={fileName,NULL}; - NXStream *errorStream=NXOpenMemory(0,0,NX_READWRITE); - char *fileName = Tcl_GetString(pathPtr); - - if(!rld_load(errorStream,&header,files,NULL)) { - 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); + 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); - *loadHandle = (Tcl_LoadHandle)1; /* A dummy non-NULL value */ - *unloadProcPtr = &TclpUnloadFile; - - return TCL_OK; + /* + * 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; } /* diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 7e7c6d4..308c55d 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -31,7 +31,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadOSF.c,v 1.10 2002/07/18 16:26:04 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadOSF.c,v 1.11 2002/10/10 12:25:53 vincentdarley Exp $ */ #include "tclInt.h" @@ -72,8 +72,28 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) ldr_module_t lm; char *pkg; char *fileName = Tcl_GetString(pathPtr); + CONST char *native; + + /* + * 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); + lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS); + + if (lm == LDR_NULL_MODULE) { + /* + * 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); + lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS); + Tcl_DStringFree(&ds); + } - lm = (Tcl_PackageInitProc *) load(fileName, LDR_NOFLAGS); if (lm == LDR_NULL_MODULE) { Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", Tcl_PosixError (interp), (char *) NULL); diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c index 84ef9fa..60919a7 100644 --- a/unix/tclLoadShl.c +++ b/unix/tclLoadShl.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadShl.c,v 1.12 2002/07/18 16:26:04 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadShl.c,v 1.13 2002/10/10 12:25:53 vincentdarley Exp $ */ #include <dl.h> @@ -57,8 +57,9 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * this file. */ { shl_t handle; + CONST char *native; char *fileName = Tcl_GetString(pathPtr); - + /* * The flags below used to be BIND_IMMEDIATE; they were changed at * the suggestion of Wolfgang Kechel (wolfgang@prs.de): "This @@ -69,9 +70,29 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * when they are build." */ - handle = shl_load(fileName, - BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, - 0L); + + /* + * 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); + handle = shl_load(native, + BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); + + if (handle == NULL) { + /* + * 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); + handle = shl_load(native, + BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); + Tcl_DStringFree(&ds); + } + if (handle == NULL) { Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); |