diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index ae3c2bceebe..23d25b4c955 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -3262,10 +3262,11 @@ Tcl_LoadFile( } /* - * The filesystem doesn't support 'load', so we fall back on the following - * technique: - * - * First check if it is readable -- and exists! + * The filesystem doesn't support 'load'. Fall to the following: + */ + + /* + * Make sure the file is accessible. */ if (Tcl_FSAccess(pathPtr, R_OK) != 0) { @@ -3279,9 +3280,9 @@ Tcl_LoadFile( #ifdef TCL_LOAD_FROM_MEMORY /* - * The platform supports loading code from memory, so ask for a buffer of - * the appropriate size, read the file into it and load the code from the - * buffer: + * The platform supports loading a dynamic shared object from memory. + * Create a sufficiently large buffer, read the file into it, and then load + * the dynamic shared object from the buffer: */ { @@ -3298,7 +3299,7 @@ Tcl_LoadFile( size = statBuf.st_size; /* - * Tcl_Read takes an int: check that file size isn't wide. + * Tcl_Read takes an int: Determine whether the file size <= INT_MAX */ if (size > INT_MAX) { @@ -3306,6 +3307,9 @@ Tcl_LoadFile( } data = Tcl_FSOpenFileChannel(interp, pathPtr, "rb", 0666); if (!data) { + if (interp) { + Tcl_ResetResult(interp); + } goto mustCopyToTempAnyway; } buffer = TclpLoadMemoryGetBuffer(size); @@ -3315,7 +3319,7 @@ Tcl_LoadFile( } ret = Tcl_Read(data, buffer, size); Tcl_Close(interp, data); - ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, + ret = TclpLoadMemory(buffer, size, ret, TclGetString(pathPtr), handlePtr, &unloadProcPtr, flags); if (ret == TCL_OK && *handlePtr != NULL) { goto resolveSymbols; @@ -3323,14 +3327,10 @@ Tcl_LoadFile( } mustCopyToTempAnyway: - if (interp) { - Tcl_ResetResult(interp); - } #endif /* TCL_LOAD_FROM_MEMORY */ /* - * Get a temporary filename to use, first to copy the file into, and then - * to load. + * Get a temporary filename, first to copy the file into, and then to load. */ copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr); diff --git a/generic/tclInt.h b/generic/tclInt.h index 987611b7964..24e8eb7d5a5 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3196,8 +3196,8 @@ MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, MODULE_SCOPE int TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); #ifdef TCL_LOAD_FROM_MEMORY MODULE_SCOPE void * TclpLoadMemoryGetBuffer(size_t size); -MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, - size_t size, int codeSize, Tcl_LoadHandle *loadHandle, +MODULE_SCOPE int TclpLoadMemory(void *buffer, size_t size, + int codeSize, const char *path, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); #endif MODULE_SCOPE void TclInitThreadStorage(void); diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c index 1af943a1f36..83596641599 100644 --- a/generic/tclLoadNone.c +++ b/generic/tclLoadNone.c @@ -93,27 +93,23 @@ TclGuessPackageName( MODULE_SCOPE void * TclpLoadMemoryGetBuffer( - int size) /* Dummy: unused by this implementation */ + size_t size) /* Dummy: unused by this implementation */ { return NULL; } MODULE_SCOPE int TclpLoadMemory( - Tcl_Interp *interp, /* Used for error reporting. */ void *buffer, /* Dummy: unused by this implementation */ size_t size, /* Dummy: unused by this implementation */ int codeSize, /* Dummy: unused by this implementation */ + const char *path, /* Dummy: unused by this implementation */ Tcl_LoadHandle *loadHandle, /* Dummy: unused by this implementation */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Dummy: unused by this implementation */ int flags) /* Dummy: unused by this implementation */ { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory " - "is not available on this system", -1)); - } return TCL_ERROR; } diff --git a/unix/Makefile.in b/unix/Makefile.in index 1c34c724408..18b943a1eff 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -792,7 +792,7 @@ INSTALL_DOC_TARGETS = install-doc INSTALL_PACKAGE_TARGETS = install-packages INSTALL_DEV_TARGETS = install-headers INSTALL_EXTRA_TARGETS = @EXTRA_INSTALL@ -INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \ +INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DEV_TARGETS) $(INSTALL_DOC_TARGETS) \ $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS) install: $(INSTALL_TARGETS) diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 9ea88ff40f8..27ed6ce768a 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -83,19 +83,19 @@ TclpDlopen( * relative path. */ - native = Tcl_FSGetNativePath(pathPtr); + native = (const char *)Tcl_FSGetNativePath(pathPtr); /* * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] */ if (flags & TCL_LOAD_GLOBAL) { - dlopenflags |= RTLD_GLOBAL; + dlopenflags |= RTLD_GLOBAL; } else { - dlopenflags |= RTLD_LOCAL; + dlopenflags |= RTLD_LOCAL; } if (flags & TCL_LOAD_LAZY) { - dlopenflags |= RTLD_LAZY; + dlopenflags |= RTLD_LAZY; } else { - dlopenflags |= RTLD_NOW; + dlopenflags |= RTLD_NOW; } handle = dlopen(native, dlopenflags); if (handle == NULL) { @@ -106,7 +106,7 @@ TclpDlopen( */ Tcl_DString ds; - const char *fileName = Tcl_GetString(pathPtr); + const char *fileName = TclGetString(pathPtr); native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); /* @@ -127,11 +127,11 @@ TclpDlopen( if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load file \"%s\": %s", - Tcl_GetString(pathPtr), errorStr)); + TclGetString(pathPtr), errorStr)); } return TCL_ERROR; } - newHandle = ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); newHandle->clientData = handle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; @@ -168,7 +168,7 @@ FindSymbol( Tcl_DString newName, ds; /* Buffers for converting the name to * system encoding and prepending an * underscore*/ - void *handle = (void *) loadHandle->clientData; + void *handle = loadHandle->clientData; /* Native handle to the loaded library */ void *proc; /* Address corresponding to the resolved * symbol */ @@ -210,15 +210,14 @@ FindSymbol( * * UnloadFile -- * - * Unloads a dynamically loaded binary code file from memory. Code - * pointers in the formerly loaded file are no longer valid after calling - * this function. + * Unloads a dynamic shared object, after which all pointers to functions + * in the formerly-loaded object are no longer valid. * * Results: * None. * * Side effects: - * Code removed from memory. + * Memory for the loaded object is deallocated. * *---------------------------------------------------------------------- */ @@ -265,6 +264,38 @@ TclGuessPackageName( return 0; } +/* + * These functions are fallbacks if we somehow determine that the platform can + * do loading from memory but the user wishes to disable it. They just report + * (gracefully) that they fail. + */ + +#ifdef TCL_LOAD_FROM_MEMORY + +MODULE_SCOPE void * +TclpLoadMemoryGetBuffer( + size_t size) /* Dummy: unused by this implementation */ +{ + return NULL; +} + +MODULE_SCOPE int +TclpLoadMemory( + void *buffer, /* Dummy: unused by this implementation */ + size_t size, /* Dummy: unused by this implementation */ + int codeSize, /* Dummy: unused by this implementation */ + const char *path, /* Dummy: unused by this implementation */ + Tcl_LoadHandle *loadHandle, /* Dummy: unused by this implementation */ + Tcl_FSUnloadFileProc **unloadProcPtr, + /* Dummy: unused by this implementation */ + int flags) + /* Dummy: unused by this implementation */ +{ + return TCL_ERROR; +} + +#endif /* TCL_LOAD_FROM_MEMORY */ + /* * Local Variables: * mode: c diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index 6b4ceb78674..bd1640ea5ef 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -562,13 +562,13 @@ TclpLoadMemoryGetBuffer( #ifdef TCL_LOAD_FROM_MEMORY MODULE_SCOPE int TclpLoadMemory( - Tcl_Interp *interp, /* Used for error reporting. */ void *buffer, /* Buffer containing the desired code * (allocated with TclpLoadMemoryGetBuffer). */ size_t size, /* Allocation size of buffer. */ int codeSize, /* Size of code data read into buffer or -1 if * an error occurred and the buffer should * just be freed. */ + const char *path, Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ @@ -583,7 +583,6 @@ TclpLoadMemory( NSObjectFileImage dyldObjFileImage = NULL; Tcl_DyldModuleHandle *modulePtr; NSModule module; - const char *objFileImageErrMsg = NULL; int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR; /* @@ -652,26 +651,16 @@ TclpLoadMemory( if (err == NSObjectFileImageSuccess) { err = NSCreateObjectFileImageFromMemory(buffer, codeSize, &dyldObjFileImage); - if (err != NSObjectFileImageSuccess) { - objFileImageErrMsg = DyldOFIErrorMsg(err); - } - } else { - objFileImageErrMsg = DyldOFIErrorMsg(err); } } /* * If it went wrong (or we were asked to just deallocate), get rid of the - * memory block and create an error message. + * memory block. */ if (dyldObjFileImage == NULL) { vm_deallocate(mach_task_self(), (vm_address_t) buffer, size); - if (objFileImageErrMsg != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "NSCreateObjectFileImageFromMemory() error: %s", - objFileImageErrMsg)); - } return TCL_ERROR; } @@ -693,7 +682,6 @@ TclpLoadMemory( const char *errorName, *errMsg; NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); return TCL_ERROR; } diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 9d2d87e72b5..b62920b1781 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -89,11 +89,11 @@ TclpDlopen( Tcl_DString ds; - /* - * Remember the first error on load attempt to be used if the - * second load attempt below also fails. - */ - firstError = (nativeName == NULL) ? + /* + * Remember the first error on load attempt to be used if the + * second load attempt below also fails. + */ + firstError = (nativeName == NULL) ? ERROR_MOD_NOT_FOUND : GetLastError(); nativeName = (WCHAR *)Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds); @@ -104,22 +104,22 @@ TclpDlopen( if (hInstance == NULL) { DWORD lastError; - Tcl_Obj *errMsg; - - /* - * We choose to only use the error from the second call if the first - * call failed due to the file not being found. Else stick to the - * first error for reporting purposes. - */ - if (firstError == ERROR_MOD_NOT_FOUND || - firstError == ERROR_DLL_NOT_FOUND) { - lastError = GetLastError(); - } else { - lastError = firstError; - } + Tcl_Obj *errMsg; + + /* + * We choose to only use the error from the second call if the first + * call failed due to the file not being found. Else stick to the + * first error for reporting purposes. + */ + if (firstError == ERROR_MOD_NOT_FOUND || + firstError == ERROR_DLL_NOT_FOUND) { + lastError = GetLastError(); + } else { + lastError = firstError; + } errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", - Tcl_GetString(pathPtr)); + TclGetString(pathPtr)); /* * Check for possible DLL errors. This doesn't work quite right, @@ -131,35 +131,35 @@ TclpDlopen( if (interp) { switch (lastError) { case ERROR_MOD_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", (char *)NULL); goto notFoundMsg; case ERROR_DLL_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", (char *)NULL); notFoundMsg: Tcl_AppendToObj(errMsg, "this library or a dependent library" " could not be found in library path", -1); break; case ERROR_PROC_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", (char *)NULL); Tcl_AppendToObj(errMsg, "A function specified in the import" " table could not be resolved by the system. Windows" " is not telling which one, I'm sorry.", -1); break; case ERROR_INVALID_DLL: - Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", (char *)NULL); Tcl_AppendToObj(errMsg, "this library or a dependent library" " is damaged", -1); break; case ERROR_DLL_INIT_FAILED: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", (char *)NULL); Tcl_AppendToObj(errMsg, "the library initialization" " routine failed", -1); break; - case ERROR_BAD_EXE_FORMAT: - Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", NULL); + case ERROR_BAD_EXE_FORMAT: + Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", (char *)NULL); Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", -1); - break; - default: + break; + default: TclWinConvertError(lastError); Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1); } @@ -173,7 +173,7 @@ TclpDlopen( */ handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); - handlePtr->clientData = (ClientData) hInstance; + handlePtr->clientData = hInstance; handlePtr->findSymbolProcPtr = &FindSymbol; handlePtr->unloadFileProcPtr = &UnloadFile; *loadHandle = handlePtr; @@ -225,7 +225,7 @@ FindSymbol( if (proc == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\"", symbol)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL); } return proc; } @@ -426,6 +426,37 @@ InitDLLDirectoryName(void) return TCL_OK; } +/* + * These functions are fallbacks if we somehow determine that the platform can + * do loading from memory but the user wishes to disable it. They just report + * (gracefully) that they fail. + */ + +#ifdef TCL_LOAD_FROM_MEMORY + +MODULE_SCOPE void * +TclpLoadMemoryGetBuffer( + size_t size) /* Dummy: unused by this implementation */ +{ + return NULL; +} + +MODULE_SCOPE int +TclpLoadMemory( + void *buffer, /* Dummy: unused by this implementation */ + size_t size, /* Dummy: unused by this implementation */ + int codeSize, /* Dummy: unused by this implementation */ + const char *path, /* Dummy: unused by this implementation */ + Tcl_LoadHandle *loadHandle, /* Dummy: unused by this implementation */ + Tcl_FSUnloadFileProc **unloadProcPtr, + /* Dummy: unused by this implementation */ + int flags) + /* Dummy: unused by this implementation */ +{ + return TCL_ERROR; +} + +#endif /* TCL_LOAD_FROM_MEMORY */ /* * Local Variables: * mode: c