diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2012-08-04 07:47:22 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2012-08-04 07:47:22 (GMT) |
commit | ef03a2c7809309b2255f7c82c6abe0db2e4160bf (patch) | |
tree | fd7b6368f954a4c1a95289f5dc388a409605c11c /win | |
parent | bf9624b12a9e6fe010e025b8f76d3e29c8399725 (diff) | |
parent | 24ef33dc101a3e9114318b884c1e99d792f4739d (diff) | |
download | tcl-ef03a2c7809309b2255f7c82c6abe0db2e4160bf.zip tcl-ef03a2c7809309b2255f7c82c6abe0db2e4160bf.tar.gz tcl-ef03a2c7809309b2255f7c82c6abe0db2e4160bf.tar.bz2 |
merge trunk
Diffstat (limited to 'win')
-rw-r--r-- | win/Makefile.in | 86 | ||||
-rw-r--r-- | win/README | 26 | ||||
-rw-r--r-- | win/coffbase.txt | 2 | ||||
-rwxr-xr-x | win/configure | 31 | ||||
-rw-r--r-- | win/configure.in | 15 | ||||
-rw-r--r-- | win/makefile.bc | 4 | ||||
-rw-r--r-- | win/makefile.vc | 97 | ||||
-rw-r--r-- | win/nmakehlp.c | 71 | ||||
-rw-r--r-- | win/rules.vc | 10 | ||||
-rw-r--r-- | win/tcl.m4 | 12 | ||||
-rw-r--r-- | win/tclWinDde.c | 453 | ||||
-rw-r--r-- | win/tclWinError.c | 11 | ||||
-rw-r--r-- | win/tclWinFCmd.c | 18 | ||||
-rw-r--r-- | win/tclWinFile.c | 30 | ||||
-rw-r--r-- | win/tclWinInit.c | 7 | ||||
-rw-r--r-- | win/tclWinInt.h | 6 | ||||
-rw-r--r-- | win/tclWinLoad.c | 2 | ||||
-rw-r--r-- | win/tclWinPipe.c | 69 | ||||
-rw-r--r-- | win/tclWinReg.c | 138 | ||||
-rw-r--r-- | win/tclWinSock.c | 56 | ||||
-rw-r--r-- | win/tclWinTest.c | 82 |
21 files changed, 654 insertions, 572 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index 8492b8f..84dcaf7 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -137,10 +137,9 @@ TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX} ZLIB_DLL_FILE = zlib1.dll SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ -STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE) +STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} -TCLTEST = tcltest${EXEEXT} CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) @@ -403,7 +402,7 @@ TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] all: binaries libraries doc packages -tcltest: $(TCLTEST) +tcltest: $(TCLSH) $(TEST_DLL_FILE) binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH) @@ -416,11 +415,6 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ -$(TCLTEST): testMain.$(OBJEXT) ${TEST_DLL_FILE} @LIBRARIES@ $(TCL_STUB_LIB_FILE) $(CAT32) tclsh.$(RES) - $(CC) $(CFLAGS) testMain.$(OBJEXT) ${TEST_LIB_FILE} $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) - @VC_MANIFEST_EMBED_EXE@ - cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) @@ -440,9 +434,9 @@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) @VC_MANIFEST_EMBED_DLL@ -${TCL_LIB_FILE}: ${TCL_OBJS} +${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_LIB_FILE} - @MAKE_LIB@ ${TCL_OBJS} + @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ # assume GNU make @@ -451,31 +445,11 @@ ${TCL_LIB_FILE}: ${TCL_OBJS} # targets have to depend on tcl<x>.lib, this ensures that linking of tcl<x>.dll # does not execute concurrently with the renaming and recompiling of tcl<x>.lib -${DDE_DLL_FILE}: ${DDE_OBJS} ${DDE_LIB_FILE} ${TCL_STUB_LIB_FILE} - @-$(RM) ${DDE_DLL_FILE} ${DDE_LIB_FILE}.sav - @-$(COPY) ${DDE_LIB_FILE} ${DDE_LIB_FILE}.sav +${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - @-$(RM) ${DDE_LIB_FILE} - @-$(COPY) ${DDE_LIB_FILE}.sav ${DDE_LIB_FILE} - @-$(RM) ${DDE_LIB_FILE}.sav -${DDE_LIB_FILE}: ${DDE_OBJS} - @$(RM) ${DDE_LIB_FILE} - @MAKE_LIB@ ${DDE_OBJS} - @POST_MAKE_LIB@ - -${REG_DLL_FILE}: ${REG_OBJS} ${REG_LIB_FILE} ${TCL_STUB_LIB_FILE} - @-$(RM) ${REG_DLL_FILE} ${REG_LIB_FILE}.sav - @-$(COPY) ${REG_LIB_FILE} ${REG_LIB_FILE}.sav +${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - @-$(RM) ${REG_LIB_FILE} - @-$(COPY) ${REG_LIB_FILE}.sav ${REG_LIB_FILE} - @-$(RM) ${REG_LIB_FILE}.sav - -${REG_LIB_FILE}: ${REG_OBJS} - @$(RM) ${REG_LIB_FILE} - @MAKE_LIB@ ${REG_OBJS} - @POST_MAKE_LIB@ ${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} @@ -606,23 +580,23 @@ install-binaries: binaries done @if [ -f $(DDE_DLL_FILE) ]; then \ echo installing $(DDE_DLL_FILE); \ - $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \ + $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/dde1.3; \ + $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo installing $(DDE_LIB_FILE); \ - $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \ + $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ fi @if [ -f $(REG_DLL_FILE) ]; then \ echo installing $(REG_DLL_FILE); \ - $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.3; \ + $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/reg1.3; \ + $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi @if [ -f $(REG_LIB_FILE) ]; then \ echo installing $(REG_LIB_FILE); \ - $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.3; \ + $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi install-libraries: libraries install-tzdata install-msgs @@ -669,8 +643,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; - @echo "Installing package msgcat 1.4.4 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm; + @echo "Installing package msgcat 1.4.5 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.5.tm; @echo "Installing package tcltest 2.3.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.4.tm; @echo "Installing package platform 1.0.10 as a Tcl Module"; @@ -719,17 +693,19 @@ install-private-headers: libraries test: test-tcl test-packages -test-tcl: binaries $(TCLTEST) +test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ - set ::reglib [file normalize ${REG_DLL_FILE}]" | ./$(CAT32) + ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ + -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ + package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) -# Useful target to launch a built tcltest with the proper path,... -runtest: binaries $(TCLTEST) +# Useful target to launch a built tclsh with the proper path,... +runtest: binaries $(TCLSH) $(TEST_DLL_FILE) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) $(TESTFLAGS) -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ - set ::reglib [file normalize ${REG_DLL_FILE}]" $(SCRIPT) + ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ + package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` @@ -753,7 +729,7 @@ cleanhelp: clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(TCLTEST) $(CAT32) + $(RM) $(TCLSH) $(CAT32) $(RM) *.pch *.ilk *.pdb distclean: distclean-packages clean @@ -849,14 +825,14 @@ $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \ @echo "This warning can be safely ignored, do not report as a bug!" genstubs: - $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \ + $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ - "$(GENERIC_DIR_NATIVE)\tcl.decls" \ - "$(GENERIC_DIR_NATIVE)\tclInt.decls" \ - "$(GENERIC_DIR_NATIVE)\tclTomMath.decls" - $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \ + "$(GENERIC_DIR_NATIVE)/tcl.decls" \ + "$(GENERIC_DIR_NATIVE)/tclInt.decls" \ + "$(GENERIC_DIR_NATIVE)/tclTomMath.decls" + $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ - "$(GENERIC_DIR_NATIVE)\tclOO.decls" + "$(GENERIC_DIR_NATIVE)/tclOO.decls" # # This target creates the HTML folder for Tcl & Tk and places it in @@ -24,28 +24,28 @@ In order to compile Tcl for Windows, you need the following: or - Linux + MinGW-w64 (any distribution e.g. Ubuntu) - (for either 32-bit or 64-bit executables) + Linux + MinGW-w64 [http://mingw-w64.sourceforge.net/] + (win32 or win64) or Cygwin + MinGW-w64 [http://cygwin.com/install.html] - (for either 32-bit or 64-bit executables) + (win32 or win64) or Darwin + MinGW-w64 [http://mingw-w64.sourceforge.net/] - (for either 32-bit or 64-bit executables) + (win32 or win64) or Msys + MinGW-w64 [http://mingw-w64.sourceforge.net/] - (for either 32-bit or 64-bit executables) + (win32 or win64) or - Msys + Mingw [http://www.mingw.org/download.shtml] - (32-bit executables only) + Msys + MinGW [http://www.mingw.org/download.shtml] + (win32 only) In practice, this release is built with Visual C++ 6.0 and the TEA @@ -67,20 +67,20 @@ configure/build process works just like the UNIX one, so you will want to refer to ../unix/README for available configure options. If you want 64-bit executables (x86_64), you need to configure using -the --enable-64bit option. Then make sure that the x86_64-w64-mingw32 +the --enable-64bit option. Make sure that the x86_64-w64-mingw32 compiler is present. For Cygwin this compiler can be found in the "mingw64-x86_64-gcc-core" package, which can be installed through the normal Cygwin install process. If you only want 32-bit executables, -the "mingw64-i686-gcc-core" package is what you need. If your Linux -distribution does not have a MinGW-w64 package, you can download one -from [https://sourceforge.net/projects/mingw-w64/files/] +the "mingw64-i686-gcc-core" package is what you need. For Linux, Darwin +and Msys, you can download a suitable win32 or win64 compiler from +[https://sourceforge.net/projects/mingw-w64/files/] Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. -Note that in order to run tclsh86.exe, you must ensure that tcl86.dll is on -your path, in the system directory, or in the directory containing +Note that in order to run tclsh85.exe, you must ensure that tcl85.dll is +on your path, in the system directory, or in the directory containing tclsh86.exe. Note: Tcl no longer provides support for Win32s. diff --git a/win/coffbase.txt b/win/coffbase.txt index 7d19420..bdf5506 100644 --- a/win/coffbase.txt +++ b/win/coffbase.txt @@ -24,6 +24,7 @@ blt 0x10680000 0x00080000 iocpsock 0x10700000 0x00080000 tls 0x10780000 0x00100000 winico 0x10880000 0x00010000 +sample 0x108B0000 0x00010000 tile 0x10900000 0x00080000 memchan 0x109D0000 0x00010000 tdom 0x109E0000 0x00080000 @@ -32,6 +33,7 @@ tkvideo 0x10B00000 0x00010000 tclsdl 0x10B20000 0x00080000 vqtcl 0x10C00000 0x00010000 tdbc 0x10C40000 0x00010000 +thread 0x10C80000 0x00020000 ; ; insert new packages here ; diff --git a/win/configure b/win/configure index f3bd0d9..f5a23fe 100755 --- a/win/configure +++ b/win/configure @@ -309,7 +309,7 @@ ac_includes_default="\ # include <unistd.h> #endif" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_DDE_PATCH_LEVEL TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION TCL_REG_PATCH_LEVEL RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -840,18 +840,18 @@ if test -n "$ac_init_help"; then Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] - --enable-threads build with threads - --enable-shared build and link with shared libraries --enable-shared + --enable-threads build with threads (default: on) + --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (where applicable) --enable-wince enable Win/CE support (where applicable) - --enable-symbols build with debugging symbols --disable-symbols + --enable-symbols build with debugging symbols (default: off) --enable-embedded-manifest embed manifest if possible (default: yes) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) - --with-encoding encoding for configuration values + --with-encoding encoding for configuration values --with-celib=DIR use Windows/CE support library from DIR Some influential environment variables: @@ -1314,21 +1314,24 @@ TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL="b2" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.3 +TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=3 -TCL_DDE_PATCH_LEVEL="2" +TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION TCL_REG_VERSION=1.3 TCL_REG_MAJOR_VERSION=1 TCL_REG_MINOR_VERSION=3 -TCL_REG_PATCH_LEVEL="0" REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION PKG_CFG_ARGS=$@ #------------------------------------------------------------------------ +# Empty slate for bundled packages, to avoid stale configuration +#------------------------------------------------------------------------ +rm -Rf pkgs + +#------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ @@ -3065,8 +3068,8 @@ else fi; if test "$tcl_ok" = "yes"; then - echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 + echo "$as_me:$LINENO: result: yes (default)" >&5 +echo "${ECHO_T}yes (default)" >&6 TCL_THREADS=1 cat >>confdefs.h <<\_ACEOF #define TCL_THREADS 1 @@ -3595,8 +3598,8 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 MAKE_EXE="\${CC} -o \$@" LIBPREFIX="lib" - extra_ldflags="$extra_ldflags -pipe" extra_cflags="$extra_cflags -pipe" + extra_ldflags="$extra_ldflags -pipe" if test "${SHARED_BUILD}" = "0" ; then # static @@ -5250,8 +5253,6 @@ fi - - ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure @@ -5980,11 +5981,9 @@ s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t s,@TCL_DDE_VERSION@,$TCL_DDE_VERSION,;t t s,@TCL_DDE_MAJOR_VERSION@,$TCL_DDE_MAJOR_VERSION,;t t s,@TCL_DDE_MINOR_VERSION@,$TCL_DDE_MINOR_VERSION,;t t -s,@TCL_DDE_PATCH_LEVEL@,$TCL_DDE_PATCH_LEVEL,;t t s,@TCL_REG_VERSION@,$TCL_REG_VERSION,;t t s,@TCL_REG_MAJOR_VERSION@,$TCL_REG_MAJOR_VERSION,;t t s,@TCL_REG_MINOR_VERSION@,$TCL_REG_MINOR_VERSION,;t t -s,@TCL_REG_PATCH_LEVEL@,$TCL_REG_PATCH_LEVEL,;t t s,@RC_OUT@,$RC_OUT,;t t s,@RC_TYPE@,$RC_TYPE,;t t s,@RC_INCLUDE@,$RC_INCLUDE,;t t diff --git a/win/configure.in b/win/configure.in index 0ed8f89..d17f815 100644 --- a/win/configure.in +++ b/win/configure.in @@ -17,21 +17,24 @@ TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL="b2" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.3 +TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=3 -TCL_DDE_PATCH_LEVEL="2" +TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION TCL_REG_VERSION=1.3 TCL_REG_MAJOR_VERSION=1 TCL_REG_MINOR_VERSION=3 -TCL_REG_PATCH_LEVEL="0" REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION PKG_CFG_ARGS=$@ #------------------------------------------------------------------------ +# Empty slate for bundled packages, to avoid stale configuration +#------------------------------------------------------------------------ +rm -Rf pkgs + +#------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ @@ -216,7 +219,7 @@ if test "$tcl_cv_intrinsics" = "yes"; then [Defined when the compilers supports intrinsics]) fi -# See if the <wspiapi.h> header file is present +# See if the <wspiapi.h> header file is present AC_CACHE_CHECK(for wspiapi.h, tcl_cv_wspiapi_h, @@ -425,11 +428,9 @@ AC_SUBST(TCL_PACKAGE_PATH) AC_SUBST(TCL_DDE_VERSION) AC_SUBST(TCL_DDE_MAJOR_VERSION) AC_SUBST(TCL_DDE_MINOR_VERSION) -AC_SUBST(TCL_DDE_PATCH_LEVEL) AC_SUBST(TCL_REG_VERSION) AC_SUBST(TCL_REG_MAJOR_VERSION) AC_SUBST(TCL_REG_MINOR_VERSION) -AC_SUBST(TCL_REG_PATCH_LEVEL) AC_SUBST(RC) AC_SUBST(RC_OUT) diff --git a/win/makefile.bc b/win/makefile.bc index 338205e..d17c624 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -126,8 +126,8 @@ STUBPREFIX = $(NAMEPREFIX)stub DOTVERSION = 8.6 VERSION = 86 -DDEVERSION = 13 -DDEDOTVERSION = 1.3 +DDEVERSION = 14 +DDEDOTVERSION = 1.4 REGVERSION = 13 REGDOTVERSION = 1.3 diff --git a/win/makefile.vc b/win/makefile.vc index bc16584..ba5b710 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -13,10 +13,9 @@ # Copyright (c) 2003-2008 Pat Thoyts. #------------------------------------------------------------------------------ -# Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) -# or with the MS Platform SDK (MSSDK). Visual Studio .NET 2003 and 2005 define -# VCINSTALLDIR instead. -!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(MSSDK) && !defined(VCINSTALLDIR) +# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or +# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir) +!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR) MSG = ^ You need to run vcvars32.bat from Developer Studio or setenv.bat from the^ Platform SDK first to setup the environment. Jump to this line to read^ @@ -72,57 +71,62 @@ the build instructions. # Sets where to install Tcl from the built binaries. # C:\Progra~1\Tcl is assumed when not specified. # -# OPTS=static,msvcrt,staticpkg,nothreads,symbols,profile,loimpact,unchecked,pdbs,none +# OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,tclalloc,unchecked,none # Sets special options for the core. The default is for none. # Any combination of the above may be used (comma separated). # 'none' will over-ride everything to nothing. # -# static = Builds a static library of the core instead of a -# dll. The shell will be static (and large), as well. -# msvcrt = Affects the static option only to switch it from +# loimpact = Adds a flag for how NT treats the heap to keep memory +# in use, low. This is said to impact alloc performance. +# msvcrt = Affects the static option only to switch it from # using libcmt(d) as the C runtime [by default] to # msvcrt(d). This is useful for static embedding # support. +# nothreads= Turns off full multithreading support. +# pdbs = Build detached symbols for release builds. +# profile = Adds profiling hooks. Map file is assumed. +# static = Builds a static library of the core instead of a +# dll. The static library will contain the dde and reg +# extensions. External applications who want to use +# this, need to link with the stub library as well as +# the static Tcl library.The shell will be static (and +# large), as well. # staticpkg = Affects the static option only to switch # tclshXX.exe to have the dde and reg extension linked # inside it. -# nothreads = Turns off full multithreading support. +# symbols = Debug build. Links to the debug C runtime, disables +# optimizations and creates pdb symbols files. # thrdalloc = Use the thread allocator (shared global free pool) # This is the default on threaded builds. # tclalloc = Use the old non-thread allocator -# symbols = Debug build. Links to the debug C runtime, disables -# optimizations and creates pdb symbols files. -# pdbs = Build detached symbols for release builds. -# profile = Adds profiling hooks. Map file is assumed. -# loimpact = Adds a flag for how NT treats the heap to keep memory -# in use, low. This is said to impact alloc performance. -# unchecked = Allows a symbols build to not use the debug +# unchecked= Allows a symbols build to not use the debug # enabled runtime (msvcrt.dll not msvcrtd.dll # or libcmt.lib not libcmtd.lib). # -# STATS=memdbg,compdbg,none +# STATS=compdbg,memdbg,none # Sets optional memory and bytecode compiler debugging code added # to the core. The default is for none. Any combination of the # above may be used (comma separated). 'none' will over-ride # everything to nothing. # -# memdbg = Enables the debugging memory allocator. # compdbg = Enables byte compilation logging. +# memdbg = Enables the debugging memory allocator. # -# CHECKS=nodep,fullwarn,64bit,none +# CHECKS=64bit,fullwarn,nodep,none # Sets special macros for checking compatability. # -# nodep = Turns off compatability macros to ensure the core -# isn't being built with deprecated functions. +# 64bit = Enable 64bit portability warnings (if available) # fullwarn = Builds with full compiler and link warnings enabled. # Very verbose. -# 64bit = Enable 64bit portability warnings (if available) +# nodep = Turns off compatability macros to ensure the core +# isn't being built with deprecated functions. # -# MACHINE=(IX86|IA64|AMD64|ALPHA) +# MACHINE=(ALPHA|AMD64|IA64|IX86) # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools # when alternate platforms are requested. IX86 is the default -# when not specified. +# when not specified. If the CPU environment variable has been +# set (ie: recent Platform SDK) then MACHINE is set from CPU. # # TMP_DIR=<path> # OUT_DIR=<path> @@ -179,14 +183,14 @@ Please `cd` to its location first. !error $(MSG) !endif -PROJECT = tcl +PROJECT = tcl !include "rules.vc" STUBPREFIX = $(PROJECT)stub DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) -DDEDOTVERSION = 1.3 +DDEDOTVERSION = 1.4 DDEVERSION = $(DDEDOTVERSION:.=) REGDOTVERSION = 1.3 @@ -232,10 +236,12 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include TCLSHOBJS = \ $(TMP_DIR)\tclAppInit.obj \ +!if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif +!endif $(TMP_DIR)\tclsh.res TCLTESTOBJS = \ @@ -244,10 +250,12 @@ TCLTESTOBJS = \ $(TMP_DIR)\tclTestProcBodyObj.obj \ $(TMP_DIR)\tclThreadTest.obj \ $(TMP_DIR)\tclWinTest.obj \ +!if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif +!endif $(TMP_DIR)\testMain.obj COREOBJS = \ @@ -429,11 +437,13 @@ PLATFORMOBJS = \ $(TMP_DIR)\tclWinSock.obj \ $(TMP_DIR)\tclWinThrd.obj \ $(TMP_DIR)\tclWinTime.obj \ -!if !$(STATIC_BUILD) +!if $(STATIC_BUILD) + $(TMP_DIR)\tclWinReg.obj \ + $(TMP_DIR)\tclWinDde.obj \ +!else $(TMP_DIR)\tcl.res !endif - TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ @@ -565,27 +575,27 @@ install: install-binaries install-libraries install-docs install-pkgs test: test-core test-pkgs test-core: setup $(TCLTEST) dlls $(CAT32) - set TCL_LIBRARY=$(ROOT:\=/)/../library + set TCL_LIBRARY=$(ROOT:\=/)/library !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" - $(DEBUGGER) $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << - set ::ddelib [file normalize $(TCLDDELIB:\=/)] - set ::reglib [file normalize $(TCLREGLIB:\=/)] + $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << + package ifneeded dde 1.4.0b1 [list load "$(TCLDDELIB:\=/)" dde] + package ifneeded registry 1.3.0 [list load "$(TCLREGLIB:\=/)" registry] << !else @echo Please wait while the tests are collected... - $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log - set ::ddelib [file normalize $(TCLDDELIB:\=/)] - set ::reglib [file normalize $(TCLREGLIB:\=/)] + $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log + package ifneeded dde 1.4.0b1 "$(TCLDDELIB:\=/)" dde] + package ifneeded registry 1.3.0 "$(TCLREGLIB:\=/)" registry] << type tests.log | more !endif runtest: setup $(TCLTEST) dlls $(CAT32) - set TCL_LIBRARY=$(ROOT)/library + set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLTEST) $(SCRIPT) runshell: setup $(TCLSH) dlls - set TCL_LIBRARY=$(ROOT)/library + set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLSH) $(SCRIPT) setup: @@ -820,7 +830,6 @@ install-docs: @$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\" !endif -#" #--------------------------------------------------------------------- # Build tclConfig.sh for the TEA build system. #--------------------------------------------------------------------- @@ -1159,15 +1168,15 @@ install-libraries: tclConfig install-msgs install-tzdata install-tzdata: @echo Installing time zone data - @set TCL_LIBRARY=$(ROOT)/library - @$(TCLSH_NATIVE) "$(ROOT)/tools/installData.tcl" \ - "$(ROOT)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" + @set TCL_LIBRARY=$(ROOT:\=/)/library + @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ + "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" install-msgs: @echo Installing message catalogs - @set TCL_LIBRARY=$(ROOT)/library - @$(TCLSH_NATIVE) "$(ROOT)/tools/installData.tcl" \ - "$(ROOT)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" + @set TCL_LIBRARY=$(ROOT:\=/)/library + @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ + "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" #--------------------------------------------------------------------- # Clean up diff --git a/win/nmakehlp.c b/win/nmakehlp.c index b5e0788..2868857 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -14,8 +14,13 @@ #define _CRT_SECURE_NO_DEPRECATE #include <windows.h> +#define NO_SHLWAPI_GDI +#define NO_SHLWAPI_STREAM +#define NO_SHLWAPI_REG +#include <shlwapi.h> #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") +#pragma comment (lib, "shlwapi.lib") #include <stdio.h> #include <math.h> @@ -37,12 +42,13 @@ /* protos */ -int CheckForCompilerFeature(const char *option); -int CheckForLinkerFeature(const char *option); -int IsIn(const char *string, const char *substring); -int SubstituteFile(const char *substs, const char *filename); -const char * GetVersionFromFile(const char *filename, const char *match); -DWORD WINAPI ReadFromPipe(LPVOID args); +static int CheckForCompilerFeature(const char *option); +static int CheckForLinkerFeature(const char *option); +static int IsIn(const char *string, const char *substring); +static int SubstituteFile(const char *substs, const char *filename); +static int QualifyPath(const char *path); +static const char *GetVersionFromFile(const char *filename, const char *match); +static DWORD WINAPI ReadFromPipe(LPVOID args); /* globals */ @@ -149,10 +155,21 @@ main( } printf("%s\n", GetVersionFromFile(argv[2], argv[3])); return 0; + case 'Q': + if (argc != 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -Q path\n" + "Emit the fully qualified path\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return QualifyPath(argv[2]); } } chars = snprintf(msg, sizeof(msg) - 1, - "usage: %s -c|-l|-f|-g|-V ...\n" + "usage: %s -c|-f|-l|-Q|-s|-V ...\n" "This is a little helper app to equalize shell differences between WinNT and\n" "Win9x and get nmake.exe to accomplish its job.\n", argv[0]); @@ -160,7 +177,7 @@ main( return 2; } -int +static int CheckForCompilerFeature( const char *option) { @@ -245,7 +262,7 @@ CheckForCompilerFeature( FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], (300-chars), 0); - WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); return 2; } @@ -294,7 +311,7 @@ CheckForCompilerFeature( || strstr(Err.buffer, "D2021") != NULL); } -int +static int CheckForLinkerFeature( const char *option) { @@ -373,7 +390,7 @@ CheckForLinkerFeature( FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], (300-chars), 0); - WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); return 2; } @@ -419,7 +436,7 @@ CheckForLinkerFeature( strstr(Err.buffer, "LNK4044") != NULL); } -DWORD WINAPI +static DWORD WINAPI ReadFromPipe( LPVOID args) { @@ -444,7 +461,7 @@ ReadFromPipe( return 0; /* makes the compiler happy */ } -int +static int IsIn( const char *string, const char *substring) @@ -459,7 +476,7 @@ IsIn( * package provide or package ifneeded. */ -const char * +static const char * GetVersionFromFile( const char *filename, const char *match) @@ -565,7 +582,7 @@ list_free(list_item_t **listPtrPtr) * << */ -int +static int SubstituteFile( const char *substitutions, const char *filename) @@ -641,6 +658,30 @@ SubstituteFile( fclose(fp); return 0; } + +/* + * QualifyPath -- + * + * This composes the current working directory with a provided path + * and returns the fully qualified and normalized path. + * Mostly needed to setup paths for testing. + */ + +static int +QualifyPath( + const char *szPath) +{ + char szCwd[MAX_PATH + 1]; + char szTmp[MAX_PATH + 1]; + char *p; + GetCurrentDirectory(MAX_PATH, szCwd); + while ((p = strchr(szPath, '/')) && *p) + *p = '\\'; + PathCombine(szTmp, szCwd, szPath); + PathCanonicalize(szCwd, szTmp); + printf("%s\n", szCwd); + return 0; +} /* * Local variables: diff --git a/win/rules.vc b/win/rules.vc index f2ee135..f09e2ea 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -8,7 +8,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 2001-2003 David Gravereaux. -# Copyright (c) 2003-2007 Patrick Thoyts +# Copyright (c) 2003-2008 Patrick Thoyts #------------------------------------------------------------------------------ !ifndef _RULES_VC @@ -243,9 +243,9 @@ TCL_USE_STATIC_PACKAGES = 1 TCL_USE_STATIC_PACKAGES = 0 !endif !if [nmakehlp -f $(OPTS) "nothreads"] +!message *** Compile explicitly for non-threaded tcl TCL_THREADS = 0 !else -!message *** Doing threads TCL_THREADS = 1 USE_THREAD_ALLOC= 1 !endif @@ -287,7 +287,7 @@ LOIMPACT = 0 USE_THREAD_ALLOC = 1 !endif !if [nmakehlp -f $(OPTS) "tclalloc"] -!message *** Doing thrdalloc +!message *** Doing tclalloc USE_THREAD_ALLOC = 0 !endif !if [nmakehlp -f $(OPTS) "unchecked"] @@ -598,7 +598,7 @@ TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\lib TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib" COFFBASE = \must\have\tcl\sources\to\build\this\target TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target TCL_INCLUDES = -I"$(_TCLDIR)\include" @@ -611,7 +611,7 @@ TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\library TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib" COFFBASE = "$(_TCLDIR)\win\coffbase.txt" TCLTOOLSDIR = $(_TCLDIR)\tools TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" @@ -211,7 +211,7 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, - [ --enable-shared build and link with shared libraries [--enable-shared]], + [ --enable-shared build and link with shared libraries (default: on)], [tcl_ok=$enableval], [tcl_ok=yes]) if test "${enable_shared+set}" = set; then @@ -250,11 +250,11 @@ AC_DEFUN([SC_ENABLE_SHARED], [ AC_DEFUN([SC_ENABLE_THREADS], [ AC_MSG_CHECKING(for building with threads) - AC_ARG_ENABLE(threads, [ --enable-threads build with threads], + AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: on)], [tcl_ok=$enableval], [tcl_ok=yes]) if test "$tcl_ok" = "yes"; then - AC_MSG_RESULT(yes) + AC_MSG_RESULT([yes (default)]) TCL_THREADS=1 AC_DEFINE(TCL_THREADS) # USE_THREAD_ALLOC tells us to try the special thread-based @@ -297,7 +297,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [ AC_DEFUN([SC_ENABLE_SYMBOLS], [ 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]) + AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols (default: off)], [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' @@ -533,8 +533,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ MAKE_EXE="\${CC} -o \[$]@" LIBPREFIX="lib" - extra_ldflags="$extra_ldflags -pipe" extra_cflags="$extra_cflags -pipe" + extra_ldflags="$extra_ldflags -pipe" if test "${SHARED_BUILD}" = "0" ; then # static @@ -1071,7 +1071,7 @@ AC_DEFUN([SC_BUILD_TCLSH], [ #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CFG_ENCODING], [ - AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval}) + AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval}) if test x"${with_tcencoding}" != x ; then AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}") diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 71b03a9..4d6e31b 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -11,13 +11,21 @@ */ #undef STATIC_BUILD -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif +#undef USE_TCL_STUBS +#define USE_TCL_STUBS #include "tclInt.h" #include <dde.h> #include <ddeml.h> +#ifndef UNICODE +# undef CP_WINUNICODE +# define CP_WINUNICODE CP_WINANSI +# undef Tcl_WinTCharToUtf +# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) +# undef Tcl_WinUtfToTChar +# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) +#endif + /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init * declaration is in the source file itself, which is only accessed when we @@ -37,7 +45,7 @@ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ - char *name; /* Interpreter's name (malloc-ed). */ + TCHAR *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; @@ -51,7 +59,7 @@ typedef struct Conversation { /* The next conversation in the list. */ RegisteredInterp *riPtr; /* The info we know about the conversation. */ HCONV hConv; /* The DDE handle for this conversation. */ - Tcl_Obj *returnPackagePtr; /* The result package for this conversation */ + Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */ } Conversation; typedef struct DdeEnumServices { @@ -79,13 +87,17 @@ static Tcl_ThreadDataKey dataKey; static HSZ ddeServiceGlobal = 0; static DWORD ddeInstance; /* The application instance handle given to us - * by DdeInitializeA. */ + * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.3.2" +#define TCL_DDE_VERSION "1.4.0b1" #define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME "TclEval" -#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT" +#define TCL_DDE_SERVICE_NAME TEXT("TclEval") +#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT") + +#define DDE_FLAG_ASYNC 1 +#define DDE_FLAG_BINARY 2 +#define DDE_FLAG_FORCE 4 TCL_DECLARE_MUTEX(ddeMutex) @@ -100,7 +112,7 @@ static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); static void DdeExitProc(ClientData clientData); static int DdeGetServicesList(Tcl_Interp *interp, - const char *serviceName, const char *topicName); + const TCHAR *serviceName, const TCHAR *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); @@ -110,7 +122,7 @@ static void DeleteProc(ClientData clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, - const char *name, HCONV *ddeConvPtr); + const TCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, @@ -143,6 +155,12 @@ Dde_Init( return TCL_ERROR; } +#ifdef UNICODE + if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) { + Tcl_AppendResult(interp, "Win32s and Windows 9x are not supported platforms", NULL); + return TCL_ERROR; + } +#endif Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); @@ -215,7 +233,7 @@ Initialize(void) if (ddeInstance == 0) { Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { - if (DdeInitializeA(&ddeInstance, (PFNCALLBACK) DdeServerProc, + if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc, CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; @@ -228,8 +246,8 @@ Initialize(void) if ((ddeServiceGlobal == 0) && (nameFound != 0)) { ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); - ddeServiceGlobal = DdeCreateStringHandleA(ddeInstance, - TCL_DDE_SERVICE_NAME, 0); + ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, + TCL_DDE_SERVICE_NAME, CP_WINUNICODE); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; @@ -263,20 +281,20 @@ Initialize(void) *---------------------------------------------------------------------- */ -static const char * +static const TCHAR * DdeSetServerName( Tcl_Interp *interp, - const char *name, /* The name that will be used to refer to the + const TCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ - int exactName, /* Should we make a unique name? 0 = unique */ + int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - const char *actualName; + const TCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -314,7 +332,7 @@ DdeSetServerName( * current interp, but it doesn't have a name. */ - return ""; + return TEXT(""); } /* @@ -325,7 +343,7 @@ DdeSetServerName( Tcl_DStringInit(&dString); actualName = name; - if (!exactName) { + if (!(flags & DDE_FLAG_FORCE)) { r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL); if (r == TCL_OK) { srvListPtr = Tcl_GetObjResult(interp); @@ -335,7 +353,9 @@ DdeSetServerName( &srvPtrPtr); } if (r != TCL_OK) { - OutputDebugStringA(Tcl_GetStringResult(interp)); + Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString); + OutputDebugString((TCHAR *) Tcl_DStringValue(&dString)); + Tcl_DStringFree(&dString); return NULL; } @@ -352,13 +372,13 @@ DdeSetServerName( lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { - Tcl_DStringAppend(&dString, name, -1); - Tcl_DStringAppend(&dString, " #", 2); + Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR)); + Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR)); offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE); - actualName = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE); + actualName = (TCHAR *) Tcl_DStringValue(&dString); } - sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix); + _stprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), TEXT("%d"), suffix); } /* @@ -367,16 +387,18 @@ DdeSetServerName( for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; + Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) { + Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); + if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; + Tcl_DStringFree(&ds); break; } + Tcl_DStringFree(&ds); } } - Tcl_DStringSetLength(&dString, - offset + (int)strlen(Tcl_DStringValue(&dString)+offset)); } /* @@ -385,14 +407,14 @@ DdeSetServerName( riPtr = ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; - riPtr->name = ckalloc(strlen(actualName) + 1); + riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR)); riPtr->nextPtr = tsdPtr->interpListPtr; riPtr->handlerPtr = handlerPtr; if (riPtr->handlerPtr != NULL) { Tcl_IncrRefCount(riPtr->handlerPtr); } tsdPtr->interpListPtr = riPtr; - strcpy(riPtr->name, actualName); + _tcscpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); @@ -472,7 +494,7 @@ DeleteProc( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL; - searchPtr != NULL && searchPtr != riPtr; + (searchPtr != NULL) && (searchPtr != riPtr); prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) { /* * Empty loop body. @@ -552,7 +574,8 @@ ExecuteRemoteObject( returnPackagePtr = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result)); + Tcl_ListObjAppendElement(NULL, returnPackagePtr, + Tcl_NewIntObj(result)); Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_GetObjResult(riPtr->interp)); @@ -607,7 +630,7 @@ DdeServerProc( Tcl_DString dString; int len; DWORD dlen; - char *utilString; + TCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; @@ -621,16 +644,16 @@ DdeServerProc( * sure we have a valid topic. */ - len = DdeQueryStringA(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); - DdeQueryStringA(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (strcasecmp(utilString, riPtr->name) == 0) { + if (_tcsicmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } @@ -646,15 +669,15 @@ DdeServerProc( * result to return in an XTYP_REQUEST. */ - len = DdeQueryStringA(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); - DdeQueryStringA(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (strcasecmp(riPtr->name, utilString) == 0) { + if (_tcsicmp(riPtr->name, utilString) == 0) { convPtr = ckalloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; @@ -698,7 +721,7 @@ DdeServerProc( * execute. */ - if (uFmt != CF_TEXT) { + if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { return (HDDEDATA) FALSE; } @@ -711,35 +734,51 @@ DdeServerProc( } if (convPtr != NULL) { - BYTE *returnString; + char *returnString; - len = DdeQueryStringA(ddeInstance, ddeItem, NULL, 0, CP_WINANSI); + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); - DdeQueryStringA(ddeInstance, ddeItem, utilString, (DWORD) len + 1, - CP_WINANSI); - if (strcasecmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { - returnString = (BYTE *) - Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); - ddeReturn = DdeCreateDataHandle(ddeInstance, returnString, - (DWORD) len+1, 0, ddeItem, CF_TEXT, 0); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + CP_WINUNICODE); + if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + if (uFmt == CF_TEXT) { + returnString = + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + } else { + returnString = (char *) + Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); + len = 2 * len + 1; + } + ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, + (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { if (Tcl_IsSafe(convPtr->riPtr->interp)) { ddeReturn = NULL; } else { - Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex( - convPtr->riPtr->interp, utilString, NULL, + Tcl_DString ds; + Tcl_Obj *variableObjPtr; + Tcl_WinTCharToUtf(utilString, -1, &ds); + variableObjPtr = Tcl_GetVar2Ex( + convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - returnString = (BYTE *) Tcl_GetStringFromObj( - variableObjPtr, &len); + if (uFmt == CF_TEXT) { + returnString = Tcl_GetStringFromObj( + variableObjPtr, &len); + } else { + returnString = (char *) Tcl_GetUnicodeFromObj( + variableObjPtr, &len); + len = 2 * len + 1; + } ddeReturn = DdeCreateDataHandle(ddeInstance, - returnString, (DWORD) len+1, 0, ddeItem, - CF_TEXT, 0); + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, + uFmt, 0); } else { ddeReturn = NULL; } + Tcl_DStringFree(&ds); } } Tcl_DStringFree(&dString); @@ -753,6 +792,7 @@ DdeServerProc( */ Tcl_Obj *returnPackagePtr; + char *string; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { @@ -765,9 +805,22 @@ DdeServerProc( return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (char *) DdeAccessData(hData, &dlen); - len = dlen; - ddeObjectPtr = Tcl_NewStringObj(utilString, -1); + utilString = (TCHAR *) DdeAccessData(hData, &dlen); + string = (char *) utilString; + if (!dlen) { + /* Empty binary array. */ + ddeObjectPtr = Tcl_NewObj(); + } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { + /* Cannot be unicode, so assume utf-8 */ + if (!string[dlen-1]) { + dlen--; + } + ddeObjectPtr = Tcl_NewStringObj(string, dlen); + } else { + /* unicode */ + dlen >>= 1; + ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1); + } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); if (convPtr->returnPackagePtr != NULL) { @@ -818,10 +871,10 @@ DdeServerProc( len = dlen; for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; i++, riPtr = riPtr->nextPtr) { - returnPtr[i].hszSvc = DdeCreateStringHandleA(ddeInstance, - TCL_DDE_SERVICE_NAME, CP_WINANSI); - returnPtr[i].hszTopic = DdeCreateStringHandleA(ddeInstance, - riPtr->name, CP_WINANSI); + returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance, + TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, + riPtr->name, CP_WINUNICODE); } returnPtr[i].hszSvc = NULL; returnPtr[i].hszTopic = NULL; @@ -879,14 +932,14 @@ DdeExitProc( static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - const char *name, /* The connection to use. */ + const TCHAR *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; - ddeService = DdeCreateStringHandleA(ddeInstance, TCL_DDE_SERVICE_NAME, 0); - ddeTopic = DdeCreateStringHandleA(ddeInstance, (void *) name, 0); + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -929,9 +982,9 @@ static int DdeCreateClient( struct DdeEnumServices *es) { - WNDCLASSEXA wc; - static const char *szDdeClientClassName = "TclEval client class"; - static const char *szDdeClientWindowName = "TclEval client window"; + WNDCLASSEX wc; + static const TCHAR *szDdeClientClassName = TEXT("TclEval client class"); + static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window"); memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); @@ -943,8 +996,8 @@ DdeCreateClient( * Register and create the callback window. */ - RegisterClassExA(&wc); - es->hwnd = CreateWindowExA(0, szDdeClientClassName, szDdeClientWindowName, + RegisterClassEx(&wc); + es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName, WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es); return TCL_OK; } @@ -956,7 +1009,6 @@ DdeClientWindowProc( WPARAM wParam, LPARAM lParam) /* (Potentially) our local handle */ { - switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; @@ -964,17 +1016,16 @@ DdeClientWindowProc( (struct DdeEnumServices *) lpcs->lpCreateParams; #ifdef _WIN64 - SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR)es); + SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); #else - SetWindowLongA(hwnd, GWL_USERDATA, (long)es); + SetWindowLong(hwnd, GWL_USERDATA, (LONG) es); #endif return (LRESULT) 0L; } case WM_DDE_ACK: return DdeServicesOnAck(hwnd, wParam, lParam); - break; default: - return DefWindowProcA(hwnd, uMsg, wParam, lParam); + return DefWindowProc(hwnd, uMsg, wParam, lParam); } } @@ -988,12 +1039,13 @@ DdeServicesOnAck( ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); struct DdeEnumServices *es; - char sz[255]; + TCHAR sz[255]; + Tcl_DString dString; #ifdef _WIN64 es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); #else - es = (struct DdeEnumServices *) GetWindowLongA(hwnd, GWL_USERDATA); + es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif if ((es->service == (ATOM)0 || es->service == service) @@ -1001,10 +1053,14 @@ DdeServicesOnAck( Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); - GlobalGetAtomNameA(service, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); - GlobalGetAtomNameA(topic, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + GlobalGetAtomName(service, sz, 255); + Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); + Tcl_DStringFree(&dString); + GlobalGetAtomName(topic, sz, 255); + Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); + Tcl_DStringFree(&dString); /* * Adding the hwnd as a third list element provides a unique @@ -1030,7 +1086,7 @@ DdeServicesOnAck( * Tell the server we are no longer interested. */ - PostMessageA(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); + PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); return 0L; } @@ -1042,7 +1098,7 @@ DdeEnumWindowsCallback( DWORD_PTR dwResult = 0; struct DdeEnumServices *es = (struct DdeEnumServices *) lParam; - SendMessageTimeoutA(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, + SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, &dwResult); return TRUE; @@ -1051,16 +1107,16 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - const char *serviceName, - const char *topicName) + const TCHAR *serviceName, + const TCHAR *topicName) { struct DdeEnumServices es; es.interp = interp; es.result = TCL_OK; es.service = (serviceName == NULL) - ? (ATOM)0 : GlobalAddAtomA(serviceName); - es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtomA(topicName); + ? (ATOM)0 : GlobalAddAtom(serviceName); + es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName); Tcl_ResetResult(interp); /* our list is to be appended to result. */ DdeCreateClient(&es); @@ -1147,12 +1203,11 @@ DdeObjCmd( ClientData clientData, /* Used only for deletion */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ - Tcl_Obj *const * objv) /* The arguments */ + Tcl_Obj *const *objv) /* The arguments */ { static const char *const ddeCommands[] = { "servername", "execute", "poke", "request", "services", "eval", - (char *) NULL - }; + (char *) NULL}; enum DdeSubcommands { DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL @@ -1164,20 +1219,25 @@ DdeObjCmd( DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST, }; static const char *const ddeExecOptions[] = { + "-async", "-binary", NULL + }; + enum DdeExecOptions { + DDE_EXEC_ASYNC, DDE_EXEC_BINARY + }; + static const char *const ddeEvalOptions[] = { "-async", NULL }; static const char *const ddeReqOptions[] = { "-binary", NULL }; - int index, i, length; - int async = 0, binary = 0, exact = 0; - int result = TCL_OK, firstArg = 0; + int index, i, length, argIndex; + int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - const char *serviceName = NULL, *topicName = NULL; - char *string; + const TCHAR *serviceName = NULL, *topicName = NULL; + const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; @@ -1198,7 +1258,6 @@ DdeObjCmd( switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: for (i = 2; i < objc; i++) { - int argIndex; if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions, "option", 0, &argIndex) != TCL_OK) { /* @@ -1213,7 +1272,7 @@ DdeObjCmd( break; } if (argIndex == DDE_SERVERNAME_EXACT) { - exact = 1; + flags |= DDE_FLAG_FORCE; } else if (argIndex == DDE_SERVERNAME_HANDLER) { if ((objc - i) == 1) { /* return current handler */ RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp); @@ -1245,39 +1304,53 @@ DdeObjCmd( if (objc == 5) { firstArg = 2; break; - } else if (objc == 6) { - int dummy; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, - &dummy) == TCL_OK) { - async = 1; - firstArg = 3; - break; + } else if (objc >= 6 && objc <= 7) { + firstArg = objc - 3; + for (i = 2; i < firstArg; i++) { + if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions, + "option", 0, &argIndex) != TCL_OK) { + goto wrongDdeExecuteArgs; + } + if (argIndex == DDE_EXEC_ASYNC) { + flags |= DDE_FLAG_ASYNC; + } else { + flags |= DDE_FLAG_BINARY; + } } + break; } /* otherwise... */ + wrongDdeExecuteArgs: Tcl_WrongNumArgs(interp, 2, objv, - "?-async? serviceName topicName value"); + "?-async? ?-binary? serviceName topicName value"); return TCL_ERROR; case DDE_POKE: - if (objc != 6) { - Tcl_WrongNumArgs(interp, 2, objv, - "serviceName topicName item value"); - return TCL_ERROR; + if (objc == 6) { + firstArg = 2; + break; + } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2], + ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + flags |= DDE_FLAG_BINARY; + firstArg = 3; + break; } - firstArg = 2; - break; + + /* + * Otherwise... + */ + + Tcl_WrongNumArgs(interp, 2, objv, + "?-binary? serviceName topicName item value"); + return TCL_ERROR; case DDE_REQUEST: if (objc == 5) { firstArg = 2; break; - } else if (objc == 6) { - int dummy; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, - &dummy) == TCL_OK) { - binary = 1; - firstArg = 3; - break; - } + } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2], + ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + flags |= DDE_FLAG_BINARY; + firstArg = 3; + break; } /* @@ -1300,15 +1373,13 @@ DdeObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args"); return TCL_ERROR; } else { - int dummy; - firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", - 0, &dummy) == TCL_OK) { + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", + 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; } - async = 1; + flags |= DDE_FLAG_ASYNC; firstArg++; } break; @@ -1318,7 +1389,11 @@ DdeObjCmd( Initialize(); if (firstArg != 1) { +#ifdef UNICODE + serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length); +#else serviceName = Tcl_GetStringFromObj(objv[firstArg], &length); +#endif } else { length = 0; } @@ -1326,26 +1401,30 @@ DdeObjCmd( if (length == 0) { serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - ddeService = DdeCreateStringHandleA(ddeInstance, (void *) serviceName, - CP_WINANSI); + ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, + CP_WINUNICODE); } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { +#ifdef UNICODE + topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length); +#else topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length); +#endif if (length == 0) { topicName = NULL; } else { - ddeTopic = DdeCreateStringHandleA(ddeInstance, (void *) topicName, - CP_WINANSI); + ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName, + CP_WINUNICODE); } } switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: - serviceName = DdeSetServerName(interp, serviceName, exact, + serviceName = DdeSetServerName(interp, serviceName, flags, handlerPtr); if (serviceName != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); + Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1)); } else { Tcl_ResetResult(interp); } @@ -1353,10 +1432,18 @@ DdeObjCmd( case DDE_EXECUTE: { int dataLength; - BYTE *dataString = (BYTE *) Tcl_GetStringFromObj( - objv[firstArg + 2], &dataLength); + const char *dataString; + + if (flags & DDE_FLAG_BINARY) { + dataString = (const char *) + Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength); + } else { + dataString = + Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength); + dataLength += 1; + } - if (dataLength == 0) { + if (dataLength <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); @@ -1373,10 +1460,10 @@ DdeObjCmd( break; } - ddeData = DdeCreateDataHandle(ddeInstance, dataString, - (DWORD) dataLength+1, 0, 0, CF_TEXT, 0); + ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString, + (DWORD) dataLength, 0, 0, CF_TEXT, 0); if (ddeData != NULL) { - if (async) { + if (flags & DDE_FLAG_ASYNC) { DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); @@ -1396,8 +1483,13 @@ DdeObjCmd( break; } case DDE_REQUEST: { - const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], +#ifdef UNICODE + const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], &length); +#else + const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + &length); +#endif if (length == 0) { Tcl_SetObjResult(interp, @@ -1415,8 +1507,8 @@ DdeObjCmd( result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandleA(ddeInstance, (void *) itemString, - CP_WINANSI); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, CF_TEXT, XTYP_REQUEST, 5000, NULL); @@ -1425,13 +1517,17 @@ DdeObjCmd( result = TCL_ERROR; } else { DWORD tmp; - const BYTE *dataString = DdeAccessData(ddeData, &tmp); + const char *dataString = (const char *) DdeAccessData(ddeData, &tmp); - if (binary) { - returnObjPtr = Tcl_NewByteArrayObj(dataString, - (int) tmp); + if (flags & DDE_FLAG_BINARY) { + returnObjPtr = + Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp); } else { - returnObjPtr = Tcl_NewStringObj((char*)dataString,-1); + if (tmp && !dataString[tmp-1]) { + --tmp; + } + returnObjPtr = Tcl_NewStringObj(dataString, + (int) tmp); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); @@ -1446,8 +1542,13 @@ DdeObjCmd( break; } case DDE_POKE: { - const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], +#ifdef UNICODE + const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], + &length); +#else + const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); +#endif BYTE *dataString; if (length == 0) { @@ -1457,8 +1558,14 @@ DdeObjCmd( result = TCL_ERROR; goto cleanup; } - dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3], - &length); + if (flags & DDE_FLAG_BINARY) { + dataString = (BYTE *) + Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length); + } else { + dataString = (BYTE *) + Tcl_GetStringFromObj(objv[firstArg + 3], &length); + length += 1; + } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -1468,10 +1575,10 @@ DdeObjCmd( SetDdeError(interp); result = TCL_ERROR; } else { - ddeItem = DdeCreateStringHandleA(ddeInstance, (void *) itemString, - CP_WINANSI); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + CP_WINUNICODE); if (ddeItem != NULL) { - ddeData = DdeClientTransaction(dataString, (DWORD) length+1, + ddeData = DdeClientTransaction(dataString, (DWORD) length, hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); @@ -1501,8 +1608,8 @@ DdeObjCmd( goto cleanup; } - objc -= (async + 3); - objv += (async + 3); + objc -= firstArg + 1; + objv += firstArg + 1; /* * See if the target interpreter is local. If so, execute the command @@ -1515,7 +1622,7 @@ DdeObjCmd( for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (strcasecmp(serviceName, riPtr->name) == 0) { + if (_tcsicmp(serviceName, riPtr->name) == 0) { break; } } @@ -1541,9 +1648,9 @@ DdeObjCmd( */ if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) { - Tcl_SetResult(riPtr->interp, "permission denied: " - "a handler procedure must be defined for use in " - "a safe interp", TCL_STATIC); + Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj( + "permission denied: a handler procedure must be" + " defined for use in a safe interp", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", NULL); result = TCL_ERROR; @@ -1608,8 +1715,7 @@ DdeObjCmd( if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { invalidServerResponse: Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid data returned from server", - -1)); + Tcl_NewStringObj("invalid data returned from server", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL); result = TCL_ERROR; goto cleanup; @@ -1618,9 +1724,9 @@ DdeObjCmd( objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetStringFromObj(objPtr, &length); ddeItemData = DdeCreateDataHandle(ddeInstance, - (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0); + (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0); - if (async) { + if (flags & DDE_FLAG_ASYNC) { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); @@ -1630,8 +1736,8 @@ DdeObjCmd( 0xFFFFFFFF, hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { - ddeCookie = DdeCreateStringHandleA(ddeInstance, - TCL_DDE_EXECUTE_RESULT, CP_WINANSI); + ddeCookie = DdeCreateStringHandle(ddeInstance, + TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL); } @@ -1642,9 +1748,10 @@ DdeObjCmd( if (ddeData == 0) { SetDdeError(interp); result = TCL_ERROR; + goto cleanup; } - if (async == 0) { + if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; /* @@ -1658,7 +1765,7 @@ DdeObjCmd( resultPtr = Tcl_NewObj(); length = DdeGetData(ddeData, NULL, 0, 0); - Tcl_SetObjLength(resultPtr, length); + Tcl_SetObjLength(resultPtr, (length + 1) * sizeof(TCHAR) - 1); string = Tcl_GetString(resultPtr); DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0); Tcl_SetObjLength(resultPtr, (int) strlen(string)); diff --git a/win/tclWinError.c b/win/tclWinError.c index 969780d..49eeed3 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -331,11 +331,6 @@ static const unsigned char wsaErrorTable[] = { EREMOTE /* WSAEREMOTE */ }; -#ifdef __CYGWIN__ -# include <windows.h> -# define DWORD unsigned int -#endif - /* *---------------------------------------------------------------------- * @@ -415,6 +410,12 @@ tclWinDebugPanic( fprintf(stderr, "\n"); fflush(stderr); } +# if defined(__GNUC__) + __builtin_trap(); +# else + DebugBreak(); +# endif + abort(); } #endif /* diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index fea9ddb..77a5b82 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -50,7 +50,7 @@ enum { WIN_SYSTEM_ATTRIBUTE }; -static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, +static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; @@ -1011,13 +1011,12 @@ TclpObjRemoveDirectory( } if (ret != TCL_OK) { - int len = Tcl_DStringLength(&ds); - if (len > 0) { + if (Tcl_DStringLength(&ds) > 0) { if (normPtr != NULL && !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) { *errorPtr = pathPtr; } else { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + *errorPtr = TclDStringToObj(&ds); } Tcl_IncrRefCount(*errorPtr); } @@ -1126,9 +1125,9 @@ DoRemoveJustDirectory( len = strlen(path); find = Tcl_DStringAppend(&buffer, path, len); if ((len > 0) && (find[len - 1] != '\\')) { - Tcl_DStringAppend(&buffer, "\\", 1); + TclDStringAppendLiteral(&buffer, "\\"); } - find = Tcl_DStringAppend(&buffer, "*.*", 3); + find = TclDStringAppendLiteral(&buffer, "*.*"); handle = FindFirstFileA(find, &data); if (handle != INVALID_HANDLE_VALUE) { while (1) { @@ -1762,6 +1761,7 @@ ConvertFileNameFormat( Tcl_DStringInit(&dsTemp); Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); + Tcl_DStringFree(&ds); /* * Deal with issues of tildes being absolute. @@ -1771,13 +1771,11 @@ ConvertFileNameFormat( TclNewLiteralStringObj(tempPath, "./"); Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), Tcl_DStringLength(&dsTemp)); + Tcl_DStringFree(&dsTemp); } else { - tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); + tempPath = TclDStringToObj(&dsTemp); } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); - Tcl_DStringFree(&ds); - Tcl_DStringFree(&dsTemp); FindClose(handle); } } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index dcc05bb..1f56060 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -819,6 +819,16 @@ tclWinDebugPanic( MessageBoxW(NULL, msgString, L"Fatal Error", MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); } +#if defined(__GNUC__) + __builtin_trap(); +#elif defined(_WIN64) + __debugbreak(); +#elif defined(_MSC_VER) + _asm {int 3} +#else + DebugBreak(); +#endif + abort(); } /* @@ -986,7 +996,7 @@ TclpMatchInDirectory( lastChar = dirName[dirLength -1]; if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { - Tcl_DStringAppend(&dsOrig, "/", 1); + TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } dirName = Tcl_DStringValue(&dsOrig); @@ -1006,7 +1016,7 @@ TclpMatchInDirectory( dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); } else { - dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3); + dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); } native = Tcl_WinUtfToTChar(dirName, -1, &ds); @@ -1457,7 +1467,7 @@ TclpGetUserHome( GetWindowsDirectoryW(buf, MAX_PATH); Tcl_UniCharToUtfDString(buf, 2, bufferPtr); - Tcl_DStringAppend(bufferPtr, "/users/default", -1); + TclDStringAppendLiteral(bufferPtr, "/users/default"); } result = Tcl_DStringValue(bufferPtr); NetApiBufferFree((void *) uiPtr); @@ -2066,7 +2076,7 @@ NativeDev( * won't work. */ - fullPath = Tcl_DStringAppend(&ds, "\\", 1); + fullPath = TclDStringAppendLiteral(&ds, "\\"); p = fullPath + Tcl_DStringLength(&ds); } else { p++; @@ -2350,13 +2360,9 @@ TclpFilesystemPathType( return NULL; } else { Tcl_DString ds; - Tcl_Obj *objPtr; Tcl_WinTCharToUtf(volType, -1, &ds); - objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - return objPtr; + return TclDStringToObj(&ds); } #undef VOL_BUF_SIZE } @@ -2530,7 +2536,7 @@ TclpObjNormalizePath( * string. */ - Tcl_DStringAppend(&dsNorm,"/", 1); + TclDStringAppendLiteral(&dsNorm, "/"); } else { char *nativeName; @@ -2540,8 +2546,8 @@ TclpObjNormalizePath( nativeName = fData.cAlternateFileName; } FindClose(handle); - Tcl_DStringAppend(&dsNorm,"/", 1); - Tcl_DStringAppend(&dsNorm,nativeName,-1); + TclDStringAppendLiteral(&dsNorm, "/"); + Tcl_DStringAppend(&dsNorm, nativeName, -1); } } } diff --git a/win/tclWinInit.c b/win/tclWinInit.c index fb53685..d89c98e 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -288,8 +288,6 @@ AppendEnvironment( */ if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) { - const char *str; - /* * TCL_LIBRARY is set but refers to a different tcl installation * than the current version. Try fiddling with the specified @@ -299,9 +297,8 @@ AppendEnvironment( pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); - str = Tcl_JoinPath(pathc, pathv, &ds); - objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); + (void) Tcl_JoinPath(pathc, pathv, &ds); + objPtr = TclDStringToObj(&ds); } else { objPtr = Tcl_NewStringObj(buf, -1); } diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 882b811..22ad8e9 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -33,6 +33,12 @@ # define TCL_I_MODIFIER "" #endif +#ifdef _WIN64 +# define TCL_I_MODIFIER "I" +#else +# define TCL_I_MODIFIER "" +#endif + /* * Declarations of functions that are not accessible by way of the * stubs table. diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index e5b927d..b59ccba 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -184,7 +184,7 @@ FindSymbol( const char *sym2; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, "_", 1); + TclDStringAppendLiteral(&ds, "_"); sym2 = Tcl_DStringAppend(&ds, symbol, -1); proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2); Tcl_DStringFree(&ds); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index f1b18df..db462f8 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -676,6 +676,7 @@ TclpCreateTempFile( if (contents != NULL) { DWORD result, length; const char *p; + int toCopy; /* * Convert the contents from UTF to native encoding @@ -683,7 +684,8 @@ TclpCreateTempFile( native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); - for (p = native; *p != '\0'; p++) { + toCopy = Tcl_DStringLength(&dstring); + for (p = native; toCopy > 0; p++, toCopy--) { if (*p == '\n') { length = p - native; if (length > 0) { @@ -860,7 +862,7 @@ TclpCloseFile( *-------------------------------------------------------------------------- */ -unsigned long +int TclpGetPid( Tcl_Pid pid) /* The HANDLE of the child process. */ { @@ -1115,7 +1117,7 @@ TclpCreateProcess( startInfo.wShowWindow = SW_HIDE; startInfo.dwFlags |= STARTF_USESHOWWINDOW; createFlags = CREATE_NEW_CONSOLE; - Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1); + TclDStringAppendLiteral(&cmdLine, "cmd.exe /c"); } else { createFlags = DETACHED_PROCESS; } @@ -1290,7 +1292,7 @@ ApplicationType( Tcl_DString nameBuf, ds; const TCHAR *nativeName; TCHAR nativeFullPath[MAX_PATH]; - static char extensions[][5] = {"", ".com", ".exe", ".bat"}; + static const char extensions[][5] = {"", ".com", ".exe", ".bat"}; /* * Look for the program as an external program. First try the name as it @@ -1465,9 +1467,9 @@ BuildCommandLine( * Prime the path. Add a space separator if we were primed with something. */ - Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1); + TclDStringAppendDString(&ds, linePtr); if (Tcl_DStringLength(linePtr) > 0) { - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); } for (i = 0; i < argc; i++) { @@ -1475,7 +1477,7 @@ BuildCommandLine( arg = executable; } else { arg = argv[i]; - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); } quote = 0; @@ -1494,7 +1496,7 @@ BuildCommandLine( } } if (quote) { - Tcl_DStringAppend(&ds, "\"", 1); + TclDStringAppendLiteral(&ds, "\""); } start = arg; for (special = arg; ; ) { @@ -1523,7 +1525,7 @@ BuildCommandLine( } if (*special == '"') { Tcl_DStringAppend(&ds, start, (int) (special - start)); - Tcl_DStringAppend(&ds, "\\\"", 2); + TclDStringAppendLiteral(&ds, "\\\""); start = special + 1; } if (*special == '\0') { @@ -1533,7 +1535,7 @@ BuildCommandLine( } Tcl_DStringAppend(&ds, start, (int) (special - start)); if (quote) { - Tcl_DStringAppend(&ds, "\"", 1); + TclDStringAppendLiteral(&ds, "\""); } } Tcl_DStringFree(linePtr); @@ -1709,8 +1711,8 @@ TclGetAndDetachPids( { PipeInfo *pipePtr; const Tcl_ChannelType *chanTypePtr; + Tcl_Obj *pidsObj; int i; - char buf[TCL_INTEGER_SPACE]; /* * Punt if the channel is not a command channel. @@ -1721,12 +1723,15 @@ TclGetAndDetachPids( return; } - pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); + pipePtr = Tcl_GetChannelInstanceData(chan); + TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { - wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); - Tcl_AppendElement(interp, buf); - Tcl_DetachPids(1, &(pipePtr->pidPtr[i])); + Tcl_ListObjAppendElement(NULL, pidsObj, + Tcl_NewWideIntObj((unsigned) + TclpGetPid(pipePtr->pidPtr[i]))); + Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } + Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { ckfree(pipePtr->pidPtr); pipePtr->numPids = 0; @@ -1873,12 +1878,26 @@ PipeClose2Proc( && (pipePtr->writeFile != NULL)) { if (pipePtr->writeThread) { /* - * Wait for the writer thread to finish the current buffer, then - * terminate the thread and close the handles. If the channel is - * nonblocking, there should be no pending write operations. + * Wait for the writer thread to finish the current buffer, then + * terminate the thread and close the handles. If the channel is + * nonblocking but blocked during exit, bail out since the worker + * thread is not interruptible and we want TIP#398-fast-exit. */ + if (TclInExit() + && (pipePtr->flags & PIPE_ASYNC)) { + + /* give it a chance to leave honorably */ + SetEvent(pipePtr->stopWriter); - WaitForSingleObject(pipePtr->writable, INFINITE); + if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) { + return EAGAIN; + } + + } else { + + WaitForSingleObject(pipePtr->writable, INFINITE); + + } /* * The thread may already have closed on it's own. Check its exit @@ -2626,15 +2645,13 @@ Tcl_PidObjCmd( PipeInfo *pipePtr; int i; Tcl_Obj *resultPtr; - char buf[TCL_INTEGER_SPACE]; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?channelId?"); return TCL_ERROR; } if (objc == 1) { - wsprintfA(buf, "%lu", (unsigned long) getpid()); - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); } else { chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); @@ -2649,9 +2666,9 @@ Tcl_PidObjCmd( pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); resultPtr = Tcl_NewObj(); for (i = 0; i < pipePtr->numPids; i++) { - wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, - Tcl_NewStringObj(buf, -1)); + Tcl_NewWideIntObj((unsigned) + TclpGetPid(pipePtr->pidPtr[i]))); } Tcl_SetObjResult(interp, resultPtr); } @@ -2943,6 +2960,10 @@ PipeWriterThread( * an error, so exit. */ + if (waitResult == WAIT_OBJECT_0) { + SetEvent(infoPtr->writable); + } + break; } diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 1390415..9c08b0c 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -13,15 +13,21 @@ */ #undef STATIC_BUILD -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif +#undef USE_TCL_STUBS +#define USE_TCL_STUBS #include "tclInt.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") #endif #include <stdlib.h> +#ifndef UNICODE +# undef Tcl_WinTCharToUtf +# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) +# undef Tcl_WinUtfToTChar +# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) +#endif + /* * Ensure that we can say which registry is being accessed. */ @@ -34,6 +40,14 @@ #endif /* + * The maximum length of a sub-key name. + */ + +#ifndef MAX_KEY_LENGTH +#define MAX_KEY_LENGTH 256 +#endif + +/* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the * Registry_Init declaration is in the source file itself, which is only * accessed when we are building a library. @@ -43,6 +57,14 @@ #define TCL_STORAGE_CLASS DLLEXPORT /* + * The maximum length of a sub-key name. + */ + +#ifndef MAX_KEY_LENGTH +#define MAX_KEY_LENGTH 256 +#endif + +/* * The following macros convert between different endian ints. */ @@ -67,7 +89,7 @@ static const char *const rootKeyNames[] = { "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL }; -static HKEY rootKeys[] = { +static const HKEY rootKeys[] = { HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA }; @@ -157,7 +179,7 @@ Registry_Init( cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); - return Tcl_PkgProvide(interp, "registry", "1.3"); + return Tcl_PkgProvide(interp, "registry", "1.3.0"); } /* @@ -552,9 +574,7 @@ GetKeyNames( { const char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ - DWORD subKeyCount; /* Number of subkeys to list */ - DWORD maxSubKeyLen; /* Maximum string length of any subkey */ - TCHAR *buffer; /* Buffer to hold the subkey name */ + TCHAR buffer[MAX_KEY_LENGTH]; /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ @@ -578,40 +598,27 @@ GetKeyNames( } /* - * Determine how big a buffer is needed for enumerating subkeys, and how - * many subkeys there are. - */ - - result = RegQueryInfoKey(key, NULL, NULL, NULL, - &subKeyCount, &maxSubKeyLen, NULL, NULL, NULL, NULL, NULL, NULL); - if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_NewObj()); - Tcl_AppendResult(interp, "unable to query key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); - AppendSystemError(interp, result); - RegCloseKey(key); - return TCL_ERROR; - } - buffer = ckalloc((maxSubKeyLen+1) * sizeof(TCHAR)); - - /* * Enumerate the subkeys. */ resultPtr = Tcl_NewObj(); - for (index = 0; index < subKeyCount; ++index) { - bufSize = maxSubKeyLen+1; + for (index = 0;; ++index) { + bufSize = MAX_KEY_LENGTH; result = RegEnumKeyEx(key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_NewObj()); - Tcl_AppendResult(interp, "unable to enumerate subkeys of \"", - Tcl_GetString(keyNameObj), "\": ", NULL); - AppendSystemError(interp, result); - result = TCL_ERROR; + if (result == ERROR_NO_MORE_ITEMS) { + result = TCL_OK; + } else { + Tcl_SetObjResult(interp, Tcl_NewObj()); + Tcl_AppendResult(interp, "unable to enumerate subkeys of \"", + Tcl_GetString(keyNameObj), "\": ", NULL); + AppendSystemError(interp, result); + result = TCL_ERROR; + } break; } - Tcl_WinTCharToUtf(buffer, bufSize * sizeof(WCHAR), &ds); + Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds); name = Tcl_DStringValue(&ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); @@ -626,9 +633,10 @@ GetKeyNames( } if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); + } else { + Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */ } - ckfree(buffer); RegCloseKey(key); return result; } @@ -756,8 +764,8 @@ GetValue( */ Tcl_DStringInit(&data); - length = TCL_DSTRING_STATIC_SIZE - 1; - Tcl_DStringSetLength(&data, (int) length); + Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); + length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); @@ -771,8 +779,8 @@ GetValue( * HKEY_PERFORMANCE_DATA */ - length *= 2; - Tcl_DStringSetLength(&data, (int) length); + length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR)); + Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR)); result = RegQueryValueEx(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } @@ -865,7 +873,7 @@ GetValueNames( { HKEY key; Tcl_Obj *resultPtr; - DWORD index, size, maxSize, result; + DWORD index, size, result; Tcl_DString buffer, ds; const char *pattern, *name; @@ -878,27 +886,9 @@ GetValueNames( return TCL_ERROR; } - /* - * Query the key to determine the appropriate buffer size to hold the - * largest value name plus the terminating null. - */ - - result = RegQueryInfoKey(key, NULL, NULL, NULL, NULL, - NULL, NULL, &index, &maxSize, NULL, NULL, NULL); - if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to query key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); - AppendSystemError(interp, result); - RegCloseKey(key); - result = TCL_ERROR; - goto done; - } - maxSize++; - resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, - (int) (maxSize*sizeof(WCHAR))); + Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); index = 0; result = TCL_OK; @@ -914,10 +904,10 @@ GetValueNames( * each iteration because RegEnumValue smashes the old value. */ - size = maxSize; + size = MAX_KEY_LENGTH; while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { - size *= 2; + size *= sizeof(TCHAR); Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds); @@ -933,12 +923,10 @@ GetValueNames( Tcl_DStringFree(&ds); index++; - size = maxSize; + size = MAX_KEY_LENGTH; } Tcl_SetObjResult(interp, resultPtr); Tcl_DStringFree(&buffer); - - done: RegCloseKey(key); return result; } @@ -1180,7 +1168,7 @@ RecursiveDeleteKey( * encoding, not UTF. */ REGSAM mode) /* Mode flags to pass. */ { - DWORD result, size, maxSize; + DWORD result, size; Tcl_DString subkey; HKEY hKey; REGSAM saveMode = mode; @@ -1200,16 +1188,9 @@ RecursiveDeleteKey( if (result != ERROR_SUCCESS) { return result; } - result = RegQueryInfoKey(hKey, NULL, NULL, NULL, NULL, - &maxSize, NULL, NULL, NULL, NULL, NULL, NULL); - maxSize++; - if (result != ERROR_SUCCESS) { - return result; - } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, - (int) (maxSize * sizeof(WCHAR))); + Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); mode = saveMode; while (result == ERROR_SUCCESS) { @@ -1217,7 +1198,7 @@ RecursiveDeleteKey( * Always get index 0 because key deletion changes ordering. */ - size = maxSize; + size = MAX_KEY_LENGTH; result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { @@ -1334,16 +1315,15 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1); + const char *bytes = Tcl_GetStringFromObj(objv[i], &length); + + Tcl_DStringAppend(&data, bytes, length); /* - * Add a null character to separate this value from the next. We - * accomplish this by growing the string by one byte. Since the - * DString always tacks on an extra null byte, the new byte will - * already be set to null. + * Add a null character to separate this value from the next. */ - Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1); + Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 7181701..97b10a3 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1280,9 +1280,14 @@ CreateSocket( } if (interp != NULL) { - Tcl_AppendResult(interp, "couldn't open socket: ", - Tcl_PosixError(interp), NULL); + Tcl_AppendResult(interp, "couldn't open socket: ", NULL); + if (errorMsg == NULL) { + Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL); + } else { + Tcl_AppendResult(interp, errorMsg, NULL); + } } + if (sock != INVALID_SOCKET) { closesocket(sock); } @@ -1398,7 +1403,7 @@ Tcl_OpenTcpClient( return NULL; } - sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, infoPtr, (TCL_READABLE | TCL_WRITABLE)); @@ -1461,7 +1466,7 @@ Tcl_MakeTcpClientChannel( infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr); - sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, infoPtr, (TCL_READABLE | TCL_WRITABLE)); Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf"); @@ -1514,7 +1519,7 @@ Tcl_OpenTcpServer( infoPtr->acceptProc = acceptProc; infoPtr->acceptProcData = acceptProcData; - sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, infoPtr, 0); @@ -1620,7 +1625,7 @@ TcpAccept( SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) newInfoPtr); - sprintf(channelName, "sock%Id", (size_t) newInfoPtr->sockets->fd); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) newInfoPtr->sockets->fd); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", @@ -2574,22 +2579,18 @@ InitializeHostName( Tcl_DStringInit(&ds); if (TclpHasSockets(NULL) == TCL_OK) { /* - * Buffer length of 255 copied slavishly from previous version of - * this routine. Presumably there's a more "correct" macro value - * for a properly sized buffer for a gethostname() call. - * Maintainers are welcome to supply it. + * The buffer size of 256 is recommended by the MSDN page that + * documents gethostname() as being always adequate. */ Tcl_DString inDs; Tcl_DStringInit(&inDs); - Tcl_DStringSetLength(&inDs, 255); + Tcl_DStringSetLength(&inDs, 256); if (gethostname(Tcl_DStringValue(&inDs), - Tcl_DStringLength(&inDs)) == 0) { - Tcl_DStringSetLength(&ds, 0); - } else { - Tcl_ExternalToUtfDString(NULL, - Tcl_DStringValue(&inDs), -1, &ds); + Tcl_DStringLength(&inDs)) == 0) { + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1, + &ds); } Tcl_DStringFree(&inDs); } @@ -2663,9 +2664,9 @@ TclWinSetSockOpt( return setsockopt(s, level, optname, optval, optlen); } -u_short +unsigned short TclWinNToHS( - u_short netshort) + unsigned short netshort) { /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -2674,12 +2675,29 @@ TclWinNToHS( */ if (!SocketsEnabled()) { - return (u_short) -1; + return (unsigned short) -1; } return ntohs(netshort); } +char * +TclpInetNtoa( + struct in_addr addr) +{ + /* + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. + */ + + if (!SocketsEnabled()) { + return NULL; + } + + return inet_ntoa(addr); +} + struct servent * TclWinGetServByName( const char *name, diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 6ef1157..136c4db 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -42,8 +42,6 @@ static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp, static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); static Tcl_ObjCmdProc TestExceptionCmd; -static int TestwincpuidCmd(ClientData dummy, Tcl_Interp* interp, - int objc, Tcl_Obj *const objv[]); static int TestplatformChmod(const char *nativePath, int pmode); static int TestchmodCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); @@ -78,7 +76,6 @@ TclplatformtestInit( Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); return TCL_OK; @@ -294,83 +291,6 @@ TestwinclockCmd( return TCL_OK; } -/* - *---------------------------------------------------------------------- - * - * TestwincpuidCmd -- - * - * Retrieves CPU ID information. - * - * Usage: - * testwincpuid <eax> - * - * Parameters: - * eax - The value to pass in the EAX register to a CPUID instruction. - * - * Results: - * Returns a four-element list containing the values from the EAX, EBX, - * ECX and EDX registers returned from the CPUID instruction. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestwincpuidCmd( - ClientData dummy, - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const * objv) /* Parameter vector */ -{ - int status, index, i; - unsigned int regs[4]; - Tcl_Obj *regsObjs[4]; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "eax"); - return TCL_ERROR; - } - if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) { - return TCL_ERROR; - } - status = TclWinCPUID((unsigned) index, regs); - if (status != TCL_OK) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("operation not available", -1)); - return status; - } - for (i=0 ; i<4 ; ++i) { - regsObjs[i] = Tcl_NewIntObj((int) regs[i]); - } - Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs)); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestwinsleepCmd -- - * - * Causes this process to wait for the given number of milliseconds by - * means of a direct call to Sleep. - * - * Usage: - * testwinsleep <n> - * - * Parameters: - * n - the number of milliseconds to sleep - * - * Results: - * None. - * - * Side effects: - * Sleeps for the requisite number of milliseconds. - * - *---------------------------------------------------------------------- - */ - static int TestwinsleepCmd( ClientData clientData, /* Unused */ @@ -430,7 +350,7 @@ TestExceptionCmd( "invalid_disp", "guard_page", "invalid_handle", "ctrl+c", NULL }; - static DWORD exceptions[] = { + static const DWORD exceptions[] = { EXCEPTION_ACCESS_VIOLATION, EXCEPTION_DATATYPE_MISALIGNMENT, EXCEPTION_ARRAY_BOUNDS_EXCEEDED, EXCEPTION_FLT_DENORMAL_OPERAND, EXCEPTION_FLT_DIVIDE_BY_ZERO, EXCEPTION_FLT_INEXACT_RESULT, |