Attachment "tclload.diff" to
ticket [611108ffff]
added by
vincentdarley
2002-10-03 22:18:09.
? win/efile
? win/httpd_820
Index: unix/tclLoadAout.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadAout.c,v
retrieving revision 1.13
diff -u -r1.13 tclLoadAout.c
--- unix/tclLoadAout.c 18 Jul 2002 16:26:04 -0000 1.13
+++ unix/tclLoadAout.c 3 Oct 2002 15:16:51 -0000
@@ -95,7 +95,7 @@
* 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 @@
* 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 @@
*/
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;
+ FILE * f; /* The load module */
+ int c = 0; /* Byte from the load module */
+ char * p;
+ CONST char *native;
- /* Open the load module */
-
- 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;
- }
- else {
- p = "@LIBS: ";
- 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;
+ }
+
+ /* 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 @@
static void
UnlinkSymbolTable ()
{
- (void) unlink (SymbolTableFile);
- ckfree (SymbolTableFile);
- SymbolTableFile = NULL;
+ (void) unlink (SymbolTableFile);
+ ckfree (SymbolTableFile);
+ SymbolTableFile = NULL;
}
/*
Index: unix/tclLoadDl.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDl.c,v
retrieving revision 1.12
diff -u -r1.12 tclLoadDl.c
--- unix/tclLoadDl.c 18 Jul 2002 16:26:04 -0000 1.12
+++ unix/tclLoadDl.c 3 Oct 2002 15:16:51 -0000
@@ -69,8 +69,25 @@
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 \"",
Index: unix/tclLoadDld.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDld.c,v
retrieving revision 1.11
diff -u -r1.11 tclLoadDld.c
--- unix/tclLoadDld.c 18 Jul 2002 16:26:04 -0000 1.11
+++ unix/tclLoadDld.c 3 Oct 2002 15:16:51 -0000
@@ -60,7 +60,8 @@
{
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 @@
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;
Index: unix/tclLoadDyld.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDyld.c,v
retrieving revision 1.12
diff -u -r1.12 tclLoadDyld.c
--- unix/tclLoadDyld.c 24 Jul 2002 13:51:18 -0000 1.12
+++ unix/tclLoadDyld.c 3 Oct 2002 15:16:51 -0000
@@ -63,10 +63,30 @@
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 @@
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;
Index: unix/tclLoadNext.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadNext.c,v
retrieving revision 1.10
diff -u -r1.10 tclLoadNext.c
--- unix/tclLoadNext.c 18 Jul 2002 16:26:04 -0000 1.10
+++ unix/tclLoadNext.c 3 Oct 2002 15:16:51 -0000
@@ -48,25 +48,54 @@
* 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;
}
/*
Index: unix/tclLoadOSF.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadOSF.c,v
retrieving revision 1.10
diff -u -r1.10 tclLoadOSF.c
--- unix/tclLoadOSF.c 18 Jul 2002 16:26:04 -0000 1.10
+++ unix/tclLoadOSF.c 3 Oct 2002 15:16:51 -0000
@@ -72,8 +72,28 @@
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);
Index: unix/tclLoadShl.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadShl.c,v
retrieving revision 1.12
diff -u -r1.12 tclLoadShl.c
--- unix/tclLoadShl.c 18 Jul 2002 16:26:04 -0000 1.12
+++ unix/tclLoadShl.c 3 Oct 2002 15:16:51 -0000
@@ -57,8 +57,9 @@
* 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 ([email protected]): "This
@@ -69,9 +70,29 @@
* 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);
Index: win/tclWinLoad.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinLoad.c,v
retrieving revision 1.14
diff -u -r1.14 tclWinLoad.c
--- win/tclWinLoad.c 18 Jul 2002 16:26:05 -0000 1.14
+++ win/tclWinLoad.c 3 Oct 2002 15:16:51 -0000
@@ -49,12 +49,26 @@
{
HINSTANCE handle;
CONST TCHAR *nativeName;
- Tcl_DString ds;
- char *fileName = Tcl_GetString(pathPtr);
- nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ /*
+ * 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.
+ */
+ nativeName = Tcl_FSGetNativePath(pathPtr);
handle = (*tclWinProcs->loadLibraryProc)(nativeName);
- Tcl_DStringFree(&ds);
+ 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);
+ nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ handle = (*tclWinProcs->loadLibraryProc)(nativeName);
+ Tcl_DStringFree(&ds);
+ }
*loadHandle = (Tcl_LoadHandle) handle;
@@ -75,7 +89,7 @@
sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
#endif
Tcl_AppendResult(interp, "couldn't load library \"",
- fileName, "\": ", (char *) NULL);
+ Tcl_GetString(pathPtr), "\": ", (char *) NULL);
/*
* Check for possible DLL errors. This doesn't work quite right,
* because Windows seems to only return ERROR_MOD_NOT_FOUND for
