diff options
author | hobbs <hobbs@noemail.net> | 2001-04-03 22:54:36 (GMT) |
---|---|---|
committer | hobbs <hobbs@noemail.net> | 2001-04-03 22:54:36 (GMT) |
commit | 1de9841f1bc65b7783ea7b98ef4f0599e3d1955e (patch) | |
tree | fea9fa3b3e3b2f751ae7af5de5f61cdbaa2336bd /win | |
parent | 3f08d1c6f1bda731b8bcd09fa4f9a7a00ae2033e (diff) | |
download | tcl-1de9841f1bc65b7783ea7b98ef4f0599e3d1955e.zip tcl-1de9841f1bc65b7783ea7b98ef4f0599e3d1955e.tar.gz tcl-1de9841f1bc65b7783ea7b98ef4f0599e3d1955e.tar.bz2 |
see backport log in ChangeLog for specific file backports from 8.4aCVS
FossilOrigin-Name: 6defc375da7f53c897947de6051d97cbc0a30fc8
Diffstat (limited to 'win')
-rw-r--r-- | win/Makefile.in | 52 | ||||
-rw-r--r-- | win/configure.in | 42 | ||||
-rw-r--r-- | win/makefile.vc | 109 | ||||
-rw-r--r-- | win/tcl.m4 | 14 | ||||
-rw-r--r-- | win/tcl.rc | 45 | ||||
-rw-r--r-- | win/tclWinChan.c | 71 | ||||
-rw-r--r-- | win/tclWinConsole.c | 21 | ||||
-rw-r--r-- | win/tclWinDde.c | 3 | ||||
-rw-r--r-- | win/tclWinError.c | 4 | ||||
-rw-r--r-- | win/tclWinFile.c | 32 | ||||
-rw-r--r-- | win/tclWinInit.c | 16 | ||||
-rw-r--r-- | win/tclWinInt.h | 3 | ||||
-rw-r--r-- | win/tclWinLoad.c | 10 | ||||
-rw-r--r-- | win/tclWinNotify.c | 10 | ||||
-rw-r--r-- | win/tclWinPipe.c | 97 | ||||
-rw-r--r-- | win/tclWinPort.h | 4 | ||||
-rw-r--r-- | win/tclWinReg.c | 30 | ||||
-rw-r--r-- | win/tclWinSerial.c | 8 | ||||
-rw-r--r-- | win/tclWinSock.c | 6 | ||||
-rw-r--r-- | win/tclsh.rc | 45 |
20 files changed, 431 insertions, 191 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index c0cce6d..7d8001a 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.33.2.3 2000/07/28 07:58:28 mo Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.33.2.4 2001/04/03 22:54:39 hobbs Exp $ VERSION = @TCL_VERSION@ @@ -357,7 +357,7 @@ ${DDE_LIB_FILE}: ${DDE_OBJS} ${TCL_LIB_FILE} ${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE} @$(RM) ${REG_DLL_FILE} - @MAKE_DLL@ ${REG_OBJS} ${TCL_STUB_LIB_FILE} $(SHLIB_LD_LIBS) + @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) ${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE} @$(RM) ${REG_LIB_FILE} @@ -418,11 +418,11 @@ tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl ${DEPARG} $(CC_OBJNAME) .rc.$(RES): - $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" $(DEPARG) + $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" $(DEPARG) install: all install-binaries install-libraries install-doc -install-binaries: +install-binaries: binaries @$(MKDIR) -p "$(BIN_INSTALL_DIR)" @$(MKDIR) -p "$(LIB_INSTALL_DIR)" $(COPY) tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh @@ -467,7 +467,7 @@ install-binaries: $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.0; \ fi -install-libraries: +install-libraries: libraries @for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \ $(SCRIPT_INSTALL_DIR); \ do \ @@ -477,7 +477,7 @@ install-libraries: else true; \ fi; \ done; - @for i in http1.0 http2.3 opt0.4 encoding msgcat1.0 tcltest1.0; \ + @for i in http1.0 http2.3 opt0.4 encoding msgcat1.1 tcltest1.0; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ @@ -486,7 +486,8 @@ install-libraries: fi; \ done; @echo "Installing header files"; - @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" ; \ + @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \ + "$(GENERIC_DIR)/tclPlatDecls.h" ; \ do \ $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \ done; @@ -495,20 +496,41 @@ install-libraries: do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; - @for i in http2.3 http1.0 opt0.4 msgcat1.0 tcltest1.0; \ + @echo "Installing library http1.0 directory"; + @for j in $(ROOT_DIR)/library/http1.0/*.tcl; \ do \ - echo "Installing library $$i directory"; \ - for j in $(ROOT_DIR)/library/$$i/*.tcl; \ - do \ - $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/$$i"; \ - done; \ + $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing encodings" + @echo "Installing library http2.3 directory"; + @for j in $(ROOT_DIR)/library/http/*.tcl; \ + do \ + $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http2.3"; \ + done; + @echo "Installing library opt0.4 directory"; + @for j in $(ROOT_DIR)/library/opt/*.tcl; \ + do \ + $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ + done; + @echo "Installing library msgcat1.1 directory"; + @for j in $(ROOT_DIR)/library/msgcat/*.tcl; \ + do \ + $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/msgcat1.1"; \ + done; + @echo "Installing library tcltest1.0 directory"; + @for j in $(ROOT_DIR)/library/tcltest1.0/*.tcl; \ + do \ + $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/tcltest1.0"; \ + done; + @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ done; -install-doc: +install-doc: doc + +# Specifying TESTFLAGS on the command line is the standard way to pass +# args to tcltest, ie: +# % make test TESTFLAGS="-verbose bps -file fileName.test" test: binaries $(TCLTEST) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ diff --git a/win/configure.in b/win/configure.in index 0e3a421..bab0cf8 100644 --- a/win/configure.in +++ b/win/configure.in @@ -2,14 +2,14 @@ # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.20.2.2 2000/07/28 07:58:28 mo Exp $ +# RCS: @(#) $Id: configure.in,v 1.20.2.3 2001/04/03 22:54:39 hobbs Exp $ AC_INIT(../generic/tcl.h) TCL_VERSION=8.3 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=3 -TCL_PATCH_LEVEL=".2" +TCL_PATCH_LEVEL=".3" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION if test "${prefix}" = "NONE"; then @@ -26,6 +26,23 @@ fi #-------------------------------------------------------------------- SC_ENABLE_GCC +#AC_PROG_CC + +# To properly support cross-compilation, one would +# need to use these tool checks instead of +# the ones below and reconfigure with +# autoconf 2.50. You can also just set +# the CC, AR, RANLIB, and RC environment +# variables if you want to cross compile. +#AC_CHECK_TOOL(AR, ar, :) +#AC_CHECK_TOOL(RANLIB, ranlib, :) +#AC_CHECK_TOOL(RC, windres, :) + +if test "${GCC}" = "yes" ; then + AC_CHECK_PROG(AR, ar, ar) + AC_CHECK_PROG(RANLIB, ranlib, ranlib) + AC_CHECK_PROG(RC, windres, windres) +fi #-------------------------------------------------------------------- # Checks to see if the make progeam sets the $MAKE variable. @@ -126,6 +143,26 @@ CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX} CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX} CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX} +#-------------------------------------------------------------------- +# Adjust the defines for how the resources are built depending +# on symbols and static vs. shared. +#-------------------------------------------------------------------- + +if test ${SHARED_BUILD} = 0 ; then + if test "${DBGX}" = "d"; then + RC_DEFINES="-d STATIC_BUILD -d DEBUG" + else + RC_DEFINES="-d STATIC_BUILD" + fi +else + if test "${DBGX}" = "d"; then + RC_DEFINES="-d DEBUG" + else + RC_DEFINES="" + fi +fi + + AC_SUBST(TCL_VERSION) AC_SUBST(TCL_MAJOR_VERSION) AC_SUBST(TCL_MINOR_VERSION) @@ -173,6 +210,7 @@ AC_SUBST(RC) AC_SUBST(RC_OUT) AC_SUBST(RC_TYPE) AC_SUBST(RC_INCLUDE) +AC_SUBST(RC_DEFINES) AC_SUBST(RES) AC_SUBST(LIBS) AC_SUBST(LIBS_GUI) diff --git a/win/makefile.vc b/win/makefile.vc index 72ce802..01aedc4 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -1,12 +1,12 @@ -# Visual C++ 2.x and 4.0 makefile +# Visual C++ makefile # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 1998-2000 Ajuba Solutions. # -# RCS: @(#) $Id: makefile.vc,v 1.50.2.1 2000/07/27 01:39:24 hobbs Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.50.2.2 2001/04/03 22:54:39 hobbs Exp $ # Does not depend on the presence of any environment variables in # order to compile tcl; all needed information is derived from @@ -27,19 +27,45 @@ # # Set this to the appropriate value of /MACHINE: for your platform +# Choices: IX86, IA64, ALPHA MACHINE = IX86 ROOT = .. -INSTALLDIR = c:\Progra~1\Tcl +INSTALLDIR = C:\Progra~1\Tcl !IF "$(MACHINE)" == "IA64" -TOOLS32 = c:\ia64sdk17 -TOOLS32_rc = c:\ia64sdk17 + +# IA64 support is based on the standard setup with v2 of the +# Microsoft Platform SDK for Whistler, build 2267 + +TOOLS32 = C:\Progra~1\Microsoft Platform SDK +TOOLS32_rc = C:\Progra~1\Microsoft Platform SDK + +cc32 = "$(TOOLS32)\bin\Win64\cl.exe" +link32 = "$(TOOLS32)\bin\Win64\link.exe" +libpath32 = /LIBPATH:"$(TOOLS32)\lib\IA64" +lib32 = "$(TOOLS32)\bin\Win64\lib.exe" + !ELSE -TOOLS32 = c:\Progra~1\devstudio\vc -TOOLS32_rc = c:\Progra~1\devstudio\sharedide + +# Visual Studio 5 default +#TOOLS32 = C:\Progra~1\devstudio\vc +#TOOLS32_rc = C:\Progra~1\devstudio\sharedide + +# Visual Studio 6 default +TOOLS32 = C:\Progra~1\Microsoft Visual Studio\VC98 +TOOLS32_rc = C:\Progra~1\Microsoft Visual Studio\common\MSDev98 + +cc32 = "$(TOOLS32)\bin\cl.exe" +link32 = "$(TOOLS32)\bin\link.exe" +libpath32 = /LIBPATH:"$(TOOLS32)\lib" +lib32 = "$(TOOLS32)\bin\lib.exe" + !ENDIF +rc32 = "$(TOOLS32_rc)\bin\rc.exe" +include32 = -I"$(TOOLS32)\include" + # Uncomment the following line to compile with thread support #THREADDEFINES = -DTCL_THREADS=1 @@ -54,10 +80,15 @@ NODEBUG = 1 # -DTCL_COMPILE_STATS Enables byte compilation statistics gathering. # -DUSE_TCLALLOC=0 Disables the Tcl memory allocator in favor # of the native malloc implementation. This is -# needed when using Purify. +# needed when using Purify. For IA64, we do +# want to use the native allocator. # #DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS +!IF "$(MACHINE)" == "IA64" +DEBUGDEFINES = -DUSE_TCLALLOC=0 +!ELSE #DEBUGDEFINES = -DUSE_TCLALLOC=0 +!ENDIF ###################################################################### # Do not modify below this line @@ -201,13 +232,6 @@ TCLOBJS = \ TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj \ -cc32 = "$(TOOLS32)\bin\cl.exe" -link32 = "$(TOOLS32)\bin\link.exe" -rc32 = "$(TOOLS32_rc)\bin\rc.exe" -include32 = -I"$(TOOLS32)\include" -libpath32 = /LIBPATH:"$(TOOLS32)\lib" -lib32 = "$(TOOLS32)\bin\lib.exe" - WINDIR = $(ROOT)\win GENERICDIR = $(ROOT)\generic @@ -221,13 +245,11 @@ TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) !IF "$(NODEBUG)" == "1" # This cranks the optimization level to maximize speed cdebug = -O2 -Gs -GD -!ELSE -!IF "$(MACHINE)" == "IA64" +!ELSE IF "$(MACHINE)" == "IA64" cdebug = -Od -Zi !ELSE cdebug = -Z7 -Od -WX !ENDIF -!ENDIF # declarations common to all compiler options cflags = -c -W3 -nologo -Fp$(TMPDIR)\ -YX @@ -254,14 +276,12 @@ lflags = /NODEFAULTLIB /NOLOGO /MACHINE:$(MACHINE) $(libpath32) !IF "$(MACHINE)" == "IX86" DLLENTRY = @12 dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll -!ELSE -!IF "$(MACHINE)" == "IA64" +!ELSE IF "$(MACHINE)" == "IA64" DLLENTRY = @12 dlllflags = $(lflags) -dll !ELSE dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll !ENDIF -!ENDIF conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup @@ -370,16 +390,16 @@ install-libraries: -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" @echo installing http2.3 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.3" - -@copy "$(ROOT)\library\http2.3\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.3" - -@copy "$(ROOT)\library\http2.3\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.3" + -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.3" + -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.3" @echo installing opt0.4 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4" - -@copy "$(ROOT)\library\opt0.4\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" - -@copy "$(ROOT)\library\opt0.4\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" - @echo installing msgcat1.0 - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.0" - -@copy "$(ROOT)\library\msgcat1.0\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.0" - -@copy "$(ROOT)\library\msgcat1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.0" + -@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" + -@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" + @echo installing msgcat1.1 + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.1" + -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.1" + -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.1" @echo installing $(TCLDDEDLLNAME) -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.1" -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.1" @@ -392,17 +412,18 @@ install-libraries: -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding" -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding" @echo installing library files - -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)" - -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)" - -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)" + -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)" + -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)" + -@copy "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)" + -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)" + -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)" + -@copy "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)" + -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)" + -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)" + -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)" + -@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)" + -@copy "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)" + -@copy "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)" # # Regenerate the stubs files. @@ -508,7 +529,11 @@ $(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h {$(WINDIR)}.rc{$(TMPDIR)}.res: $(rc32) -fo $@ -r -i $(GENERICDIR) -i $(WINDIR) -D__WIN32__ \ - $(TCL_DEFINES) $< + $(TCL_DEFINES) \ +!if "$(NODEBUG)" == "0" + -d DEBUG \ +!endif + $< clean: -@$(RM) $(OUTDIR)\*.exp @@ -307,6 +307,13 @@ AC_DEFUN(SC_ENABLE_THREADS, [ #------------------------------------------------------------------------ AC_DEFUN(SC_ENABLE_SYMBOLS, [ + + # Step 0: Enable 64 bit support? + + AC_MSG_CHECKING([if 64bit support is requested]) + AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)], [do64bit=$enableval], [do64bit=no]) + AC_MSG_RESULT($do64bit) + AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no]) @@ -384,6 +391,9 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ # set various compiler flags depending on whether we are using gcc or cl if test "${GCC}" = "yes" ; then + if test "$do64bit" = "yes" ; then + AC_MSG_WARN("64bit mode not supported with GCC on Windows") + fi SHLIB_LD="" SHLIB_LD_LIBS="" LIBS="" @@ -536,6 +546,10 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ # built -- Console vs. Window. LDFLAGS_CONSOLE="-link -subsystem:console" LDFLAGS_WINDOW="-link -subsystem:windows" + + if test "$do64bit" = "yes" ; then + EXTRA_CFLAGS="$EXTRA_CFLAGS -DUSE_TCLALLOC=0" + fi fi ]) @@ -1,22 +1,44 @@ -// RCS: @(#) $Id: tcl.rc,v 1.5 2000/04/18 23:26:45 redman Exp $ +// RCS: @(#) $Id: tcl.rc,v 1.5.2.1 2001/04/03 22:54:39 hobbs Exp $ // -// Version +// Version Resource Script // -#define VS_VERSION_INFO 1 +#include <winver.h> #define RESOURCE_INCLUDED #include <tcl.h> +// +// build-up the name suffix that defines the type of build this is. +// +#ifdef TCL_THREADS +#define SUFFIX_THREADS "t" +#else +#define SUFFIX_THREADS "" +#endif + +#ifdef DEBUG +#define SUFFIX_DEBUG "d" +#else +#define SUFFIX_DEBUG "" +#endif + +#define SUFFIX SUFFIX_THREADS SUFFIX_DEBUG + + LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ VS_VERSION_INFO VERSIONINFO FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL FILEFLAGSMASK 0x3fL +#ifdef DEBUG + FILEFLAGS VS_FF_DEBUG +#else FILEFLAGS 0x0L - FILEOS 0x4 /* VOS__WINDOWS32 */ - FILETYPE 0x2 /* VFT_DLL */ +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL FILESUBTYPE 0x0L BEGIN BLOCK "StringFileInfo" @@ -24,10 +46,10 @@ BEGIN BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */ BEGIN VALUE "FileDescription", "Tcl DLL\0" - VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".dll\0" - VALUE "CompanyName", "Scriptics Corporation\0" + VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".dll\0" + VALUE "CompanyName", "Ajuba Solutions\0" VALUE "FileVersion", TCL_PATCH_LEVEL - VALUE "LegalCopyright", "Copyright (c) 2000 by Scriptics Corporation\0" + VALUE "LegalCopyright", "Copyright (c) 2000 by Ajuba Solutions\0" VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" VALUE "ProductVersion", TCL_PATCH_LEVEL END @@ -37,10 +59,3 @@ BEGIN VALUE "Translation", 0x409, 1200 END END - - - - - - - diff --git a/win/tclWinChan.c b/win/tclWinChan.c index d6fa836..a48e5f2 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinChan.c,v 1.10.2.1 2000/07/27 01:39:24 hobbs Exp $ + * RCS: @(#) $Id: tclWinChan.c,v 1.10.2.2 2001/04/03 22:54:39 hobbs Exp $ */ #include "tclWinInt.h" @@ -879,16 +879,21 @@ Tcl_MakeFileChannel(rawHandle, mode) char channelName[16 + TCL_INTEGER_SPACE]; Tcl_Channel channel = NULL; HANDLE handle = (HANDLE) rawHandle; + HANDLE dupedHandle; DCB dcb; - DWORD consoleParams; - DWORD type; + DWORD consoleParams, type; TclFile readFile = NULL; TclFile writeFile = NULL; + BOOL result; if (mode == 0) { return NULL; } + /* + * GetFileType() returns FILE_TYPE_UNKNOWN for invalid handles. + */ + type = GetFileType(handle); /* @@ -930,19 +935,58 @@ Tcl_MakeFileChannel(rawHandle, mode) case FILE_TYPE_DISK: case FILE_TYPE_CHAR: - case FILE_TYPE_UNKNOWN: channel = TclWinOpenFileChannel(handle, channelName, mode, 0); break; + case FILE_TYPE_UNKNOWN: default: /* - * The handle is of an unknown type, probably /dev/nul equivalent - * or possibly a closed handle. + * The handle is of an unknown type. Test the validity of this OS + * handle by duplicating it, then closing the dupe. The Win32 API + * doesn't provide an IsValidHandle() function, so we have to emulate + * it here. This test will not work on a console handle reliably, + * which is why we can't test every handle that comes into this + * function in this way. + */ + + result = DuplicateHandle(GetCurrentProcess(), handle, + GetCurrentProcess(), &dupedHandle, 0, FALSE, + DUPLICATE_SAME_ACCESS); + + if (result != 0) { + /* + * Unable to make a duplicate. It's definately invalid at this + * point. + */ + + return NULL; + } + + /* + * Use structured exception handling (Win32 SEH) to protect the close + * of this duped handle which might throw EXCEPTION_INVALID_HANDLE. */ - - channel = NULL; - break; + __try { + CloseHandle(dupedHandle); + } + __except (EXCEPTION_EXECUTE_HANDLER) { + /* + * Definately an invalid handle. So, therefore, the original + * is invalid also. + */ + + return NULL; + } + + /* Fall through, the handle is valid. */ + + /* + * Create the undefined channel, anyways, because we know the handle + * is valid to something. + */ + + channel = TclWinOpenFileChannel(handle, channelName, mode, 0); } return channel; @@ -975,6 +1019,7 @@ TclpGetDefaultStdChannel(type) char *bufMode; DWORD handleId; /* Standard handle to retrieve. */ + switch (type) { case TCL_STDIN: handleId = STD_INPUT_HANDLE; @@ -1003,15 +1048,15 @@ TclpGetDefaultStdChannel(type) * is not a console mode application, even though this is not a valid * handle. */ - + if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) { - return NULL; + return (Tcl_Channel) NULL; } - + channel = Tcl_MakeFileChannel(handle, mode); if (channel == NULL) { - return NULL; + return (Tcl_Channel) NULL; } /* diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 579900e..009cd76 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinConsole.c,v 1.3.10.1 2000/07/27 01:39:25 hobbs Exp $ + * RCS: @(#) $Id: tclWinConsole.c,v 1.3.10.2 2001/04/03 22:54:39 hobbs Exp $ */ #include "tclWinInt.h" @@ -135,14 +135,6 @@ typedef struct ConsoleEvent { * Declarations for functions used only in this file. */ -static int ApplicationType(Tcl_Interp *interp, - const char *fileName, char *fullName); -static void BuildCommandLine(const char *executable, int argc, - char **argv, Tcl_DString *linePtr); -static void CopyChannel(HANDLE dst, HANDLE src); -static BOOL HasConsole(void); -static TclFile MakeFile(HANDLE handle); -static char * MakeTempFile(Tcl_DString *namePtr); static int ConsoleBlockModeProc(ClientData instanceData, int mode); static void ConsoleCheckProc(ClientData clientData, int flags); static int ConsoleCloseProc(ClientData instanceData, @@ -161,7 +153,6 @@ static void ConsoleSetupProc(ClientData clientData, int flags); static void ConsoleWatchProc(ClientData instanceData, int mask); static DWORD WINAPI ConsoleWriterThread(LPVOID arg); static void ProcExitHandler(ClientData clientData); -static int TempFileName(WCHAR name[MAX_PATH]); static int WaitForRead(ConsoleInfo *infoPtr, int blocking); /* @@ -636,11 +627,11 @@ ConsoleInputProc( */ if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) { - memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize); + memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize); bytesRead = bufSize; infoPtr->offset += bufSize; } else { - memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize); + memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize); bytesRead = infoPtr->bytesRead - infoPtr->offset; /* @@ -734,9 +725,9 @@ ConsoleOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc(toWrite); + infoPtr->writeBuf = ckalloc((unsigned int) toWrite); } - memcpy(infoPtr->writeBuf, buf, toWrite); + memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); infoPtr->toWrite = toWrite; ResetEvent(infoPtr->writable); SetEvent(infoPtr->startWriter); @@ -1086,7 +1077,7 @@ ConsoleReaderThread(LPVOID arg) * that are not KEY_EVENTs */ if (ReadConsole(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE, - &infoPtr->bytesRead, NULL) != FALSE) { + (LPDWORD) &infoPtr->bytesRead, NULL) != FALSE) { /* * Data was stored in the buffer. */ diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 2eaf974..359e7ec 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.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: tclWinDde.c,v 1.5 1999/06/26 22:41:53 redman Exp $ + * RCS: @(#) $Id: tclWinDde.c,v 1.5.10.1 2001/04/03 22:54:39 hobbs Exp $ */ #include "tclPort.h" @@ -733,7 +733,6 @@ MakeDdeConnection( { HSZ ddeTopic, ddeService; HCONV ddeConv; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0); ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); diff --git a/win/tclWinError.c b/win/tclWinError.c index 7786334..ad2aeb4 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinError.c,v 1.3 1999/04/16 00:48:08 stanton Exp $ + * RCS: @(#) $Id: tclWinError.c,v 1.3.12.1 2001/04/03 22:54:39 hobbs Exp $ */ #include "tclWinInt.h" @@ -147,7 +147,7 @@ static char errorTable[] = { EINVAL, /* 124 */ EINVAL, /* 125 */ EINVAL, /* 126 */ - ESRCH, /* ERROR_PROC_NOT_FOUND 127 */ + EINVAL, /* ERROR_PROC_NOT_FOUND 127 */ ECHILD, /* ERROR_WAIT_NO_CHILDREN 128 */ ECHILD, /* ERROR_CHILD_NOT_COMPLETE 129 */ EBADF, /* ERROR_DIRECT_ACCESS_HANDLE 130 */ diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 1a689ac..617e267 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.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: tclWinFile.c,v 1.7 1999/12/12 22:46:51 hobbs Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.7.2.1 2001/04/03 22:54:39 hobbs Exp $ */ #include "tclWinInt.h" @@ -326,13 +326,20 @@ TclpMatchFilesTypes( fname = Tcl_DStringValue(dirPtr); nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(dirPtr), &ds); - attr = (*tclWinProcs->getFileAttributesProc)(nativeName); - Tcl_DStringFree(&ds); + + /* + * 'attr' represents the attributes of the file, but we only + * want to retrieve this info if it is absolutely necessary + * because it is an expensive call. + */ + + attr = 0; if (tail == NULL) { int typeOk = 1; if (types != NULL) { if (types->perm != 0) { + attr = (*tclWinProcs->getFileAttributesProc)(nativeName); if ( ((types->perm & TCL_GLOB_PERM_RONLY) && !(attr & FILE_ATTRIBUTE_READONLY)) || @@ -389,13 +396,22 @@ TclpMatchFilesTypes( Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr))); } - } else if (attr & FILE_ATTRIBUTE_DIRECTORY) { - Tcl_DStringAppend(dirPtr, "/", 1); - result = TclDoGlob(interp, separators, dirPtr, tail, types); - if (result != TCL_OK) { - break; + } else { + attr = (*tclWinProcs->getFileAttributesProc)(nativeName); + if (attr & FILE_ATTRIBUTE_DIRECTORY) { + Tcl_DStringAppend(dirPtr, "/", 1); + result = TclDoGlob(interp, separators, dirPtr, tail, types); + if (result != TCL_OK) { + break; + } } } + /* + * Free ds here to ensure that nativeName is valid above. + */ + + Tcl_DStringFree(&ds); + Tcl_DStringSetLength(dirPtr, dirLength); } diff --git a/win/tclWinInit.c b/win/tclWinInit.c index dbf44ea..2d22b0a 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclWinInit.c,v 1.22 2000/03/31 08:52:31 hobbs Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.22.2.1 2001/04/03 22:54:39 hobbs Exp $ */ #include "tclWinInt.h" @@ -248,42 +248,42 @@ TclpInitLibraryPath(path) if (path != NULL) { Tcl_SplitPath(path, &pathc, &pathv); - if (pathc > 1) { + if (pathc > 2) { pathv[pathc - 2] = installLib; path = Tcl_JoinPath(pathc - 1, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 2) { + if (pathc > 3) { pathv[pathc - 3] = installLib; path = Tcl_JoinPath(pathc - 2, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 1) { + if (pathc > 2) { pathv[pathc - 2] = "library"; path = Tcl_JoinPath(pathc - 1, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 2) { + if (pathc > 3) { pathv[pathc - 3] = "library"; path = Tcl_JoinPath(pathc - 2, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 1) { + if (pathc > 3) { pathv[pathc - 3] = developLib; path = Tcl_JoinPath(pathc - 2, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 3) { + if (pathc > 4) { pathv[pathc - 4] = developLib; path = Tcl_JoinPath(pathc - 3, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); @@ -622,7 +622,7 @@ TclpSetVariables(interp) Tcl_DStringSetLength(&ds, 100); if (TclGetEnv("USERNAME", &ds) == NULL) { - if (GetUserName(Tcl_DStringValue(&ds), &Tcl_DStringLength(&ds)) == 0) { + if (GetUserName(Tcl_DStringValue(&ds), (LPDWORD) &Tcl_DStringLength(&ds)) == 0) { Tcl_DStringSetLength(&ds, 0); } } diff --git a/win/tclWinInt.h b/win/tclWinInt.h index b744045..d6ac043 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinInt.h,v 1.8 1999/08/03 18:07:15 redman Exp $ + * RCS: @(#) $Id: tclWinInt.h,v 1.8.10.1 2001/04/03 22:54:39 hobbs Exp $ */ #ifndef _TCLWININT @@ -92,7 +92,6 @@ typedef struct TclWinProcs { } TclWinProcs; EXTERN TclWinProcs *tclWinProcs; -EXTERN Tcl_Encoding tclWinTCharEncoding; /* * Declarations of functions that are not accessible by way of the diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 360b629..c685d3d 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.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: tclWinLoad.c,v 1.5 2000/02/10 09:53:57 hobbs Exp $ + * RCS: @(#) $Id: tclWinLoad.c,v 1.5.2.1 2001/04/03 22:54:39 hobbs Exp $ */ #include "tclWinInt.h" @@ -87,8 +87,12 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) case ERROR_MOD_NOT_FOUND: case ERROR_DLL_NOT_FOUND: Tcl_AppendResult(interp, "this library or a dependent library", - " could not be found in library path", (char *) - NULL); + " could not be found in library path", + (char *) NULL); + break; + case ERROR_PROC_NOT_FOUND: + Tcl_AppendResult(interp, "could not find specified procedure", + (char *) NULL); break; case ERROR_INVALID_DLL: Tcl_AppendResult(interp, "this library or a dependent library", diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 932f86c..a930e7b 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -10,18 +10,12 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinNotify.c,v 1.5 1999/07/02 22:08:28 redman Exp $ + * RCS: @(#) $Id: tclWinNotify.c,v 1.5.10.1 2001/04/03 22:54:39 hobbs Exp $ */ #include "tclWinInt.h" #include <winsock.h> -/* - * The follwing static indicates whether this module has been initialized. - */ - -static int initialized = 0; - #define INTERVAL_TIMER 1 /* Handle of interval timer. */ #define WM_WAKEUP WM_USER /* Message that is send by @@ -468,7 +462,7 @@ Tcl_WaitForEvent( * propagate the quit message and start unwinding. */ - PostQuitMessage(msg.wParam); + PostQuitMessage((int) msg.wParam); status = -1; } else if (result == -1) { /* diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 0f3793a..2448b4a 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinPipe.c,v 1.11.2.1 2000/07/27 01:39:25 hobbs Exp $ + * RCS: @(#) $Id: tclWinPipe.c,v 1.11.2.2 2001/04/03 22:54:39 hobbs Exp $ */ #include "tclWinInt.h" @@ -124,6 +124,8 @@ typedef struct PipeInfo { HANDLE startReader; /* Auto-reset event used by the main thread to * signal when the reader thread should attempt * to read from the pipe. */ + HANDLE stopReader; /* Manual-reset event used to alert the reader + * thread to fall-out and exit */ DWORD writeError; /* An error caused by the last background * write. Set to 0 if no error has been * detected. This word is shared with the @@ -833,7 +835,8 @@ TclpCloseFile( || ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle) && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) { - if (CloseHandle(filePtr->handle) == FALSE) { + if (filePtr->handle != NULL && + CloseHandle(filePtr->handle) == FALSE) { TclWinConvertError(GetLastError()); ckfree((char *) filePtr); return -1; @@ -1197,7 +1200,7 @@ TclpCreateProcess( if ((*tclWinProcs->createProcessProc)(NULL, (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, - createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { + (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { TclWinConvertError(GetLastError()); Tcl_AppendResult(interp, "couldn't execute \"", argv[0], "\": ", Tcl_PosixError(interp), (char *) NULL); @@ -1572,6 +1575,7 @@ BuildCommandLine( Tcl_DStringAppend(&ds, "\"", 1); } } + Tcl_DStringFree(linePtr); Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr); Tcl_DStringFree(&ds); } @@ -1648,7 +1652,8 @@ TclpCreateCommandChannel( infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL); infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL); - infoPtr->readThread = CreateThread(NULL, 8000, PipeReaderThread, + infoPtr->stopReader = CreateEvent(NULL, TRUE, FALSE, NULL); + infoPtr->readThread = CreateThread(NULL, 512, PipeReaderThread, infoPtr, 0, &id); SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); infoPtr->validMask |= TCL_READABLE; @@ -1657,12 +1662,12 @@ TclpCreateCommandChannel( } if (writeFile != NULL) { /* - * Start the background writeer thwrite. + * Start the background writer thread. */ infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL); infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL); - infoPtr->writeThread = CreateThread(NULL, 8000, PipeWriterThread, + infoPtr->writeThread = CreateThread(NULL, 512, PipeWriterThread, infoPtr, 0, &id); SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); infoPtr->validMask |= TCL_WRITABLE; @@ -1807,6 +1812,7 @@ PipeClose2Proc( int errorCode, result; PipeInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + DWORD exitCode; errorCode = 0; if ((!flags || (flags == TCL_CLOSE_READ)) @@ -1819,29 +1825,60 @@ PipeClose2Proc( if (pipePtr->readThread) { /* - * Forcibly terminate the background thread. We cannot rely on the - * thread to cleanly terminate itself because we have no way of - * closing the pipe handle without blocking in the case where the - * thread is in the middle of an I/O operation. Note that we need - * to guard against terminating the thread while it is in the - * middle of Tcl_ThreadAlert because it won't be able to release - * the notifier lock. + * Note that we need to guard against terminating the thread while + * it is in the middle of Tcl_ThreadAlert because it won't be able + * to release the notifier lock. */ Tcl_MutexLock(&pipeMutex); - TerminateThread(pipePtr->readThread, 0); /* - * Wait for the thread to terminate. This ensures that we are - * completely cleaned up before we leave this function. + * The thread may already have closed on it's own. Check it's + * exit code. */ - WaitForSingleObject(pipePtr->readThread, INFINITE); + GetExitCodeThread(pipePtr->readThread, &exitCode); + + if (exitCode == STILL_ACTIVE) { + /* + * Set the stop event so that if the reader thread is blocked + * in PipeReaderThread on WaitForMultipleEvents, it will exit + * cleanly. + */ + + SetEvent(pipePtr->stopReader); + + /* + * Wait at most 10 milliseconds for the reader thread to close. + */ + + WaitForSingleObject(pipePtr->readThread, 10); + GetExitCodeThread(pipePtr->readThread, &exitCode); + + if (exitCode == STILL_ACTIVE) { + /* + * The thread must be blocked waiting for the pipe to become + * readable in ReadFile(). There isn't a clean way to exit + * the thread from this condition. We should terminate the + * child process instead to get the reader thread to fall out of + * ReadFile with a FALSE. (below) is not the correct way to do + * this, but will stay here until a better solution is found. + */ + + /* BUG: this leaks memory */ + TerminateThread(pipePtr->readThread, 0); + + /* Wait for the thread to terminate. */ + WaitForSingleObject(pipePtr->readThread, INFINITE); + } + } + Tcl_MutexUnlock(&pipeMutex); CloseHandle(pipePtr->readThread); CloseHandle(pipePtr->readable); CloseHandle(pipePtr->startReader); + CloseHandle(pipePtr->stopReader); pipePtr->readThread = NULL; } if (TclpCloseFile(pipePtr->readFile) != 0) { @@ -2115,9 +2152,9 @@ PipeOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc(toWrite); + infoPtr->writeBuf = ckalloc((unsigned int) toWrite); } - memcpy(infoPtr->writeBuf, buf, toWrite); + memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); infoPtr->toWrite = toWrite; ResetEvent(infoPtr->writable); SetEvent(infoPtr->startWriter); @@ -2360,7 +2397,7 @@ Tcl_WaitPid( int options) { ProcInfo *infoPtr, **prevPtrPtr; - int flags; + DWORD flags; Tcl_Pid result; DWORD ret; @@ -2662,7 +2699,9 @@ WaitForRead( * Side effects: * Signals the main thread when input become available. May * cause the main thread to wake up by posting a message. May - * consume one byte from the pipe for each wait operation. + * consume one byte from the pipe for each wait operation. Will + * cause a memory leak of ~4k, if forcefully terminated with + * TerminateThread(). * *---------------------------------------------------------------------- */ @@ -2674,13 +2713,25 @@ PipeReaderThread(LPVOID arg) HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle; DWORD count, err; int done = 0; + HANDLE wEvents[2] = {infoPtr->stopReader, infoPtr->startReader}; + DWORD dwWait; while (!done) { /* - * Wait for the main thread to signal before attempting to wait. + * Wait for the main thread to signal before attempting to wait + * on the pipe becoming readable. */ - WaitForSingleObject(infoPtr->startReader, INFINITE); + dwWait = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE); + + if (dwWait != (WAIT_OBJECT_0 + 1)) { + /* + * The start event was not signaled. It might be the stop event + * or an error, so exit. + */ + + return 0; + } /* * Try waiting for 0 bytes. This will block until some data is diff --git a/win/tclWinPort.h b/win/tclWinPort.h index a40681c..d28b7d9 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -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: tclWinPort.h,v 1.12 2000/03/31 08:52:31 hobbs Exp $ + * RCS: @(#) $Id: tclWinPort.h,v 1.12.2.1 2001/04/03 22:54:40 hobbs Exp $ */ #ifndef _TCLWINPORT @@ -66,7 +66,7 @@ typedef float *TCHAR; #include <tchar.h> #include <time.h> -#include <winsock2.h> +#include <winsock.h> #define WIN32_LEAN_AND_MEAN #include <windows.h> diff --git a/win/tclWinReg.c b/win/tclWinReg.c index e5808c2..dd2c83a 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.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: tclWinReg.c,v 1.11 2000/03/31 08:52:32 hobbs Exp $ + * RCS: @(#) $Id: tclWinReg.c,v 1.11.2.1 2001/04/03 22:54:40 hobbs Exp $ */ #include <tclPort.h> @@ -367,7 +367,7 @@ DeleteKey( */ keyName = Tcl_GetStringFromObj(keyNameObj, &length); - buffer = ckalloc(length + 1); + buffer = ckalloc((unsigned int) length + 1); strcpy(buffer, keyName); if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName) @@ -621,7 +621,7 @@ GetType( */ if (type > lastType || type < 0) { - Tcl_SetIntObj(resultPtr, type); + Tcl_SetIntObj(resultPtr, (int) type); } else { Tcl_SetStringObj(resultPtr, typeNames[type], -1); } @@ -680,7 +680,7 @@ GetValue( Tcl_DStringInit(&data); length = TCL_DSTRING_STATIC_SIZE - 1; - Tcl_DStringSetLength(&data, length); + Tcl_DStringSetLength(&data, (int) length); resultPtr = Tcl_GetObjResult(interp); @@ -696,7 +696,7 @@ GetValue( * Required for HKEY_PERFORMANCE_DATA */ length *= 2; - Tcl_DStringSetLength(&data, length); + Tcl_DStringSetLength(&data, (int) length); result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } @@ -719,7 +719,7 @@ GetValue( */ if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { - Tcl_SetIntObj(resultPtr, ConvertDWORD(type, + Tcl_SetIntObj(resultPtr, (int) ConvertDWORD(type, *((DWORD*) Tcl_DStringValue(&data)))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); @@ -754,7 +754,7 @@ GetValue( * Save binary data as a byte array. */ - Tcl_SetByteArrayObj(resultPtr, Tcl_DStringValue(&data), length); + Tcl_SetByteArrayObj(resultPtr, Tcl_DStringValue(&data), (int) length); } Tcl_DStringFree(&data); return result; @@ -822,7 +822,7 @@ GetValueNames( Tcl_DStringInit(&buffer); Tcl_DStringSetLength(&buffer, - (regWinProcs->useWide) ? maxSize*2 : maxSize); + (int) ((regWinProcs->useWide) ? maxSize*2 : maxSize)); index = 0; result = TCL_OK; @@ -847,7 +847,7 @@ GetValueNames( size *= 2; } - Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), size, &ds); + Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds); name = Tcl_DStringValue(&ds); if (!pattern || Tcl_StringMatch(name, pattern)) { result = Tcl_ListObjAppendElement(interp, resultPtr, @@ -901,7 +901,7 @@ OpenKey( DWORD result; keyName = Tcl_GetStringFromObj(keyNameObj, &length); - buffer = ckalloc(length + 1); + buffer = ckalloc((unsigned int) length + 1); strcpy(buffer, keyName); result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); @@ -1135,7 +1135,7 @@ RecursiveDeleteKey( Tcl_DStringInit(&subkey); Tcl_DStringSetLength(&subkey, - (regWinProcs->useWide) ? maxSize * 2 : maxSize); + (int) ((regWinProcs->useWide) ? maxSize * 2 : maxSize)); while (result == ERROR_SUCCESS) { /* @@ -1272,7 +1272,7 @@ SetValue( length = Tcl_DStringLength(&buf) + 1; result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type, - (BYTE*)data, length); + (BYTE*)data, (DWORD) length); Tcl_DStringFree(&buf); } else { char *data; @@ -1283,7 +1283,7 @@ SetValue( data = Tcl_GetByteArrayFromObj(dataObj, &length); result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type, - (BYTE *)data, length); + (BYTE *)data, (DWORD) length); } Tcl_DStringFree(&nameBuf); RegCloseKey(key); @@ -1346,7 +1346,7 @@ AppendSystemError( if (error == ERROR_CALL_NOT_IMPLEMENTED) { msg = "function not supported under Win32s"; } else { - sprintf(msgBuf, "unknown error: %d", error); + sprintf(msgBuf, "unknown error: %ld", error); msg = msgBuf; } } else { @@ -1371,7 +1371,7 @@ AppendSystemError( } } - sprintf(id, "%d", error); + sprintf(id, "%ld", error); Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL); Tcl_AppendToObj(resultPtr, msg, length); diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 8e1da0a..ba86f17 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -10,7 +10,7 @@ * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * Changes by Rolf.Schroedter@dlr.de June 25-27, 1999 * - * RCS: @(#) $Id: tclWinSerial.c,v 1.9.2.1 2000/07/27 01:39:26 hobbs Exp $ + * RCS: @(#) $Id: tclWinSerial.c,v 1.9.2.2 2001/04/03 22:54:40 hobbs Exp $ */ #include "tclWinInt.h" @@ -1047,7 +1047,7 @@ SerialSetOptionProc(instanceData, interp, optionName, value) { SerialInfo *infoPtr; DCB dcb; - int len; + size_t len; BOOL result; Tcl_DString ds; TCHAR *native; @@ -1123,7 +1123,7 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) { SerialInfo *infoPtr; DCB dcb; - int len; + size_t len; int valid = 0; /* flag if valid option parsed */ infoPtr = (SerialInfo *) instanceData; @@ -1157,7 +1157,7 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) char buf[2 * TCL_INTEGER_SPACE + 16]; parity = 'n'; - if (dcb.Parity < 4) { + if (dcb.Parity <= 4) { parity = "noems"[dcb.Parity]; } diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 24429f4..3147be2 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinSock.c,v 1.18.2.1 2000/07/27 01:39:26 hobbs Exp $ + * RCS: @(#) $Id: tclWinSock.c,v 1.18.2.2 2001/04/03 22:54:40 hobbs Exp $ */ #include "tclWinInt.h" @@ -226,7 +226,7 @@ static Tcl_ChannelType tcpChannelType = { TcpWatchProc, /* Set up notifier to watch this channel. */ TcpGetHandleProc, /* Get an OS handle from channel. */ NULL, /* close2proc. */ - TcpBlockProc, /* Set blocking/non-blocking mode. */ + TcpBlockProc, /* Set socket into (non-)blocking mode. */ NULL, /* flush proc. */ NULL, /* handler proc. */ }; @@ -836,9 +836,9 @@ SocketEventProc(evPtr, flags) if ((*winSock.select)(0, &readFds, NULL, NULL, &timeout) != 0) { mask |= TCL_READABLE; } else { + infoPtr->readyEvents &= ~(FD_READ); SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr); - infoPtr->readyEvents &= ~(FD_READ); } } if (events & (FD_WRITE | FD_CONNECT)) { diff --git a/win/tclsh.rc b/win/tclsh.rc index 874abd7..250b36f 100644 --- a/win/tclsh.rc +++ b/win/tclsh.rc @@ -1,22 +1,50 @@ -// RCS: @(#) $Id: tclsh.rc,v 1.5 2000/04/18 23:26:45 redman Exp $ +// RCS: @(#) $Id: tclsh.rc,v 1.5.2.1 2001/04/03 22:54:40 hobbs Exp $ // -// Version +// Version Resource Script // -#define VS_VERSION_INFO 1 +#include <winver.h> #define RESOURCE_INCLUDED #include <tcl.h> +// +// build-up the name suffix that defines the type of build this is. +// +#ifdef TCL_THREADS +#define SUFFIX_THREADS "t" +#else +#define SUFFIX_THREADS "" +#endif + +#ifdef STATIC_BUILD +#define SUFFIX_STATIC "s" +#else +#define SUFFIX_STATIC "" +#endif + +#ifdef DEBUG +#define SUFFIX_DEBUG "d" +#else +#define SUFFIX_DEBUG "" +#endif + +#define SUFFIX SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG + + LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ VS_VERSION_INFO VERSIONINFO FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL FILEFLAGSMASK 0x3fL +#ifdef DEBUG + FILEFLAGS VS_FF_DEBUG +#else FILEFLAGS 0x0L - FILEOS 0x4 /* VOS__WINDOWS32 */ - FILETYPE 0x2 /* VFT_DLL */ +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_APP FILESUBTYPE 0x0L BEGIN BLOCK "StringFileInfo" @@ -24,10 +52,10 @@ BEGIN BLOCK "040904b0" BEGIN VALUE "FileDescription", "Tclsh Application\0" - VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".exe\0" - VALUE "CompanyName", "Scriptics Corporation\0" + VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0" + VALUE "CompanyName", "Ajuba Solutions\0" VALUE "FileVersion", TCL_PATCH_LEVEL - VALUE "LegalCopyright", "Copyright (c) 2000 by Scriptics Corporation\0" + VALUE "LegalCopyright", "Copyright (c) 2000 by Ajuba Solutions\0" VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" VALUE "ProductVersion", TCL_PATCH_LEVEL END @@ -43,4 +71,3 @@ END // tclsh ICON DISCARDABLE "tclsh.ico" - |