diff options
Diffstat (limited to 'win')
-rw-r--r-- | win/Makefile.in | 107 | ||||
-rw-r--r-- | win/README | 8 | ||||
-rwxr-xr-x | win/configure | 1184 | ||||
-rw-r--r-- | win/configure.ac | 54 | ||||
-rw-r--r-- | win/makefile.vc | 204 | ||||
-rw-r--r-- | win/nmakehlp.c | 51 | ||||
-rw-r--r-- | win/rules.vc | 68 | ||||
-rw-r--r-- | win/tcl.dsp | 74 | ||||
-rw-r--r-- | win/tcl.m4 | 36 | ||||
-rw-r--r-- | win/tcl.rc | 3 | ||||
-rw-r--r-- | win/tclAppInit.c | 39 | ||||
-rw-r--r-- | win/tclConfig.sh.in | 27 | ||||
-rw-r--r-- | win/tclWin32Dll.c | 88 | ||||
-rw-r--r-- | win/tclWinChan.c | 419 | ||||
-rw-r--r-- | win/tclWinConsole.c | 2393 | ||||
-rw-r--r-- | win/tclWinDde.c | 172 | ||||
-rw-r--r-- | win/tclWinError.c | 12 | ||||
-rw-r--r-- | win/tclWinFCmd.c | 87 | ||||
-rw-r--r-- | win/tclWinFile.c | 216 | ||||
-rw-r--r-- | win/tclWinInit.c | 98 | ||||
-rw-r--r-- | win/tclWinInt.h | 7 | ||||
-rw-r--r-- | win/tclWinLoad.c | 45 | ||||
-rw-r--r-- | win/tclWinNotify.c | 25 | ||||
-rw-r--r-- | win/tclWinPanic.c | 8 | ||||
-rw-r--r-- | win/tclWinPipe.c | 199 | ||||
-rw-r--r-- | win/tclWinPort.h | 22 | ||||
-rw-r--r-- | win/tclWinReg.c | 168 | ||||
-rw-r--r-- | win/tclWinSerial.c | 174 | ||||
-rw-r--r-- | win/tclWinSock.c | 794 | ||||
-rw-r--r-- | win/tclWinTest.c | 357 | ||||
-rw-r--r-- | win/tclWinThrd.c | 32 | ||||
-rw-r--r-- | win/tclWinTime.c | 373 | ||||
-rw-r--r-- | win/tclooConfig.sh | 2 | ||||
-rw-r--r-- | win/tclsh.rc | 3 | ||||
-rw-r--r-- | win/tcltest.rc | 75 |
35 files changed, 4046 insertions, 3578 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index 8a294ce..e4f6b8b 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -50,7 +50,7 @@ LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) # Path name to use when installing Tcl modules. -MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8 +MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl9 # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) @@ -82,7 +82,7 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -D__USE_MINGW_ANSI_STDIO=0 -DMP_FIXED_CUTOFFS -DMP_NO_STDINT +CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DMP_FIXED_CUTOFFS -D__USE_MINGW_ANSI_STDIO=0 # To compile without backward compatibility and deprecated code uncomment the # following @@ -126,10 +126,6 @@ ZLIB_DIR_NATIVE = $(shell $(CYGPATH) '$(ZLIB_DIR)') MINIZIP_DIR_NATIVE = $(shell $(CYGPATH) '$(MINIZIP_DIR)') TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)') -# Fully qualify library path so that `make test` -# does not depend on the current directory. -LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P) -LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)') DLLSUFFIX = @DLLSUFFIX@ LIBSUFFIX = @LIBSUFFIX@ EXESUFFIX = @EXESUFFIX@ @@ -149,16 +145,18 @@ TCL_VFS_ROOT = libtcl.vfs TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ -DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX} +DDE_DLL_FILE = tcl9dde$(DDEVER)${DLLSUFFIX} +DDE_DLL_FILE8 = tcldde$(DDEVER)${DLLSUFFIX} DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX} -REG_DLL_FILE = tclregistry$(REGVER)${DLLSUFFIX} +REG_DLL_FILE = tcl9registry$(REGVER)${DLLSUFFIX} +REG_DLL_FILE8 = tclregistry$(REGVER)${DLLSUFFIX} REG_LIB_FILE = @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX} TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_EXE_FILE = tcltest${EXESUFFIX} TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX} TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ - package ifneeded dde 1.4.4 [list load [file normalize ${DDE_DLL_FILE}]];\ - package ifneeded registry 1.3.6 [list load [file normalize ${REG_DLL_FILE}]] + package ifneeded dde 1.4.5 [list load [file normalize ${DDE_DLL_FILE}]];\ + package ifneeded registry 1.3.7 [list load [file normalize ${REG_DLL_FILE}]] TEST_LOAD_FACILITIES = package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\ $(TEST_LOAD_PRMS) ZLIB_DLL_FILE = zlib1.dll @@ -232,6 +230,14 @@ SHARED_BUILD = @SHARED_BUILD@ INSTALL_MSGS = @INSTALL_MSGS@ INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ +# Fully qualify library path so that `make test` +# does not depend on the current directory. +# Only define these if not embedding the library +ifeq ($(ZIPFS_BUILD), 0) +LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P) +LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)') +endif + # Minizip MINIZIP_OBJS = \ adler32.$(HOST_OBJEXT) \ @@ -267,6 +273,7 @@ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} TCLTEST_OBJS = \ tclTest.$(OBJEXT) \ + tclTestABSList.$(OBJEXT) \ tclTestObj.$(OBJEXT) \ tclTestProcBodyObj.$(OBJEXT) \ tclThreadTest.$(OBJEXT) \ @@ -278,6 +285,7 @@ GENERIC_OBJS = \ regfree.$(OBJEXT) \ regerror.$(OBJEXT) \ tclAlloc.$(OBJEXT) \ + tclArithSeries.$(OBJEXT) \ tclAssembly.$(OBJEXT) \ tclAsync.$(OBJEXT) \ tclBasic.$(OBJEXT) \ @@ -402,6 +410,8 @@ TOMMATH_OBJS = \ bn_mp_mul_d.${OBJEXT} \ bn_mp_neg.${OBJEXT} \ bn_mp_or.${OBJEXT} \ + bn_mp_pack.${OBJEXT} \ + bn_mp_pack_count.${OBJEXT} \ bn_mp_radix_size.${OBJEXT} \ bn_mp_radix_smap.${OBJEXT} \ bn_mp_read_radix.${OBJEXT} \ @@ -456,6 +466,8 @@ REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ + tclStubCall.$(OBJEXT) \ + tclStubLibTbl.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ tclOOStubLib.$(OBJEXT) \ tclWinPanic.$(OBJEXT) @@ -514,7 +526,7 @@ tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH) -winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} +winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} ${DDE_DLL_FILE8} ${REG_DLL_FILE8} libraries: @@ -544,7 +556,7 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) ${TCL_ZIP_ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) $(COPY) tclsh.exe.manifest $(TCLSH).manifest @VC_MANIFEST_EMBED_EXE@ - if test "${ZIPFS_BUILD}" = "2" ; then \ + @if test "${ZIPFS_BUILD}" = "2" ; then \ cat ${TCL_ZIP_FILE} >> ${TCLSH}; \ ${NATIVE_ZIP} -A ${TCLSH} \ || echo 'ignore zip-error by adjust sfx process (not executable?)'; \ @@ -588,6 +600,14 @@ ${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest +${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinDde.$(OBJEXT) + @MAKE_DLL@ tcl8WinDde.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest + +${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinReg.$(OBJEXT) + @MAKE_DLL@ -DTCL_MAJOR_VERSION=8 tcl8WinReg.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest + ${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) @@ -599,7 +619,7 @@ ${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT} tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) $(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest -# use pre-built zlib1.dll +# use prebuilt zlib1.dll ${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} @if test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/zdll.libset" ; then \ $(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ @@ -613,10 +633,14 @@ ${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} # use pre-built libtommath.dll ${TOMMATH_DLL_FILE}: ${TCL_STUB_LIB_FILE} - @if test "@TOMMATH_LIBS@set" != "${TOMMATH_DIR_NATIVE}/win32/tommath.libset" ; then \ - $(COPY) $(TOMMATH_DIR)/win64/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ - else \ + @if test "@TOMMATH_LIBS@set" = "${TOMMATH_DIR_NATIVE}/win64-arm/tommath.libset" ; then \ + $(COPY) $(TOMMATH_DIR)/win64-arm/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ + elif test "@TOMMATH_LIBS@set" = "${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.aset" ; then \ + $(COPY) $(TOMMATH_DIR)/win64-arm/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ + elif test "@TOMMATH_LIBS@set" = "${TOMMATH_DIR_NATIVE}/win32/tommath.libset" ; then \ $(COPY) $(TOMMATH_DIR)/win32/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ + else \ + $(COPY) $(TOMMATH_DIR)/win64/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ fi; # Add the object extension to the implicit rules. By default .obj is not @@ -640,9 +664,15 @@ tclWinPipe.${OBJEXT}: tclWinPipe.c tclWinReg.${OBJEXT}: tclWinReg.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) +tcl8WinReg.${OBJEXT}: tclWinReg.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + tclWinDde.${OBJEXT}: tclWinDde.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) +tcl8WinDde.${OBJEXT}: tclWinDde.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + tclAppInit.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) @@ -682,6 +712,8 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c tclEvent.${OBJEXT}: tclEvent.c tclUuid.h +tclTest.${OBJEXT}: tclTest.c tclUuid.h + $(TOP_DIR)/manifest.uuid: printf "git-" >$(TOP_DIR)/manifest.uuid (cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || \ @@ -700,6 +732,15 @@ tclUuid.h: $(TOP_DIR)/manifest.uuid tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) +tclStubCall.${OBJEXT}: tclStubCall.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ + -DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \ + @DEPARG@ $(CC_OBJNAME) + +tclStubLibTbl.${OBJEXT}: tclStubLibTbl.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) + tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c $(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) @@ -817,7 +858,7 @@ install-binaries: binaries $(COPY) $$i "$(BIN_INSTALL_DIR)"; \ fi; \ done - @for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \ + @for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) @ZLIB_LIBS@ @TOMMATH_LIBS@; \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \ @@ -830,6 +871,10 @@ install-binaries: binaries $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ fi + @if [ -f $(DDE_DLL_FILE8) ]; then \ + echo Installing $(DDE_DLL_FILE8); \ + $(COPY) $(DDE_DLL_FILE8) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ + fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo Installing $(DDE_LIB_FILE); \ $(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ @@ -840,6 +885,10 @@ install-binaries: binaries $(COPY) $(ROOT_DIR)/library/registry/pkgIndex.tcl \ "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ fi + @if [ -f $(REG_DLL_FILE8) ]; then \ + echo Installing $(REG_DLL_FILE8); \ + $(COPY) $(REG_DLL_FILE8) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ + fi @if [ -f $(REG_LIB_FILE) ]; then \ echo Installing $(REG_LIB_FILE); \ $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ @@ -863,7 +912,7 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @for i in 8.4 8.4/platform 8.5 8.6 8.7; \ + @for i in 9.0 9.0/platform; \ do \ if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ @@ -880,20 +929,20 @@ install-libraries: libraries install-tzdata install-msgs $(ROOT_DIR)/library/cookiejar/*.gz; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ done; - @echo "Installing package http 2.10a4 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10a4.tm"; + @echo "Installing package http 2.10b2 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10b2.tm"; @echo "Installing package opt 0.4.7"; @for j in $(ROOT_DIR)/library/opt/*.tcl; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.7.1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm"; - @echo "Installing package tcltest 2.5.4 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.4.tm"; - @echo "Installing package platform 1.0.18 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.18.tm"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm"; + @echo "Installing package tcltest 2.5.7 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.7.tm"; + @echo "Installing package platform 1.0.19 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.tm"; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm"; + @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/9.0/platform/shell-1.1.4.tm"; @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ @@ -971,7 +1020,7 @@ runtest: tcltest # `make shell SCRIPT=foo.tcl` shell: binaries @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - $(WINE) ./$(TCLSH) $(SCRIPT) + $(WINE) ./$(TCLSH) -encoding utf-8 $(SCRIPT) # This target can be used to run tclsh inside either gdb or insight gdb: binaries @@ -996,7 +1045,7 @@ clean: cleanhelp clean-packages distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ - config.status.lineno tclsh.exe.manifest + config.status.lineno tclsh.exe.manifest tclUuid.h # # Bundled package targets @@ -1099,7 +1148,7 @@ genstubs: # # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool -# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & +# workspace. It depends on the Tcl & Tk being in directories called tcl9.* & # tk8.* up two directories from the TOOL_DIR. # @@ -1,4 +1,4 @@ -Tcl 8.7 for Windows +Tcl 9.0 for Windows 1. Introduction --------------- @@ -16,7 +16,7 @@ The information in this file is maintained on the web at: In order to compile Tcl for Windows, you need the following: - Tcl 8.7 Source Distribution (plus any patches) + Tcl 9.0 Source Distribution (plus any patches) and @@ -80,9 +80,9 @@ 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 tclsh87.exe, you must ensure that tcl87.dll, +Note that in order to run tclsh90.exe, you must ensure that tcl90.dll, libtommath.dll and zlib1.dll are on your path, in the system -directory, or in the directory containing tclsh87.exe. +directory, or in the directory containing tclsh90.exe. Note: Tcl no longer provides support for systems earlier than Windows 7. You will also need the Windows Universal C runtime (UCRT): diff --git a/win/configure b/win/configure index ba0007f..e689ad4 100755 --- a/win/configure +++ b/win/configure @@ -1,9 +1,9 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.71 for tcl 8.7. +# Generated by GNU Autoconf 2.72 for tcl 9.0. # # -# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, +# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, # Inc. # # @@ -15,7 +15,6 @@ # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh -as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh @@ -24,12 +23,13 @@ then : # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST -else $as_nop - case `(set -o) 2>/dev/null` in #( +else case e in #( + e) case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; +esac ;; esac fi @@ -101,7 +101,7 @@ IFS=$as_save_IFS ;; esac -# We did not find ourselves, most probably we were run as `sh COMMAND' +# We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 @@ -131,15 +131,14 @@ case $- in # (((( esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. +# out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi # We don't want this to propagate to other subprocesses. { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then - as_bourne_compatible="as_nop=: -if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 + as_bourne_compatible="if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: @@ -147,12 +146,13 @@ then : # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST -else \$as_nop - case \`(set -o) 2>/dev/null\` in #( +else case e in #( + e) case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; +esac ;; esac fi " @@ -170,8 +170,9 @@ as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ) then : -else \$as_nop - exitcode=1; echo positional parameters were not saved. +else case e in #( + e) exitcode=1; echo positional parameters were not saved. ;; +esac fi test x\$exitcode = x0 || exit 1 blah=\$(echo \$(echo blah)) @@ -185,14 +186,15 @@ test \$(( 1 + 1 )) = 2 || exit 1" if (eval "$as_required") 2>/dev/null then : as_have_required=yes -else $as_nop - as_have_required=no +else case e in #( + e) as_have_required=no ;; +esac fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null then : -else $as_nop - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +else case e in #( + e) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do @@ -225,12 +227,13 @@ IFS=$as_save_IFS if $as_found then : -else $as_nop - if { test -f "$SHELL" || test -f "$SHELL.exe"; } && +else case e in #( + e) if { test -f "$SHELL" || test -f "$SHELL.exe"; } && as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$SHELL as_have_required=yes -fi +fi ;; +esac fi @@ -252,7 +255,7 @@ case $- in # (((( esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. +# out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi @@ -271,7 +274,8 @@ $0: message. Then install a modern shell, or manually run $0: the script under such a shell if you do have one." fi exit 1 -fi +fi ;; +esac fi fi SHELL=${CONFIG_SHELL-/bin/sh} @@ -310,14 +314,6 @@ as_fn_exit () as_fn_set_status $1 exit $1 } # as_fn_exit -# as_fn_nop -# --------- -# Do nothing but, unlike ":", preserve the value of $?. -as_fn_nop () -{ - return $? -} -as_nop=as_fn_nop # as_fn_mkdir_p # ------------- @@ -386,11 +382,12 @@ then : { eval $1+=\$2 }' -else $as_nop - as_fn_append () +else case e in #( + e) as_fn_append () { eval $1=\$$1\$2 - } + } ;; +esac fi # as_fn_append # as_fn_arith ARG... @@ -404,21 +401,14 @@ then : { as_val=$(( $* )) }' -else $as_nop - as_fn_arith () +else case e in #( + e) as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` - } + } ;; +esac fi # as_fn_arith -# as_fn_nop -# --------- -# Do nothing but, unlike ":", preserve the value of $?. -as_fn_nop () -{ - return $? -} -as_nop=as_fn_nop # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- @@ -492,6 +482,8 @@ as_cr_alnum=$as_cr_Letters$as_cr_digits /[$]LINENO/= ' <$as_myself | sed ' + t clear + :clear s/[$]LINENO.*/&-/ t lineno b @@ -540,7 +532,6 @@ esac as_echo='printf %s\n' as_echo_n='printf %s' - rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file @@ -552,9 +543,9 @@ if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. + # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. + # In both cases, we have to default to 'cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then @@ -579,10 +570,12 @@ as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" +as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" +as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated # Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" +as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" +as_tr_sh="eval sed '$as_sed_sh'" # deprecated test -n "$DJDIR" || exec 7<&0 </dev/null @@ -608,8 +601,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' -PACKAGE_VERSION='8.7' -PACKAGE_STRING='tcl 8.7' +PACKAGE_VERSION='9.0' +PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -661,12 +654,6 @@ TCL_DDE_MINOR_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_VERSION TCL_PACKAGE_PATH -TCL_LIB_VERSIONS_OK -TCL_EXP_FILE -TCL_BUILD_EXP_FILE -TCL_NEEDS_EXP_FILE -TCL_LD_SEARCH_FLAGS -TCL_CC_SEARCH_FLAGS TCL_BUILD_LIB_SPEC MAKE_EXE MAKE_DLL @@ -693,7 +680,6 @@ CC_EXENAME CC_OBJNAME DEPARG EXTRA_CFLAGS -CFG_TCL_EXPORT_FILE_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_SHARED_LIB_SUFFIX TCL_BIN_DIR @@ -723,8 +709,6 @@ MACHINE TCL_WIN_VERSION VC_MANIFEST_EMBED_EXE VC_MANIFEST_EMBED_DLL -EGREP -GREP CPP LDFLAGS_DEFAULT CFLAGS_DEFAULT @@ -739,6 +723,8 @@ ZIP_PROG TCLSH_PROG EXEEXT_FOR_BUILD CC_FOR_BUILD +TCL_TOMMATH_LIB_NAME +TCL_ZLIB_LIB_NAME TOMMATH_OBJS ZLIB_OBJS TOMMATH_LIBS @@ -809,7 +795,6 @@ ac_user_opts=' enable_option_checking with_encoding enable_shared -enable_time64bit enable_64bit enable_zipfs enable_symbols @@ -932,7 +917,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: \`$ac_useropt'" + as_fn_error $? "invalid feature name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -958,7 +943,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: \`$ac_useropt'" + as_fn_error $? "invalid feature name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1171,7 +1156,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: \`$ac_useropt'" + as_fn_error $? "invalid package name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1187,7 +1172,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: \`$ac_useropt'" + as_fn_error $? "invalid package name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1217,8 +1202,8 @@ do | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) as_fn_error $? "unrecognized option: \`$ac_option' -Try \`$0 --help' for more information" + -*) as_fn_error $? "unrecognized option: '$ac_option' +Try '$0 --help' for more information" ;; *=*) @@ -1226,7 +1211,7 @@ Try \`$0 --help' for more information" # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + as_fn_error $? "invalid variable name: '$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; @@ -1276,7 +1261,7 @@ do as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done -# There might be people who depend on the old broken behavior: `$host' +# There might be people who depend on the old broken behavior: '$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias @@ -1344,7 +1329,7 @@ if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi -ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_msg="sources are in $srcdir, but 'cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` @@ -1372,7 +1357,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tcl 8.7 to adapt to many kinds of systems. +'configure' configures tcl 9.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1386,11 +1371,11 @@ Configuration: --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking ...' messages + -q, --quiet, --silent do not print 'checking ...' messages --cache-file=FILE cache test results in FILE [disabled] - -C, --config-cache alias for \`--cache-file=config.cache' + -C, --config-cache alias for '--cache-file=config.cache' -n, --no-create do not create output files - --srcdir=DIR find the sources in DIR [configure dir or \`..'] + --srcdir=DIR find the sources in DIR [configure dir or '..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX @@ -1398,10 +1383,10 @@ Installation directories: --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] -By default, \`make install' will install all the files in -\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify -an installation prefix other than \`$ac_default_prefix' using \`--prefix', -for instance \`--prefix=\$HOME'. +By default, 'make install' will install all the files in +'$ac_default_prefix/bin', '$ac_default_prefix/lib' etc. You can specify +an installation prefix other than '$ac_default_prefix' using '--prefix', +for instance '--prefix=\$HOME'. For better control, use the options below. @@ -1434,7 +1419,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tcl 8.7:";; + short | recursive ) echo "Configuration of tcl 9.0:";; esac cat <<\_ACEOF @@ -1443,7 +1428,6 @@ Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-shared build and link with shared libraries (default: on) - --enable-time64bit force 64-bit time_t for 32-bit build (default: off) --enable-64bit enable 64bit support (where applicable) --enable-zipfs build with Zipfs support (default: on) --enable-symbols build with debugging symbols (default: off) @@ -1465,7 +1449,7 @@ Some influential environment variables: you have headers in a nonstandard directory <include dir> CPP C preprocessor -Use these variables to override the choices made by `configure' or to help +Use these variables to override the choices made by 'configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to the package provider. @@ -1532,10 +1516,10 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -tcl configure 8.7 -generated by GNU Autoconf 2.71 +tcl configure 9.0 +generated by GNU Autoconf 2.72 -Copyright (C) 2021 Free Software Foundation, Inc. +Copyright (C) 2023 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1574,11 +1558,12 @@ printf "%s\n" "$ac_try_echo"; } >&5 } && test -s conftest.$ac_objext then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=1 + ac_retval=1 ;; +esac fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval @@ -1597,8 +1582,8 @@ printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 #include <$2> @@ -1606,10 +1591,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$3=yes" -else $as_nop - eval "$3=no" +else case e in #( + e) eval "$3=no" ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 @@ -1630,8 +1617,8 @@ printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 -else $as_nop - eval "$3=no" +else case e in #( + e) eval "$3=no" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 @@ -1661,12 +1648,14 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : -else $as_nop - eval "$3=yes" +else case e in #( + e) eval "$3=yes" ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 @@ -1702,11 +1691,12 @@ printf "%s\n" "$ac_try_echo"; } >&5 } then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=1 + ac_retval=1 ;; +esac fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval @@ -1736,8 +1726,8 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tcl $as_me 8.7, which was -generated by GNU Autoconf 2.71. Invocation command line was +It was created by tcl $as_me 9.0, which was +generated by GNU Autoconf 2.72. Invocation command line was $ $0$ac_configure_args_raw @@ -1983,10 +1973,10 @@ esac printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" \ - || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } fi done @@ -2022,9 +2012,7 @@ struct stat; /* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ struct buf { int x; }; struct buf * (*rcsopen) (struct buf *, struct stat *, int); -static char *e (p, i) - char **p; - int i; +static char *e (char **p, int i) { return p[i]; } @@ -2038,6 +2026,21 @@ static char *f (char * (*g) (char **, int), char **p, ...) return s; } +/* C89 style stringification. */ +#define noexpand_stringify(a) #a +const char *stringified = noexpand_stringify(arbitrary+token=sequence); + +/* C89 style token pasting. Exercises some of the corner cases that + e.g. old MSVC gets wrong, but not very hard. */ +#define noexpand_concat(a,b) a##b +#define expand_concat(a,b) noexpand_concat(a,b) +extern int vA; +extern int vbee; +#define aye A +#define bee B +int *pvA = &expand_concat(v,aye); +int *pvbee = &noexpand_concat(v,bee); + /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not \xHH hex character constants. These do not provoke an error unfortunately, instead are silently treated @@ -2065,16 +2068,19 @@ ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); # Test code for whether the C compiler supports C99 (global declarations) ac_c_conftest_c99_globals=' -// Does the compiler advertise C99 conformance? +/* Does the compiler advertise C99 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # error "Compiler does not advertise C99 conformance" #endif +// See if C++-style comments work. + #include <stdbool.h> extern int puts (const char *); extern int printf (const char *, ...); extern int dprintf (int, const char *, ...); extern void *malloc (size_t); +extern void free (void *); // Check varargs macros. These examples are taken from C99 6.10.3.5. // dprintf is used instead of fprintf to avoid needing to declare @@ -2124,7 +2130,6 @@ typedef const char *ccp; static inline int test_restrict (ccp restrict text) { - // See if C++-style comments work. // Iterate through items via the restricted pointer. // Also check for declarations in for loops. for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) @@ -2190,6 +2195,8 @@ ac_c_conftest_c99_main=' ia->datasize = 10; for (int i = 0; i < ia->datasize; ++i) ia->data[i] = i * 1.234; + // Work around memory leak warnings. + free (ia); // Check named initializers. struct named_init ni = { @@ -2211,7 +2218,7 @@ ac_c_conftest_c99_main=' # Test code for whether the C compiler supports C11 (global declarations) ac_c_conftest_c11_globals=' -// Does the compiler advertise C11 conformance? +/* Does the compiler advertise C11 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L # error "Compiler does not advertise C11 conformance" #endif @@ -2334,12 +2341,12 @@ for ac_var in $ac_precious_vars; do eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 -printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&5 +printf "%s\n" "$as_me: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 -printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was not set in the previous run" >&5 +printf "%s\n" "$as_me: error: '$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) @@ -2348,18 +2355,18 @@ printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 -printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' has changed since the previous run:" >&5 +printf "%s\n" "$as_me: error: '$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 -printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&5 +printf "%s\n" "$as_me: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 -printf "%s\n" "$as_me: former value: \`$ac_old_val'" >&2;} - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 -printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: '$ac_old_val'" >&5 +printf "%s\n" "$as_me: former value: '$ac_old_val'" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: '$ac_new_val'" >&5 +printf "%s\n" "$as_me: current value: '$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. @@ -2375,11 +2382,11 @@ printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} fi done if $ac_cache_corrupted; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} - as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file' + as_fn_error $? "run '${MAKE-make} distclean' and/or 'rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## @@ -2401,10 +2408,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="b1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 @@ -2469,8 +2476,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2492,7 +2499,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2514,8 +2522,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_CC"; then +else case e in #( + e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2537,7 +2545,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then @@ -2572,8 +2581,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2595,7 +2604,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2617,8 +2627,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no @@ -2657,7 +2667,8 @@ if test $ac_prog_rejected = yes; then ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" fi fi -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2681,8 +2692,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2704,7 +2715,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2730,8 +2742,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_CC"; then +else case e in #( + e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2753,7 +2765,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then @@ -2791,8 +2804,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2814,7 +2827,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2836,8 +2850,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_CC"; then +else case e in #( + e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2859,7 +2873,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then @@ -2888,10 +2903,10 @@ fi fi -test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 @@ -2963,8 +2978,8 @@ printf "%s\n" "$ac_try_echo"; } >&5 printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : - # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. -# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' + # Autoconf-2.13 could set the ac_cv_exeext variable to 'no'. +# So ignore a value of 'no', otherwise this would lead to 'EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. @@ -2984,7 +2999,7 @@ do ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not - # safe: cross compilers may not add the suffix if given an `-o' + # safe: cross compilers may not add the suffix if given an '-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. @@ -2995,8 +3010,9 @@ do done test "$ac_cv_exeext" = no && ac_cv_exeext= -else $as_nop - ac_file='' +else case e in #( + e) ac_file='' ;; +esac fi if test -z "$ac_file" then : @@ -3005,13 +3021,14 @@ printf "%s\n" "no" >&6; } printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables -See \`config.log' for more details" "$LINENO" 5; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -printf "%s\n" "yes" >&6; } +See 'config.log' for more details" "$LINENO" 5; } +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 printf %s "checking for C compiler default output file name... " >&6; } @@ -3035,10 +3052,10 @@ printf "%s\n" "$ac_try_echo"; } >&5 printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : - # If both `conftest.exe' and `conftest' are `present' (well, observable) -# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will -# work properly (i.e., refer to `conftest.exe'), while it won't with -# `rm'. + # If both 'conftest.exe' and 'conftest' are 'present' (well, observable) +# catch 'conftest.exe'. For instance with Cygwin, 'ls conftest' will +# work properly (i.e., refer to 'conftest.exe'), while it won't with +# 'rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in @@ -3048,11 +3065,12 @@ for ac_file in conftest.exe conftest conftest.*; do * ) break;; esac done -else $as_nop - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +else case e in #( + e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } ;; +esac fi rm -f conftest conftest$ac_cv_exeext { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 @@ -3068,6 +3086,8 @@ int main (void) { FILE *f = fopen ("conftest.out", "w"); + if (!f) + return 1; return ferror (f) || fclose (f) != 0; ; @@ -3107,26 +3127,27 @@ printf "%s\n" "$ac_try_echo"; } >&5 if test "$cross_compiling" = maybe; then cross_compiling=yes else - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details" "$LINENO" 5; } +If you meant to cross compile, use '--host'. +See 'config.log' for more details" "$LINENO" 5; } fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 printf "%s\n" "$cross_compiling" >&6; } -rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +rm -f conftest.$ac_ext conftest$ac_cv_exeext \ + conftest.o conftest.obj conftest.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 printf %s "checking for suffix of object files... " >&6; } if test ${ac_cv_objext+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -3158,16 +3179,18 @@ then : break;; esac done -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } ;; +esac fi -rm -f conftest.$ac_cv_objext conftest.$ac_ext +rm -f conftest.$ac_cv_objext conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 printf "%s\n" "$ac_cv_objext" >&6; } @@ -3178,8 +3201,8 @@ printf %s "checking whether the compiler supports GNU C... " >&6; } if test ${ac_cv_c_compiler_gnu+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -3196,12 +3219,14 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_compiler_gnu=yes -else $as_nop - ac_compiler_gnu=no +else case e in #( + e) ac_compiler_gnu=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } @@ -3219,8 +3244,8 @@ printf %s "checking whether $CC accepts -g... " >&6; } if test ${ac_cv_prog_cc_g+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_save_c_werror_flag=$ac_c_werror_flag +else case e in #( + e) ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" @@ -3238,8 +3263,8 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes -else $as_nop - CFLAGS="" +else case e in #( + e) CFLAGS="" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3254,8 +3279,8 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : -else $as_nop - ac_c_werror_flag=$ac_save_c_werror_flag +else case e in #( + e) ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3272,12 +3297,15 @@ if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ac_c_werror_flag=$ac_save_c_werror_flag + ac_c_werror_flag=$ac_save_c_werror_flag ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 printf "%s\n" "$ac_cv_prog_cc_g" >&6; } @@ -3304,8 +3332,8 @@ printf %s "checking for $CC option to enable C11 features... " >&6; } if test ${ac_cv_prog_cc_c11+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_prog_cc_c11=no +else case e in #( + e) ac_cv_prog_cc_c11=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3322,25 +3350,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext -CC=$ac_save_CC +CC=$ac_save_CC ;; +esac fi if test "x$ac_cv_prog_cc_c11" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } -else $as_nop - if test "x$ac_cv_prog_cc_c11" = x +else case e in #( + e) if test "x$ac_cv_prog_cc_c11" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } - CC="$CC $ac_cv_prog_cc_c11" + CC="$CC $ac_cv_prog_cc_c11" ;; +esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 - ac_prog_cc_stdc=c11 + ac_prog_cc_stdc=c11 ;; +esac fi fi if test x$ac_prog_cc_stdc = xno @@ -3350,8 +3381,8 @@ printf %s "checking for $CC option to enable C99 features... " >&6; } if test ${ac_cv_prog_cc_c99+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_prog_cc_c99=no +else case e in #( + e) ac_cv_prog_cc_c99=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3368,25 +3399,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c99" != "xno" && break done rm -f conftest.$ac_ext -CC=$ac_save_CC +CC=$ac_save_CC ;; +esac fi if test "x$ac_cv_prog_cc_c99" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } -else $as_nop - if test "x$ac_cv_prog_cc_c99" = x +else case e in #( + e) if test "x$ac_cv_prog_cc_c99" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } - CC="$CC $ac_cv_prog_cc_c99" + CC="$CC $ac_cv_prog_cc_c99" ;; +esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 - ac_prog_cc_stdc=c99 + ac_prog_cc_stdc=c99 ;; +esac fi fi if test x$ac_prog_cc_stdc = xno @@ -3396,8 +3430,8 @@ printf %s "checking for $CC option to enable C89 features... " >&6; } if test ${ac_cv_prog_cc_c89+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_prog_cc_c89=no +else case e in #( + e) ac_cv_prog_cc_c89=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3414,25 +3448,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext -CC=$ac_save_CC +CC=$ac_save_CC ;; +esac fi if test "x$ac_cv_prog_cc_c89" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } -else $as_nop - if test "x$ac_cv_prog_cc_c89" = x +else case e in #( + e) if test "x$ac_cv_prog_cc_c89" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } - CC="$CC $ac_cv_prog_cc_c89" + CC="$CC $ac_cv_prog_cc_c89" ;; +esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 - ac_prog_cc_stdc=c89 + ac_prog_cc_stdc=c89 ;; +esac fi fi @@ -3448,8 +3485,8 @@ printf %s "checking for inline... " >&6; } if test ${ac_cv_c_inline+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_c_inline=no +else case e in #( + e) ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3467,7 +3504,8 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext test "$ac_cv_c_inline" != no && break done - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 printf "%s\n" "$ac_cv_c_inline" >&6; } @@ -3496,8 +3534,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_AR+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$AR"; then +else case e in #( + e) if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3519,7 +3557,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi AR=$ac_cv_prog_AR if test -n "$AR"; then @@ -3541,8 +3580,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_AR+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_AR"; then +else case e in #( + e) if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3564,7 +3603,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then @@ -3598,8 +3638,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_RANLIB+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$RANLIB"; then +else case e in #( + e) if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3621,7 +3661,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then @@ -3643,8 +3684,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_RANLIB+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_RANLIB"; then +else case e in #( + e) if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3666,7 +3707,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then @@ -3700,8 +3742,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_RC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$RC"; then +else case e in #( + e) if test -n "$RC"; then ac_cv_prog_RC="$RC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3723,7 +3765,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi RC=$ac_cv_prog_RC if test -n "$RC"; then @@ -3745,8 +3788,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_RC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_RC"; then +else case e in #( + e) if test -n "$ac_ct_RC"; then ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3768,7 +3811,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_RC=$ac_cv_prog_ac_ct_RC if test -n "$ac_ct_RC"; then @@ -3806,8 +3850,8 @@ ac_make=`printf "%s\n" "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if eval test \${ac_cv_prog_make_${ac_make}_set+y} then : printf %s "(cached) " >&6 -else $as_nop - cat >conftest.make <<\_ACEOF +else case e in #( + e) cat >conftest.make <<\_ACEOF SHELL = /bin/sh all: @echo '@@@%%%=$(MAKE)=@@@%%%' @@ -3819,7 +3863,8 @@ case `${MAKE-make} -f conftest.make 2>/dev/null` in *) eval ac_cv_prog_make_${ac_make}_set=no;; esac -rm -f conftest.make +rm -f conftest.make ;; +esac fi if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 @@ -3873,8 +3918,9 @@ printf %s "checking how to build libraries... " >&6; } if test ${enable_shared+y} then : enableval=$enable_shared; tcl_ok=$enableval -else $as_nop - tcl_ok=yes +else case e in #( + e) tcl_ok=yes ;; +esac fi if test "$tcl_ok" = "yes" ; then @@ -3893,26 +3939,6 @@ printf "%s\n" "#define STATIC_BUILD 1" >>confdefs.h #-------------------------------------------------------------------- -# Check whether --enable-time64bit was given. -#-------------------------------------------------------------------- - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking force of 64-bit time_t" >&5 -printf %s "checking force of 64-bit time_t... " >&6; } -# Check whether --enable-time64bit was given. -if test ${enable_time64bit+y} -then : - enableval=$enable_time64bit; tcl_ok=$enableval -else $as_nop - tcl_ok=no -fi - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: \"$tcl_ok\"" >&5 -printf "%s\n" "\"$tcl_ok\"" >&6; } -if test "$tcl_ok" = "yes"; then - CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" -fi - -#-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. @@ -3957,8 +3983,9 @@ printf %s "checking if 64bit support is requested... " >&6; } if test ${enable_64bit+y} then : enableval=$enable_64bit; do64bit=$enableval -else $as_nop - do64bit=no +else case e in #( + e) do64bit=no ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 @@ -3977,8 +4004,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CYGPATH+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CYGPATH"; then +else case e in #( + e) if test -n "$CYGPATH"; then ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -4001,7 +4028,8 @@ done IFS=$as_save_IFS test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" -fi +fi ;; +esac fi CYGPATH=$ac_cv_prog_CYGPATH if test -n "$CYGPATH"; then @@ -4020,8 +4048,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_WINE+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$WINE"; then +else case e in #( + e) if test -n "$WINE"; then ac_cv_prog_WINE="$WINE" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -4043,7 +4071,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi WINE=$ac_cv_prog_WINE if test -n "$WINE"; then @@ -4069,8 +4098,8 @@ printf %s "checking for cross-compile version of gcc... " >&6; } if test ${ac_cv_cross+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef _WIN32 @@ -4088,11 +4117,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_cross=no -else $as_nop - ac_cv_cross=yes +else case e in #( + e) ac_cv_cross=yes ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5 printf "%s\n" "$ac_cv_cross" >&6; } @@ -4173,8 +4204,8 @@ printf %s "checking for mingw32 version of gcc... " >&6; } if test ${ac_cv_win32+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef _WIN32 @@ -4192,11 +4223,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_win32=no -else $as_nop - ac_cv_win32=yes +else case e in #( + e) ac_cv_win32=yes ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5 printf "%s\n" "$ac_cv_win32" >&6; } @@ -4213,8 +4246,8 @@ printf %s "checking for working -municode linker flag... " >&6; } if test ${ac_cv_municode+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) # ac_fn_c_try_link LINENO # ----------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. @@ -4246,11 +4279,12 @@ printf "%s\n" "$ac_try_echo"; } >&5 } then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=1 + ac_retval=1 ;; +esac fi # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would @@ -4278,12 +4312,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_municode=yes -else $as_nop - ac_cv_municode=no +else case e in #( + e) ac_cv_municode=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_municode" >&5 printf "%s\n" "$ac_cv_municode" >&6; } @@ -4299,8 +4335,8 @@ printf %s "checking for working -fno-lto... " >&6; } if test ${ac_cv_nolto+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -4314,11 +4350,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_nolto=yes -else $as_nop - ac_cv_nolto=no +else case e in #( + e) ac_cv_nolto=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_nolto" >&5 printf "%s\n" "$ac_cv_nolto" >&6; } @@ -4333,8 +4371,8 @@ printf %s "checking if the compiler understands -finput-charset... " >&6; } if test ${tcl_cv_cc_input_charset+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -4350,11 +4388,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cc_input_charset=yes -else $as_nop - tcl_cv_cc_input_charset=no +else case e in #( + e) tcl_cv_cc_input_charset=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_input_charset" >&5 printf "%s\n" "$tcl_cv_cc_input_charset" >&6; } @@ -4369,8 +4409,8 @@ printf %s "checking for working --enable-auto-image-base... " >&6; } if test ${ac_cv_enable_auto_image_base+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -4384,11 +4424,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_enable_auto_image_base=yes -else $as_nop - ac_cv_enable_auto_image_base=no +else case e in #( + e) ac_cv_enable_auto_image_base=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_enable_auto_image_base" >&5 printf "%s\n" "$ac_cv_enable_auto_image_base" >&6; } @@ -4527,9 +4569,10 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_win_64bit=yes -else $as_nop - tcl_win_64bit=no - +else case e in #( + e) tcl_win_64bit=no + ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext if test "$tcl_win_64bit" = "yes" ; then @@ -4668,12 +4711,12 @@ printf %s "checking for SEH support in compiler... " >&6; } if test ${tcl_cv_seh+y} then : printf %s "(cached) " >&6 -else $as_nop - if test "$cross_compiling" = yes +else case e in #( + e) if test "$cross_compiling" = yes then : tcl_cv_seh=no -else $as_nop - +else case e in #( + e) # ac_fn_c_try_run LINENO # ---------------------- # Try to run conftest.$ac_ext, and return whether this succeeded. Assumes that @@ -4704,12 +4747,13 @@ printf "%s\n" "$ac_try_echo"; } >&5 test $ac_status = 0; }; } then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: program exited with status $ac_status" >&5 +else case e in #( + e) printf "%s\n" "$as_me: program exited with status $ac_status" >&5 printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=$ac_status + ac_retval=$ac_status ;; +esac fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno @@ -4738,14 +4782,17 @@ _ACEOF if ac_fn_c_try_run "$LINENO" then : tcl_cv_seh=yes -else $as_nop - tcl_cv_seh=no +else case e in #( + e) tcl_cv_seh=no ;; +esac fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext + conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5 printf "%s\n" "$tcl_cv_seh" >&6; } @@ -4766,8 +4813,8 @@ printf %s "checking for EXCEPTION_DISPOSITION support in include files... " >&6; if test ${tcl_cv_eh_disposition+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ # define WIN32_LEAN_AND_MEAN @@ -4787,11 +4834,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_eh_disposition=yes -else $as_nop - tcl_cv_eh_disposition=no +else case e in #( + e) tcl_cv_eh_disposition=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5 printf "%s\n" "$tcl_cv_eh_disposition" >&6; } @@ -4801,53 +4850,6 @@ printf "%s\n" "#define EXCEPTION_DISPOSITION int" >>confdefs.h fi - # Check to see if winnt.h defines CHAR, SHORT, and LONG - # even if VOID has already been #defined. The win32api - # used by mingw and cygwin is known to do this. - - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5 -printf %s "checking for winnt.h that ignores VOID define... " >&6; } -if test ${tcl_cv_winnt_ignore_void+y} -then : - printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #define VOID void - #define WIN32_LEAN_AND_MEAN - #include <windows.h> - #undef WIN32_LEAN_AND_MEAN - -int -main (void) -{ - - CHAR c; - SHORT s; - LONG l; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - tcl_cv_winnt_ignore_void=yes -else $as_nop - tcl_cv_winnt_ignore_void=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_winnt_ignore_void" >&5 -printf "%s\n" "$tcl_cv_winnt_ignore_void" >&6; } - if test "$tcl_cv_winnt_ignore_void" = "yes" ; then - -printf "%s\n" "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h - - fi - ac_fn_c_check_header_compile "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default" if test "x$ac_cv_header_stdbool_h" = xyes then : @@ -4866,8 +4868,8 @@ printf %s "checking for cast to union support... " >&6; } if test ${tcl_cv_cast_to_union+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -4884,11 +4886,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cast_to_union=yes -else $as_nop - tcl_cv_cast_to_union=no +else case e in #( + e) tcl_cv_cast_to_union=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5 printf "%s\n" "$tcl_cv_cast_to_union" >&6; } @@ -4929,11 +4933,14 @@ then : enableval="$enable_shared" tcl_ok=$enableval -else $as_nop - +else case e in #( + e) tcl_ok=yes - + ;; +esac fi +zlib_lib_name=zdll.lib +tommath_lib_name=tommath.lib if test "$tcl_ok" = "yes" then : @@ -4960,18 +4967,21 @@ then : TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.a + zlib_lib_name=libz.dll.a + tommath_lib_name=libtommath.dll.a -else $as_nop - +else case e in #( + e) ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64-arm/tommath.lib - + ;; +esac fi -else $as_nop - +else case e in #( + e) if test "$GCC" == "yes" then : @@ -4979,38 +4989,47 @@ then : TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a + zlib_lib_name=libz.dll.a + tommath_lib_name=libtommath.dll.a -else $as_nop - +else case e in #( + e) ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/tommath.lib - + ;; +esac fi - + ;; +esac fi -else $as_nop - +else case e in #( + e) ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win32/tommath.lib - + ;; +esac fi -else $as_nop - +else case e in #( + e) ZLIB_OBJS=\${ZLIB_OBJS} TOMMATH_OBJS=\${TOMMATH_OBJS} - + ;; +esac fi printf "%s\n" "#define HAVE_ZLIB 1" >>confdefs.h +TCL_ZLIB_LIB_NAME=$zlib_lib_name + +TCL_TOMMATH_LIB_NAME=$tommath_lib_name ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" " #include <stdint.h> @@ -5043,8 +5062,9 @@ fi if test ${enable_zipfs+y} then : enableval=$enable_zipfs; tcl_ok=$enableval -else $as_nop - tcl_ok=yes +else case e in #( + e) tcl_ok=yes ;; +esac fi if test "$tcl_ok" = "yes" ; then @@ -5061,8 +5081,8 @@ printf %s "checking for gcc... " >&6; } if test ${ac_cv_path_cc+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/gcc 2> /dev/null` \ @@ -5075,7 +5095,8 @@ else $as_nop fi done done - + ;; +esac fi fi @@ -5092,8 +5113,8 @@ printf %s "checking for build system executable suffix... " >&6; } if test ${bfd_cv_build_exeext+y} then : printf %s "(cached) " >&6 -else $as_nop - rm -f conftest* +else case e in #( + e) rm -f conftest* echo 'int main () { return 0; }' > conftest.c bfd_cv_build_exeext= ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 @@ -5104,7 +5125,8 @@ else $as_nop esac done rm -f conftest* - test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 printf "%s\n" "$bfd_cv_build_exeext" >&6; } @@ -5122,8 +5144,8 @@ printf %s "checking for tclsh... " >&6; } if test ${ac_cv_path_tclsh+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \ @@ -5136,7 +5158,8 @@ else $as_nop fi done done - + ;; +esac fi @@ -5163,8 +5186,8 @@ printf %s "checking for zip... " >&6; } if test ${ac_cv_path_zip+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/zip 2> /dev/null` \ @@ -5177,7 +5200,8 @@ else $as_nop fi done done - + ;; +esac fi if test -f "$ac_cv_path_zip" ; then @@ -5251,8 +5275,8 @@ printf %s "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; } if test ${tcl_cv_findex_enums+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN @@ -5273,11 +5297,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_findex_enums=yes -else $as_nop - tcl_cv_findex_enums=no +else case e in #( + e) tcl_cv_findex_enums=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5 printf "%s\n" "$tcl_cv_findex_enums" >&6; } @@ -5294,8 +5320,8 @@ printf %s "checking for intrinsics support in compiler... " >&6; } if test ${tcl_cv_intrinsics+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN @@ -5316,12 +5342,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_intrinsics=yes -else $as_nop - tcl_cv_intrinsics=no +else case e in #( + e) tcl_cv_intrinsics=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intrinsics" >&5 printf "%s\n" "$tcl_cv_intrinsics" >&6; } @@ -5338,8 +5366,8 @@ printf %s "checking for wspiapi.h... " >&6; } if test ${tcl_cv_wspiapi_h+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <wspiapi.h> @@ -5355,11 +5383,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_wspiapi_h=yes -else $as_nop - tcl_cv_wspiapi_h=no +else case e in #( + e) tcl_cv_wspiapi_h=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_wspiapi_h" >&5 printf "%s\n" "$tcl_cv_wspiapi_h" >&6; } @@ -5378,8 +5408,8 @@ printf %s "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; } if test ${tcl_cv_findex_enums+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN @@ -5400,11 +5430,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_findex_enums=yes -else $as_nop - tcl_cv_findex_enums=no +else case e in #( + e) tcl_cv_findex_enums=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5 printf "%s\n" "$tcl_cv_findex_enums" >&6; } @@ -5427,8 +5459,9 @@ printf %s "checking for build with symbols... " >&6; } if test ${enable_symbols+y} then : enableval=$enable_symbols; tcl_ok=$enableval -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. @@ -5499,8 +5532,8 @@ if test -z "$CPP"; then if test ${ac_cv_prog_CPP+y} then : printf %s "(cached) " >&6 -else $as_nop - # Double quotes because $CC needs to be expanded +else case e in #( + e) # Double quotes because $CC needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" cpp /lib/cpp do ac_preproc_ok=false @@ -5518,9 +5551,10 @@ _ACEOF if ac_fn_c_try_cpp "$LINENO" then : -else $as_nop - # Broken: fails on valid input. -continue +else case e in #( + e) # Broken: fails on valid input. +continue ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext @@ -5534,15 +5568,16 @@ if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue -else $as_nop - # Passes both tests. +else case e in #( + e) # Passes both tests. ac_preproc_ok=: -break +break ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +# Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : @@ -5551,7 +5586,8 @@ fi done ac_cv_prog_CPP=$CPP - + ;; +esac fi CPP=$ac_cv_prog_CPP else @@ -5574,9 +5610,10 @@ _ACEOF if ac_fn_c_try_cpp "$LINENO" then : -else $as_nop - # Broken: fails on valid input. -continue +else case e in #( + e) # Broken: fails on valid input. +continue ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext @@ -5590,24 +5627,26 @@ if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue -else $as_nop - # Passes both tests. +else case e in #( + e) # Passes both tests. ac_preproc_ok=: -break +break ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +# Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : -else $as_nop - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +else case e in #( + e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } ;; +esac fi ac_ext=c @@ -5617,14 +5656,14 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 -printf %s "checking for grep that handles long lines and -e... " >&6; } -if test ${ac_cv_path_GREP+y} +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep -e" >&5 +printf %s "checking for egrep -e... " >&6; } +if test ${ac_cv_path_EGREP_TRADITIONAL+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -z "$GREP"; then - ac_path_GREP_found=false +else case e in #( + e) if test -z "$EGREP_TRADITIONAL"; then + ac_path_EGREP_TRADITIONAL_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin @@ -5638,13 +5677,14 @@ do for ac_prog in grep ggrep do for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_GREP="$as_dir$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_GREP" || continue -# Check for GNU ac_path_GREP and select it if it is found. - # Check for GNU $ac_path_GREP -case `"$ac_path_GREP" --version 2>&1` in + ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue +# Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found. + # Check for GNU $ac_path_EGREP_TRADITIONAL +case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #( *GNU*) - ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;; +#( *) ac_count=0 printf %s 0123456789 >"conftest.in" @@ -5653,14 +5693,14 @@ case `"$ac_path_GREP" --version 2>&1` in cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" - printf "%s\n" 'GREP' >> "conftest.nl" - "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl" + "$ac_path_EGREP_TRADITIONAL" -E 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_GREP_max-0}; then + if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then # Best one so far, save it but keep looking for a better one - ac_cv_path_GREP="$ac_path_GREP" - ac_path_GREP_max=$ac_count + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" + ac_path_EGREP_TRADITIONAL_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break @@ -5668,35 +5708,24 @@ case `"$ac_path_GREP" --version 2>&1` in rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac - $ac_path_GREP_found && break 3 + $ac_path_EGREP_TRADITIONAL_found && break 3 done done done IFS=$as_save_IFS - if test -z "$ac_cv_path_GREP"; then - as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then + : fi else - ac_cv_path_GREP=$GREP -fi - + ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 -printf "%s\n" "$ac_cv_path_GREP" >&6; } - GREP="$ac_cv_path_GREP" - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 -printf %s "checking for egrep... " >&6; } -if test ${ac_cv_path_EGREP+y} + if test "$ac_cv_path_EGREP_TRADITIONAL" then : - printf %s "(cached) " >&6 -else $as_nop - if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 - then ac_cv_path_EGREP="$GREP -E" - else - if test -z "$EGREP"; then - ac_path_EGREP_found=false + ac_cv_path_EGREP_TRADITIONAL="$ac_cv_path_EGREP_TRADITIONAL -E" +else case e in #( + e) if test -z "$EGREP_TRADITIONAL"; then + ac_path_EGREP_TRADITIONAL_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin @@ -5710,13 +5739,14 @@ do for ac_prog in egrep do for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP="$as_dir$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP" || continue -# Check for GNU ac_path_EGREP and select it if it is found. - # Check for GNU $ac_path_EGREP -case `"$ac_path_EGREP" --version 2>&1` in + ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue +# Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found. + # Check for GNU $ac_path_EGREP_TRADITIONAL +case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #( *GNU*) - ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;; +#( *) ac_count=0 printf %s 0123456789 >"conftest.in" @@ -5725,14 +5755,14 @@ case `"$ac_path_EGREP" --version 2>&1` in cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" - printf "%s\n" 'EGREP' >> "conftest.nl" - "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl" + "$ac_path_EGREP_TRADITIONAL" 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_EGREP_max-0}; then + if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then # Best one so far, save it but keep looking for a better one - ac_cv_path_EGREP="$ac_path_EGREP" - ac_path_EGREP_max=$ac_count + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" + ac_path_EGREP_TRADITIONAL_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break @@ -5740,24 +5770,25 @@ case `"$ac_path_EGREP" --version 2>&1` in rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac - $ac_path_EGREP_found && break 3 + $ac_path_EGREP_TRADITIONAL_found && break 3 done done done IFS=$as_save_IFS - if test -z "$ac_cv_path_EGREP"; then + if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else - ac_cv_path_EGREP=$EGREP + ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL fi - - fi + ;; +esac +fi ;; +esac fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 -printf "%s\n" "$ac_cv_path_EGREP" >&6; } - EGREP="$ac_cv_path_EGREP" - +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP_TRADITIONAL" >&5 +printf "%s\n" "$ac_cv_path_EGREP_TRADITIONAL" >&6; } + EGREP_TRADITIONAL=$ac_cv_path_EGREP_TRADITIONAL { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to embed manifest" >&5 @@ -5766,8 +5797,9 @@ printf %s "checking whether to embed manifest... " >&6; } if test ${enable_embedded_manifest+y} then : enableval=$enable_embedded_manifest; embed_ok=$enableval -else $as_nop - embed_ok=yes +else case e in #( + e) embed_ok=yes ;; +esac fi @@ -5786,7 +5818,7 @@ print("manifest needed") _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "manifest needed" >/dev/null 2>&1 + $EGREP_TRADITIONAL "manifest needed" >/dev/null 2>&1 then : # Could do a CHECK_PROG for mt, but should always be with MSVC8+ @@ -5826,31 +5858,31 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" -eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" -eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" +eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${LIBSUFFIX}\"" +eval "TCL_STUB_LIB_FLAG=\"-ltclstub${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then + eval "TCL_LIB_FLAG=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" else + eval "TCL_LIB_FLAG=\"-ltcl${VER}${FLAGSUFFIX}\"" eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\"" fi -eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${FLAGSUFFIX}\"" -eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\"" +eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\"" +eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}" TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" -TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX} CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX} -CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX} #-------------------------------------------------------------------- # Adjust the defines for how the resources are built depending @@ -5918,7 +5950,6 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d - # win/tcl.m4 doesn't set (CFLAGS) @@ -5956,14 +5987,6 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d -# empty on win, but needs sub'ing - - - - - - - @@ -5995,8 +6018,8 @@ cat >confcache <<\_ACEOF # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # -# `ac_cv_env_foo' variables (set or unset) will be overridden when -# loading this file, other *unset* `ac_cv_foo' will be assigned the +# 'ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* 'ac_cv_foo' will be assigned the # following values. _ACEOF @@ -6026,14 +6049,14 @@ printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) - # `set' does not quote correctly, so add quotes: double-quote + # 'set' does not quote correctly, so add quotes: double-quote # substitution turns \\\\ into \\, and sed turns \\ into \. sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) - # `set' quotes correctly as required by POSIX, so do not add quotes. + # 'set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | @@ -6097,9 +6120,7 @@ s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g t quote b any :quote -s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g -s/\[/\\&/g -s/\]/\\&/g +s/[][ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\$/$$/g H :any @@ -6159,7 +6180,6 @@ cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh -as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh @@ -6168,12 +6188,13 @@ then : # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST -else $as_nop - case `(set -o) 2>/dev/null` in #( +else case e in #( + e) case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; +esac ;; esac fi @@ -6245,7 +6266,7 @@ IFS=$as_save_IFS ;; esac -# We did not find ourselves, most probably we were run as `sh COMMAND' +# We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 @@ -6274,7 +6295,6 @@ as_fn_error () } # as_fn_error - # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. @@ -6314,11 +6334,12 @@ then : { eval $1+=\$2 }' -else $as_nop - as_fn_append () +else case e in #( + e) as_fn_append () { eval $1=\$$1\$2 - } + } ;; +esac fi # as_fn_append # as_fn_arith ARG... @@ -6332,11 +6353,12 @@ then : { as_val=$(( $* )) }' -else $as_nop - as_fn_arith () +else case e in #( + e) as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` - } + } ;; +esac fi # as_fn_arith @@ -6419,9 +6441,9 @@ if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. + # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. + # In both cases, we have to default to 'cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then @@ -6502,10 +6524,12 @@ as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" +as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" +as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated # Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" +as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" +as_tr_sh="eval sed '$as_sed_sh'" # deprecated exec 6>&1 @@ -6520,8 +6544,8 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by tcl $as_me 8.7, which was -generated by GNU Autoconf 2.71. Invocation command line was +This file was extended by tcl $as_me 9.0, which was +generated by GNU Autoconf 2.72. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -6548,7 +6572,7 @@ _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ -\`$as_me' instantiates files and other configuration actions +'$as_me' instantiates files and other configuration actions from templates according to the current configuration. Unless the files and actions are specified as TAGs, all are instantiated by default. @@ -6575,11 +6599,11 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -tcl config.status 8.7 -configured by $0, generated by GNU Autoconf 2.71, +tcl config.status 9.0 +configured by $0, generated by GNU Autoconf 2.72, with options \\"\$ac_cs_config\\" -Copyright (C) 2021 Free Software Foundation, Inc. +Copyright (C) 2023 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -6636,8 +6660,8 @@ do ac_cs_silent=: ;; # This is an error. - -*) as_fn_error $? "unrecognized option: \`$1' -Try \`$0 --help' for more information." ;; + -*) as_fn_error $? "unrecognized option: '$1' +Try '$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" ac_need_defaults=false ;; @@ -6689,7 +6713,7 @@ do "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; "tclsh.exe.manifest") CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;; - *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + *) as_fn_error $? "invalid argument: '$ac_config_target'" "$LINENO" 5;; esac done @@ -6707,7 +6731,7 @@ fi # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: -# after its creation but before its name has been assigned to `$tmp'. +# after its creation but before its name has been assigned to '$tmp'. $debug || { tmp= ac_tmp= @@ -6731,7 +6755,7 @@ ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. -# This happens for instance with `./config.status config.h'. +# This happens for instance with './config.status config.h'. if test -n "$CONFIG_FILES"; then @@ -6897,7 +6921,7 @@ do esac case $ac_mode$ac_tag in :[FHL]*:*);; - :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :L* | :C*:*) as_fn_error $? "invalid tag '$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac @@ -6919,19 +6943,19 @@ do -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, - # because $ac_f cannot contain `:'. + # because $ac_f cannot contain ':'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || - as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + as_fn_error 1 "cannot find input file: '$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done - # Let's still pretend it is `configure' which instantiates (i.e., don't + # Let's still pretend it is 'configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` @@ -7055,7 +7079,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 esac _ACEOF -# Neutralize VPATH when `$srcdir' = `.'. +# Neutralize VPATH when '$srcdir' = '.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 @@ -7084,9 +7108,9 @@ test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable 'datarootdir' which seems to be undefined. Please make sure it is defined" >&5 -printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable 'datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$ac_tmp/stdin" diff --git a/win/configure.ac b/win/configure.ac index 01f70b4..8eb748e 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -3,7 +3,7 @@ # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. -AC_INIT([tcl],[8.7]) +AC_INIT([tcl],[9.0]) AC_CONFIG_SRCDIR([../generic/tcl.h]) AC_PREREQ([2.69]) @@ -12,10 +12,10 @@ AC_PREREQ([2.69]) # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="b1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 @@ -92,20 +92,6 @@ SC_TCL_CFG_ENCODING SC_ENABLE_SHARED #-------------------------------------------------------------------- -# Check whether --enable-time64bit was given. -#-------------------------------------------------------------------- - -AC_MSG_CHECKING([force of 64-bit time_t]) -AC_ARG_ENABLE(time64bit, - AS_HELP_STRING([--enable-time64bit], - [force 64-bit time_t for 32-bit build (default: off)]), - [tcl_ok=$enableval], [tcl_ok=no]) -AC_MSG_RESULT("$tcl_ok") -if test "$tcl_ok" = "yes"; then - CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" -fi - -#-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. @@ -135,6 +121,8 @@ AS_IF([test "${enable_shared+set}" = "set"], [ ], [ tcl_ok=yes ]) +zlib_lib_name=zdll.lib +tommath_lib_name=tommath.lib AS_IF([test "$tcl_ok" = "yes"], [ AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}]) AC_SUBST(TOMMATH_DLL_FILE,[\${TOMMATH_DLL_FILE}]) @@ -145,6 +133,8 @@ AS_IF([test "$tcl_ok" = "yes"], [ AS_IF([test "$GCC" == "yes"],[ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a]) AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.a]) + zlib_lib_name=libz.dll.a + tommath_lib_name=libtommath.dll.a ], [ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib]) AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64-arm/tommath.lib]) @@ -153,6 +143,8 @@ AS_IF([test "$tcl_ok" = "yes"], [ AS_IF([test "$GCC" == "yes"],[ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a]) AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a]) + zlib_lib_name=libz.dll.a + tommath_lib_name=libtommath.dll.a ], [ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/zdll.lib]) AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/tommath.lib]) @@ -167,7 +159,8 @@ AS_IF([test "$tcl_ok" = "yes"], [ AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) - +AC_SUBST(TCL_ZLIB_LIB_NAME, $zlib_lib_name) +AC_SUBST(TCL_TOMMATH_LIB_NAME, $tommath_lib_name) AC_CHECK_TYPES([intptr_t, uintptr_t],,,[[ #include <stdint.h> ]]) @@ -327,31 +320,31 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" -eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" -eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" +eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${LIBSUFFIX}\"" +eval "TCL_STUB_LIB_FLAG=\"-ltclstub${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then + eval "TCL_LIB_FLAG=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" else + eval "TCL_LIB_FLAG=\"-ltcl${VER}${FLAGSUFFIX}\"" eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\"" fi -eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${FLAGSUFFIX}\"" -eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\"" +eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\"" +eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}" TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" -TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX} CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX} -CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX} #-------------------------------------------------------------------- # Adjust the defines for how the resources are built depending @@ -418,7 +411,6 @@ AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_BIN_DIR) AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX) AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX) -AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX) # win/tcl.m4 doesn't set (CFLAGS) AC_SUBST(CFLAGS_DEFAULT) @@ -457,15 +449,7 @@ AC_SUBST(POST_MAKE_LIB) AC_SUBST(MAKE_DLL) AC_SUBST(MAKE_EXE) -# empty on win, but needs sub'ing AC_SUBST(TCL_BUILD_LIB_SPEC) -AC_SUBST(TCL_CC_SEARCH_FLAGS) -AC_SUBST(TCL_LD_SEARCH_FLAGS) -AC_SUBST(TCL_NEEDS_EXP_FILE) -AC_SUBST(TCL_BUILD_EXP_FILE) -AC_SUBST(TCL_EXP_FILE) -AC_SUBST(DL_LIBS) -AC_SUBST(TCL_LIB_VERSIONS_OK) AC_SUBST(TCL_PACKAGE_PATH) # win only diff --git a/win/makefile.vc b/win/makefile.vc index 522f19f..b5f4e37 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -17,13 +17,13 @@ # nmake [-nologo] -f makefile.vc [TARGET|MACRODEF [TARGET|MACRODEF] [...]]
#
# For MACRODEF, see TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md)
-# or examine Sections 6-8 in rules.vc.
+# or examine Sections 7-9 in rules.vc.
#
-# Possible values of TARGET are:
-# release -- Builds the core, the shell and the dlls. (default)
-# dlls -- Just builds the windows extensions
-# shell -- Just builds the shell and the core.
-# core -- Only builds the core [tclXX.(dll|lib)].
+# Possible values for TARGET are:
+# release -- Builds everything that ships with a release. (default)
+# core -- Builds the core [tclXX.(dll|lib)]
+# shell -- Builds tclsh and the core.
+# dlls -- Just builds the windows extensions.
# all -- Builds everything.
# test -- Builds and runs the test suite.
# tcltest -- Just builds the test shell.
@@ -47,12 +47,12 @@ # Visual Studio/Windows SDK for the appropriate target architecture.
#
# NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform
-# SDK (not expressly needed), run setenv.bat after
-# vcvars32.bat according to the instructions for it. This can also
-# turn on the 64-bit compiler, if your SDK has it.
+# SDK (not expressly needed), run setenv.bat after vcvars32.bat
+# according to the instructions for it. This can also turn on the
+# 64-bit compiler, if your SDK has it.
#
# Basic macros and options usable on the commandline (see rules.vc for more info):
-# OPTS=msvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,time64bit,unchecked,utf16,none
+# OPTS=nomsvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,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.
@@ -75,12 +75,9 @@ # have the dde and registry extensions linked inside.
# symbols = Adds symbols for step debugging.
# thrdalloc = Use the thread allocator (shared global free pool).
-# time64bit = Forces a build using 64-bit time_t for 32-bit build
-# (CRT library should support this).
# unchecked = Allows a symbols build to not use the debug
# enabled runtime (msvcrt.dll not msvcrtd.dll
# or libcmt.lib not libcmtd.lib).
-# utf16 = Forces a build using UTF-16 representation internally.
#
# STATS=compdbg,memdbg,none
# Sets optional memory and bytecode compiler debugging code added
@@ -112,7 +109,7 @@ # Hooks to allow the intermediate and output directories to be
# changed. $(OUT_DIR) is assumed to be
# $(BINROOT)\(Release|Debug) based on if symbols are requested.
-# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
+# $(TMP_DIR) will be $(OUT_DIR)\<buildtype> by default.
#
# TESTPAT=<file>
# Reads the tests requested to be run from this file.
@@ -137,13 +134,20 @@ PROJECT = tcl # rules.vc file will set up "all" as the target.
DEFAULT_BUILD_TARGET = release
-# We want to use our own resource file, not the standard template one.
+# We have a custom resource file
RCFILE = tcl.rc
-# The rules.vc file does most of the hard work in terms of defining
+# The rules.vc file does much of the hard work in terms of defining
# the build configuration, macros, output directories etc.
!include "rules.vc"
+#
+# The tclsh executable without the embedded libzip. We need this
+# separately from tclsh to have dependency and build order work right.
+# Ditto for the DLL and tcltest
+TCLSHRAW=$(TCLSH:.exe=-raw.exe)
+TCLLIBRAW=$(TCLLIB:.dll=-raw.dll)
+
# Tcl version info based on macros set up by rules.vc
DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
@@ -164,9 +168,11 @@ VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) !if [nmakehlp -f $(OPTS) "noembed"]
!message *** Option noembed specified. Tcl script library will not be appended to the binary.
TCL_EMBED_SCRIPTS = 0
+TCL_TEST_LIBRARY=$(ROOT:\=/)/library
!else
!message *** Tcl script library will be appended to the binary.
TCL_EMBED_SCRIPTS = 1
+TCL_TEST_LIBRARY=
!endif
# We need versions of various core packages to generate appropriate
@@ -209,13 +215,14 @@ DDEVERSION = $(DDEDOTVERSION:.=) REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)
-TCLREGLIBNAME = $(PROJECT)registry$(REGVERSION)$(SUFX:t=).$(EXT)
+TCLREGLIBNAME = $(PROJECT)9registry$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
-TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
+TCLDDELIBNAME = $(PROJECT)9dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
-TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
+TCLTEST = $(OUT_DIR)\$(PROJECT)test$(VERSION)$(SUFX:t=).exe
+TCLTESTRAW = $(TCLTEST:.exe=-raw.exe)
TCLSHOBJS = \
$(TMP_DIR)\tclAppInit.obj \
@@ -227,16 +234,19 @@ TCLTESTOBJS = \ $(TMP_DIR)\tclTestProcBodyObj.obj \
$(TMP_DIR)\tclThreadTest.obj \
$(TMP_DIR)\tclWinTest.obj \
+ $(TMP_DIR)\tclTestABSList.obj \
!if !$(STATIC_BUILD)
$(OUT_DIR)\tommath.lib \
!endif
- $(TMP_DIR)\testMain.obj
+ $(TMP_DIR)\testMain.obj \
+ $(TMP_DIR)\tcltest.res
COREOBJS = \
$(TMP_DIR)\regcomp.obj \
$(TMP_DIR)\regerror.obj \
$(TMP_DIR)\regexec.obj \
$(TMP_DIR)\regfree.obj \
+ $(TMP_DIR)\tclArithSeries.obj \
$(TMP_DIR)\tclAlloc.obj \
$(TMP_DIR)\tclAssembly.obj \
$(TMP_DIR)\tclAsync.obj \
@@ -380,6 +390,8 @@ TOMMATHOBJS = \ $(TMP_DIR)\bn_mp_mul_d.obj \
$(TMP_DIR)\bn_mp_neg.obj \
$(TMP_DIR)\bn_mp_or.obj \
+ $(TMP_DIR)\bn_mp_pack.obj \
+ $(TMP_DIR)\bn_mp_pack_count.obj \
$(TMP_DIR)\bn_mp_radix_size.obj \
$(TMP_DIR)\bn_mp_radix_smap.obj \
$(TMP_DIR)\bn_mp_read_radix.obj \
@@ -441,6 +453,8 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \
$(TMP_DIR)\tclStubLib.obj \
+ $(TMP_DIR)\tclStubCall.obj \
+ $(TMP_DIR)\tclStubLibTbl.obj \
$(TMP_DIR)\tclTomMathStubLib.obj \
$(TMP_DIR)\tclOOStubLib.obj \
$(TMP_DIR)\tclWinPanic.obj
@@ -471,24 +485,57 @@ TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT) #---------------------------------------------------------------------
# Project specific targets
+# There are 4 primary build configurations to consider from the combination
+# of static/shared and embed/noembed of the library zip. The targets are
+# done in the following order.
+# $(TCLLIB) - this is either the core static .lib or the .dll. The target
+# build does not embed the library zip in the DLL irrespective
+# of the noembed setting. A copy is made as $(TCLLIBRAW)
+# as the $(TCLLIB) binary is potentially modified later.
+# dlls - these are the registry and dde DLL's or static libraries
+# $(TCLSH) - the Tcl shell WITHOUT any embedded zip. This needs $(TCLLIB)
+# to be built first as it links against it. A copy is made
+# as $(TCLSHRAW) as $(TCLSH) binary may be modified later.
+# $(TCLSCRIPTZIP) - the zip file that is to be embedded. Note this also
+# ships separately and needs to be built irrespective of the
+# whether it is embedded or not. All above targets need to
+# be built prior as they are used to build the zip (unlike
+# Unix where the external zip program is used.)
+# core - this virtual target builds the final release ready Tcl
+# library. For shared, embedded builds it appends $(TCLSCRIPTZIP)
+# to the $(TCLLIB). For other build configurations, this
+# is a no-op.
+# shell - this virtual target builds the final release ready tclsh shell.
+# For static, embedded builds it appends $(TCLSCRIPTZIP)
+# to the $(TCLSH). For other build configurations, this
+# is a no-op.
+# release - Everything that builds as part of a release
#---------------------------------------------------------------------
-release: setup $(TCLSH) $(TCLSTUBLIB) dlls libtclzip embed pkgs
-core: setup $(TCLLIB) $(TCLSTUBLIB)
-shell: setup $(TCLSH)
-dlls: setup $(TCLREGLIB) $(TCLDDELIB) $(OUT_DIR)\zlib1.dll $(OUT_DIR)\libtommath.dll
-libtclzip: core dlls $(TCLSCRIPTZIP)
-all: setup $(TCLSH) $(TCLSTUBLIB) dlls libtclzip embed pkgs
-embed: setup $(TCLSH) $(TCLSTUBLIB) libtclzip
-!if $(TCL_EMBED_SCRIPTS)
-!if $(STATIC_BUILD)
- @copy /y /b "$(TCLSH)"+"$(TCLSCRIPTZIP)" "$(TCLSH)"
-!else
- @copy /y /b "$(TCLLIB)"+"$(TCLSCRIPTZIP)" "$(TCLLIB)"
+release: setup libtclzip core dlls shell pkgs
+all: setup libtclzip core dlls shell pkgs
+
+core: setup $(TCLLIB)
+!if $(TCL_EMBED_SCRIPTS) && !$(STATIC_BUILD)
+core: libtclzip
+ @$(COPY) /b "$(TCLLIBRAW)"+"$(TCLSCRIPTZIP)" "$(TCLLIB)"
!endif
+
+shell: setup core $(TCLSH)
+!if $(TCL_EMBED_SCRIPTS) && $(STATIC_BUILD)
+shell: libtclzip
+ @$(COPY) /b "$(TCLSHRAW)"+"$(TCLSCRIPTZIP)" "$(TCLSH)"
+!endif
+
+dlls: setup $(TCLREGLIB) $(TCLDDELIB) $(OUT_DIR)\zlib1.dll $(OUT_DIR)\libtommath.dll
+libtclzip: $(TCLSCRIPTZIP)
+
+tcltest: setup core $(TCLTEST) dlls
+!if $(TCL_EMBED_SCRIPTS) && $(STATIC_BUILD)
+tcltest: libtclzip
+ @$(COPY) /b "$(TCLTESTRAW)"+"$(TCLSCRIPTZIP)" "$(TCLTEST)"
!endif
-tcltest: setup $(TCLTEST) dlls
install: install-binaries install-libraries install-docs install-pkgs
!if $(SYMBOLS)
install: install-pdbs
@@ -496,19 +543,19 @@ install: install-pdbs setup: default-setup
test: test-core test-pkgs
-test-core: setup $(TCLTEST) dlls
- set TCL_LIBRARY=$(ROOT:\=/)/library
+test-core: tcltest
+ set TCL_LIBRARY=$(TCL_TEST_LIBRARY)
$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
- package ifneeded dde 1.4.4 [list load "$(TCLDDELIB:\=/)"]
- package ifneeded registry 1.3.6 [list load "$(TCLREGLIB:\=/)"]
+ package ifneeded dde 1.4.5 [list load "$(TCLDDELIB:\=/)"]
+ package ifneeded registry 1.3.7 [list load "$(TCLREGLIB:\=/)"]
<<
runtest: setup $(TCLTEST) dlls
- set TCL_LIBRARY=$(ROOT:\=/)/library
+ set TCL_LIBRARY=$(TCL_TEST_LIBRARY)
$(DEBUGGER) $(TCLTEST) $(SCRIPT)
-runshell: setup $(TCLSH) dlls
- set TCL_LIBRARY=$(ROOT:\=/)/library
+runshell: setup core shell dlls
+ set TCL_LIBRARY=$(TCL_TEST_LIBRARY)
$(DEBUGGER) $(TCLSH) $(SCRIPT)
!if $(STATIC_BUILD)
@@ -525,6 +572,9 @@ $(TCLLIB): $(TCLOBJS) $**
<<
$(_VC_MANIFEST_EMBED_DLL)
+!if $(TCL_EMBED_SCRIPTS) && !$(STATIC_BUILD)
+ $(COPY) $@ $(TCLLIBRAW)
+!endif
$(TCLIMPLIB): $(TCLLIB)
@@ -535,11 +585,20 @@ $(TCLSTUBLIB): $(TCLSTUBOBJS) $(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
$(CONEXECMD) -stack:2300000 $**
+ copy $(TMP_DIR)\tclsh.exe.manifest $(TCLSH).manifest
$(_VC_MANIFEST_EMBED_EXE)
+!if $(TCL_EMBED_SCRIPTS) && $(STATIC_BUILD)
+ $(COPY) $@ $(TCLSHRAW)
+!endif
+
$(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
$(CONEXECMD) -stack:2300000 $**
+ copy $(TMP_DIR)\tclsh.exe.manifest $(TCLTEST).manifest
$(_VC_MANIFEST_EMBED_EXE)
+!if $(TCL_EMBED_SCRIPTS) && $(STATIC_BUILD)
+ $(COPY) $@ $(TCLTESTRAW)
+!endif
!if $(STATIC_BUILD)
$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
@@ -588,8 +647,9 @@ $(OUT_DIR)\tommath.lib: $(TOMMATHDIR)\win64\tommath.lib $(COPY) $(TOMMATHDIR)\win64\tommath.lib $(OUT_DIR)\tommath.lib
!endif
-$(TCLSCRIPTZIP): $(TCLDDELIB) $(TCLREGLIB)
- @echo Building Tcl library zip file
+$(TCLSCRIPTZIP): $(TCLLIB) $(TCLSH) dlls
+ @echo Building Tcl library zip file $(TCLSCRIPTZIP)
+ @set TCL_LIBRARY=$(ROOT:\=/)/library
@if exist "$(LIBTCLVFS)" $(RMDIR) "$(LIBTCLVFS)"
@$(MKDIR) "$(LIBTCLVFS)"
@$(CPYDIR) $(LIBDIR) "$(LIBTCLVFS)\tcl_library"
@@ -608,7 +668,6 @@ $(TCLSCRIPTZIP): $(TCLDDELIB) $(TCLREGLIB) @echo zipfs mkzip {$@} {$(LIBTCLVFS)} {$(LIBTCLVFS)} >> "$(OUT_DIR)\zipper.tcl"
@cd "$(OUT_DIR)" && $(TCLSH_NATIVE) zipper.tcl
-
pkgs:
@for /d %d in ($(PKGSDIR)\*) do \
@if exist "%~fd\win\makefile.vc" ( \
@@ -675,7 +734,7 @@ CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm htmlhelp: chmsetup $(CHMFILE)
$(CHMFILE): $(DOCDIR)\*
- @$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)"
+ @$(TCLSH) -encoding utf-8 $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)"
@echo Compiling HTML help project
-"$(HHC)" <<$(HHPFILE) >NUL
[OPTIONS]
@@ -743,7 +802,6 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in @LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug -debugtype:cv
@LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
@TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib
-@TCL_NEEDS_EXP_FILE@
@LIBS@ $(baselibs) $(PRJ_LIBS)
@prefix@ $(_INSTALLDIR)
@exec_prefix@ $(BIN_INSTALL_DIR)
@@ -755,17 +813,13 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in @STLIB_LD@ $(lib32) -nologo
@SHLIB_LD_LIBS@ $(baselibs) $(PRJ_LIBS)
@SHLIB_SUFFIX@ .dll
-@DL_LIBS@
@LDFLAGS@
-@TCL_CC_SEARCH_FLAGS@
-@TCL_LD_SEARCH_FLAGS@
@LIBOBJS@
@RANLIB@
-@TCL_LIB_FLAG@
-@TCL_BUILD_LIB_SPEC@
+@TCL_LIB_FLAG@ $(PROJECT)$(VERSION)$(SUFX).lib
+@TCL_BUILD_LIB_SPEC@ $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
@TCL_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
@TCL_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR)
-@TCL_LIB_VERSIONS_OK@
@TCL_SRC_DIR@ $(ROOT)
@TCL_PACKAGE_PATH@
@TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME)
@@ -774,7 +828,6 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in @TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
@TCL_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
-@CFG_TCL_EXPORT_FILE_SUFFIX@ $(VERSION)$(SUFX).lib
@CFG_TCL_SHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).dll
@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
!if $(STATIC_BUILD)
@@ -782,6 +835,8 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in !else
@TCL_SHARED_BUILD@ 1
!endif
+@TCL_ZLIB_LIB_NAME@ zdll.lib
+@TCL_TOMMATH_LIB_NAME@ tommath.lib
<<
@@ -828,6 +883,9 @@ $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
$(cc32) $(appcflags) -Fo$@ $?
+$(TMP_DIR)\tclTestABSList.obj: $(GENERICDIR)\tclTestABSList.c
+ $(cc32) $(appcflags) -Fo$@ $?
+
$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
$(CCAPPCMD) $?
@@ -874,11 +932,11 @@ $(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c ### The following objects should be built using the stub interfaces
$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c
- $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?
$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
- $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?
### The following objects are part of the stub library and should not
@@ -888,6 +946,15 @@ $(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
$(cc32) $(stubscflags) -Fo$@ $?
+$(TMP_DIR)\tclStubCall.obj: $(GENERICDIR)\tclStubCall.c
+ $(cc32) $(stubscflags) \
+ /DCFG_RUNTIME_DLLFILE="\"$(TCLLIBNAME)\"" \
+ /DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ $(TCL_INCLUDES) -Fo$@ $?
+
+$(TMP_DIR)\tclStubLibTbl.obj: $(GENERICDIR)\tclStubLibTbl.c
+ $(cc32) $(stubscflags) $(TCL_INCLUDES) -Fo$@ $?
+
$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
$(cc32) $(stubscflags) -Fo$@ $?
@@ -956,6 +1023,7 @@ $< $(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tclsh.rc
+$(TMP_DIR)\tcltest.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tcltest.rc
#---------------------------------------------------------------------
# Installation.
@@ -970,6 +1038,10 @@ install-binaries: @$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
@$(CPY) "$(OUT_DIR)\zlib1.dll" "$(BIN_INSTALL_DIR)\"
@$(CPY) "$(OUT_DIR)\libtommath.dll" "$(BIN_INSTALL_DIR)\"
+!if !$(STATIC_BUILD)
+ @$(CPY) "$(OUT_DIR)\zdll.lib" "$(LIB_INSTALL_DIR)\"
+ @$(CPY) "$(OUT_DIR)\tommath.lib" "$(LIB_INSTALL_DIR)\"
+!endif
!if exist($(TCLSH))
@echo Installing $(TCLSHNAME)
@$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
@@ -1028,30 +1100,24 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @if not exist "$(MODULE_INSTALL_DIR)" \
$(MKDIR) "$(MODULE_INSTALL_DIR)"
@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.6" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.6"
+ @if not exist "$(MODULE_INSTALL_DIR)\9.0" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0"
@$(COPY) "$(ROOT)\library\http\http.tcl" \
- "$(MODULE_INSTALL_DIR)\8.6\http-$(PKG_HTTP_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\http-$(PKG_HTTP_VER).tm"
@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.7" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.7"
@$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
- "$(MODULE_INSTALL_DIR)\8.7\msgcat-$(PKG_MSGCAT_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\msgcat-$(PKG_MSGCAT_VER).tm"
@echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.5" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.5"
@$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
- "$(MODULE_INSTALL_DIR)\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\tcltest-$(PKG_TCLTEST_VER).tm"
@echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.4" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4"
- @if not exist "$(MODULE_INSTALL_DIR)\8.4\platform" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4\platform"
+ @if not exist "$(MODULE_INSTALL_DIR)\9.0\platform" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0\platform"
@$(COPY) "$(ROOT)\library\platform\platform.tcl" \
- "$(MODULE_INSTALL_DIR)\8.4\platform-$(PKG_PLATFORM_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\platform-$(PKG_PLATFORM_VER).tm"
@echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\platform\shell.tcl" \
- "$(MODULE_INSTALL_DIR)\8.4\platform\shell-$(PKG_SHELL_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\platform\shell-$(PKG_SHELL_VER).tm"
!endif
@echo Installing $(TCLDDELIBNAME)
!if !$(STATIC_BUILD)
diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 71d727f..b0799f8 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -4,8 +4,8 @@ * * This is used to fix limitations within nmake and the environment. * - * Copyright (c) 2002 by David Gravereaux. - * Copyright (c) 2006 by Pat Thoyts + * Copyright (c) 2002 David Gravereaux. + * Copyright (c) 2006 Pat Thoyts * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -19,10 +19,18 @@ #pragma comment (lib, "kernel32.lib") #endif #include <stdio.h> -#include <math.h> + +/* + * This library is required for x64 builds with _some_ versions of MSVC + */ +#if defined(_M_IA64) || defined(_M_AMD64) +#if _MSC_VER >= 1400 && _MSC_VER < 1500 +#pragma comment(lib, "bufferoverflowU") +#endif +#endif /* ISO hack for dumb VC++ */ -#ifdef _MSC_VER +#if defined(_WIN32) && defined(_MSC_VER) && _MSC_VER < 1900 #define snprintf _snprintf #endif @@ -198,25 +206,25 @@ CheckForCompilerFeature( hProcess = GetCurrentProcess(); - ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); - ZeroMemory(&si, sizeof(STARTUPINFO)); + memset(&pi, 0, sizeof(PROCESS_INFORMATION)); + memset(&si, 0, sizeof(STARTUPINFO)); si.cb = sizeof(STARTUPINFO); si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = INVALID_HANDLE_VALUE; - ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); + memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES)); sa.nLength = sizeof(SECURITY_ATTRIBUTES); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = FALSE; /* - * Create a non-inheritible pipe. + * Create a non-inheritable pipe. */ CreatePipe(&Out.pipe, &h, &sa, 0); /* - * Dupe the write side, make it inheritible, and close the original. + * Dupe the write side, make it inheritable, and close the original. */ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, @@ -263,7 +271,7 @@ CheckForCompilerFeature( if (!ok) { DWORD err = GetLastError(); int chars = snprintf(msg, sizeof(msg) - 1, - "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + "Tried to launch: \"%s\", but got error [%lu]: ", cmdline, err); FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars], @@ -334,13 +342,13 @@ CheckForLinkerFeature( hProcess = GetCurrentProcess(); - ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); - ZeroMemory(&si, sizeof(STARTUPINFO)); + memset(&pi, 0, sizeof(PROCESS_INFORMATION)); + memset(&si, 0, sizeof(STARTUPINFO)); si.cb = sizeof(STARTUPINFO); si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = INVALID_HANDLE_VALUE; - ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); + memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES)); sa.nLength = sizeof(SECURITY_ATTRIBUTES); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = TRUE; @@ -352,7 +360,7 @@ CheckForLinkerFeature( CreatePipe(&Out.pipe, &h, &sa, 0); /* - * Dupe the write side, make it inheritible, and close the original. + * Dupe the write side, make it inheritable, and close the original. */ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, @@ -397,7 +405,7 @@ CheckForLinkerFeature( if (!ok) { DWORD err = GetLastError(); int chars = snprintf(msg, sizeof(msg) - 1, - "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + "Tried to launch: \"%s\", but got error [%lu]: ", cmdline, err); FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars], @@ -584,7 +592,7 @@ list_free(list_item_t **listPtrPtr) * SubstituteFile -- * As windows doesn't provide anything useful like sed and it's unreliable * to use the tclsh you are building against (consider x-platform builds - - * eg compiling AMD64 target from IX86) we provide a simple substitution + * e.g. compiling AMD64 target from IX86) we provide a simple substitution * option here to handle autoconf style substitutions. * The substitution file is whitespace and line delimited. The file should * consist of lines matching the regular expression: @@ -610,7 +618,7 @@ SubstituteFile( if (fp != NULL) { /* - * Build a list of substutitions from the first filename + * Build a list of substitutions from the first filename */ sp = fopen(substitutions, "rt"); @@ -718,11 +726,13 @@ static int LocateDependencyHelper(const char *dir, const char *keypath) int keylen, ret; WIN32_FIND_DATA finfo; - if (dir == NULL || keypath == NULL) + if (dir == NULL || keypath == NULL) { return 2; /* Have no real error reporting mechanism into nmake */ + } dirlen = strlen(dir); - if ((dirlen + 3) > sizeof(path)) + if (dirlen > sizeof(path) - 3) { return 2; + } strncpy(path, dir, dirlen); strncpy(path+dirlen, "\\*", 3); /* Including terminating \0 */ keylen = strlen(keypath); @@ -788,8 +798,9 @@ static int LocateDependency(const char *keypath) for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) { ret = LocateDependencyHelper(paths[i], keypath); - if (ret == 0) + if (ret == 0) { return ret; + } } return ret; } diff --git a/win/rules.vc b/win/rules.vc index db65ce7..143ea9e 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -24,7 +24,7 @@ _RULES_VC = 1 # For modifications that are not backward-compatible, you *must* change
# the major version.
RULES_VERSION_MAJOR = 1
-RULES_VERSION_MINOR = 10
+RULES_VERSION_MINOR = 11
# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
@@ -79,10 +79,11 @@ NEED_TK_SOURCE = 0 # 3. Determine the compiler and linker versions
# 4. Build the nmakehlp helper application
# 5. Determine the supported compiler options and features
-# 6. Parse the OPTS macro value for user-specified build configuration
-# 7. Parse the STATS macro value for statistics instrumentation
-# 8. Parse the CHECKS macro for additional compilation checks
-# 9. Extract Tcl, and possibly Tk, version numbers from the headers
+# 6. Extract Tcl, Tk, and possibly extensions, version numbers from the
+# headers
+# 7. Parse the OPTS macro value for user-specified build configuration
+# 8. Parse the STATS macro value for statistics instrumentation
+# 9. Parse the CHECKS macro for additional compilation checks
# 10. Based on this selected configuration, construct the output
# directory and file paths
# 11. Construct the paths where the package is to be installed
@@ -707,7 +708,7 @@ LINKERFLAGS = $(LINKERFLAGS) -ltcg !if defined(_TK_H)
!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
- && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]
+ && [nmakehlp -V $(_TK_H) "define TK_MAJOR_VERSION" >> versions.vc]
!endif
!if [echo TK_MINOR_VERSION = \>> versions.vc] \
&& [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
@@ -816,7 +817,6 @@ DOTSEPARATED=$(DOTSEPARATED:b=.) # configuration (ignored for Tcl itself)
# _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build
# (CRT library should support this, not needed for Tcl 9.x)
-# TCL_UTF_MAX=3 - forces a build using UTF-16 internally (not recommended).
# Further, LINKERFLAGS are modified based on above.
# Default values for all the above
@@ -877,16 +877,16 @@ TCL_THREADS = 0 USE_THREAD_ALLOC= 0
!endif
+!if [nmakehlp -f $(OPTS) "tcl8"]
+!message *** Build for Tcl8
+TCL_BUILD_FOR = 8
+!endif
+
!if $(TCL_MAJOR_VERSION) == 8
!if [nmakehlp -f $(OPTS) "time64bit"]
!message *** Force 64-bit time_t
_USE_64BIT_TIME_T = 1
!endif
-
-!if [nmakehlp -f $(OPTS) "utf16"]
-!message *** Force UTF-16 internally
-TCL_UTF_MAX = 3
-!endif
!endif
# Yes, it's weird that the "symbols" option controls DEBUG and
@@ -1094,7 +1094,7 @@ SUFX = $(SUFX:x=) !else
TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
EXT = lib
-!if !$(MSVCRT)
+!if $(MSVCRT) && $(TCL_VERSION) > 86 || !$(MSVCRT) && $(TCL_VERSION) < 87
TMP_DIRFULL = $(TMP_DIRFULL:X=)
SUFX = $(SUFX:x=)
!endif
@@ -1146,7 +1146,11 @@ TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
TCLSCRIPTZIP = $(OUT_DIR)\$(TCLSCRIPTZIPNAME)
+!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+!else
+TCLSTUBLIBNAME = $(STUBPREFIX).lib
+!endif
TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)"
@@ -1162,7 +1166,11 @@ TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
+!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
+!else
+TCLSTUBLIB = $(_TCLDIR)\lib\tclstub.lib
+!endif
TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
@@ -1182,7 +1190,11 @@ TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe !if !exist($(TCLSH))
TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
+!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
+!else
+TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub.lib
+!endif
TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
@@ -1198,7 +1210,11 @@ TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" !endif # TCLINSTALL
+!if !$(STATIC_BUILD) && "$(TCL_BUILD_FOR)" == "8"
+tcllibs = "$(TCLSTUBLIB)"
+!else
tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"
+!endif
!endif # $(DOING_TCL)
@@ -1218,14 +1234,18 @@ WISHNAMEPREFIX = wish WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
TKLIBNAME8 = tk$(TK_VERSION)$(SUFX).$(EXT)
TKLIBNAME9 = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
-!if $(TCL_MAJOR_VERSION) == 8
+!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
TKLIBNAME = tk$(TK_VERSION)$(SUFX).$(EXT)
TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib
!else
TKLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
TKIMPLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).lib
!endif
+!if $(TK_MAJOR_VERSION) == 8
TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
+!else
+TKSTUBLIBNAME = tkstub.lib
+!endif
!if $(DOING_TK)
WISH = $(OUT_DIR)\$(WISHNAME)
@@ -1275,14 +1295,18 @@ tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)" PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
PRJLIBNAME8 = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
PRJLIBNAME9 = tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT)
-!if $(TCL_MAJOR_VERSION) == 8
+!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
PRJLIBNAME = $(PRJLIBNAME8)
!else
PRJLIBNAME = $(PRJLIBNAME9)
!endif
PRJLIB = $(OUT_DIR)\$(PRJLIBNAME)
+!if $(TCL_MAJOR_VERSION) == 8
PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+!else
+PRJSTUBLIBNAME = $(STUBPREFIX).lib
+!endif
PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME)
# If extension parent makefile has not defined a resource definition file,
@@ -1344,7 +1368,7 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\..\include # and switches are specific to it.
# The following macros are defined, names are for historical compatibility:
# OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS
-# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration opttions
+# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration options
# crt - Compiler switch that selects the appropriate C runtime
# cdebug - Compiler switches related to debug AND optimizations
# cwarn - Compiler switches that set warning levels
@@ -1418,7 +1442,7 @@ OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1
!endif
-!if "$(TCL_MAJOR_VERSION)" == "8"
+!if $(TCL_MAJOR_VERSION) == 8
!if "$(_USE_64BIT_TIME_T)" == "1"
OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
!endif
@@ -1426,8 +1450,8 @@ OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1 # _ATL_XP_TARGETING - Newer SDK's need this to build for XP
COMPILERFLAGS = /D_ATL_XP_TARGETING
!endif
-!if "$(TCL_UTF_MAX)" == "3"
-OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=3
+!if "$(TCL_BUILD_FOR)" == "8"
+OPTDEFINES = $(OPTDEFINES) /DTCL_MAJOR_VERSION=8
!endif
# Like the TEA system only set this non empty for non-Tk extensions
@@ -1511,6 +1535,10 @@ INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WIN_DIR)" -I"$(COMPATDIR)" # cflags contains generic flags used for building practically all object files
cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\ $(cdebug)
+!if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7
+cflags = $(cflags) -DTcl_Size=int
+!endif
+
# appcflags contains $(cflags) and flags for building the application
# object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus
# flags used for building shared object files The two differ in the
@@ -1597,7 +1625,7 @@ DLLCMD = $(link32) $(dlllflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
- $(TCL_INCLUDES) \
+ $(TCL_INCLUDES) /DSTATIC_BUILD=$(STATIC_BUILD) \
/DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
/DCOMMAVERSION=$(RCCOMMAVERSION) \
/DDOTVERSION=\"$(DOTVERSION)\" \
diff --git a/win/tcl.dsp b/win/tcl.dsp index cc9d173..a5e4a63 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -36,7 +36,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Release\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh87.exe"
+# PROP BASE Target_File "Release\tclsh90.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -45,7 +45,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Release\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Release\tclsh87t.exe"
+# PROP Target_File "Release\tclsh90t.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -57,7 +57,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh87g.exe"
+# PROP BASE Target_File "Debug\tclsh90g.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -66,7 +66,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Debug\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Debug\tclsh87tg.exe"
+# PROP Target_File "Debug\tclsh90tg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -78,7 +78,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh87sg.exe"
+# PROP BASE Target_File "Debug\tclsh90sg.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -87,7 +87,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Debug\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Debug\tclsh87sg.exe"
+# PROP Target_File "Debug\tclsh90sg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -99,7 +99,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Release\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh87s.exe"
+# PROP BASE Target_File "Release\tclsh90s.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -108,7 +108,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Release\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Release\tclsh87s.exe"
+# PROP Target_File "Release\tclsh90s.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -136,14 +136,6 @@ CFG=tcl - Win32 Debug Static # PROP Default_Filter ""
# Begin Source File
-SOURCE=..\compat\dirent.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\dirent2.h
-# End Source File
-# Begin Source File
-
SOURCE=..\compat\dlfcn.h
# End Source File
# Begin Source File
@@ -156,48 +148,12 @@ SOURCE=..\compat\limits.h # End Source File
# Begin Source File
-SOURCE=..\compat\memcmp.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\opendir.c
-# End Source File
-# Begin Source File
-
SOURCE=..\compat\README
# End Source File
# Begin Source File
-SOURCE=..\compat\stdlib.h
-# End Source File
-# Begin Source File
-
SOURCE=..\compat\string.h
# End Source File
-# Begin Source File
-
-SOURCE=..\compat\strncasecmp.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\strstr.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\strtol.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\strtoul.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\tclErrno.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\waitpid.c
-# End Source File
# End Group
# Begin Group "doc"
@@ -276,10 +232,6 @@ SOURCE=..\doc\CallDel.3 # End Source File
# Begin Source File
-SOURCE=..\doc\case.n
-# End Source File
-# Begin Source File
-
SOURCE=..\doc\catch.n
# End Source File
# Begin Source File
@@ -760,7 +712,7 @@ SOURCE=..\doc\safe.n # End Source File
# Begin Source File
-SOURCE=..\doc\SaveResult.3
+SOURCE=..\doc\SaveInterpState.3
# End Source File
# Begin Source File
@@ -1288,6 +1240,14 @@ SOURCE=..\generic\tclStubLib.c # End Source File
# Begin Source File
+SOURCE=..\generic\tclStubCall.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclStubLibTbl.c
+# End Source File
+# Begin Source File
+
SOURCE=..\generic\tclOOStubLib.c
# End Source File
# Begin Source File
@@ -938,30 +938,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION]) fi - # Check to see if winnt.h defines CHAR, SHORT, and LONG - # even if VOID has already been #defined. The win32api - # used by mingw and cygwin is known to do this. - - AC_CACHE_CHECK(for winnt.h that ignores VOID define, - tcl_cv_winnt_ignore_void, - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ - #define VOID void - #define WIN32_LEAN_AND_MEAN - #include <windows.h> - #undef WIN32_LEAN_AND_MEAN - ]], [[ - CHAR c; - SHORT s; - LONG l; - ]])], - [tcl_cv_winnt_ignore_void=yes], - [tcl_cv_winnt_ignore_void=no]) - ) - if test "$tcl_cv_winnt_ignore_void" = "yes" ; then - AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1, - [Defined when cygwin/mingw ignores VOID define in winnt.h]) - fi - AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have <stdbool.h>?])],) # See if the compiler supports casting to a union type. @@ -1009,13 +985,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ #------------------------------------------------------------------------ AC_DEFUN([SC_WITH_TCL], [ - if test -d ../../tcl8.7$1/win; then - TCL_BIN_DEFAULT=../../tcl8.7$1/win + if test -d ../../tcl9.0$1/win; then + TCL_BIN_DEFAULT=../../tcl9.0$1/win else - TCL_BIN_DEFAULT=../../tcl8.7/win + TCL_BIN_DEFAULT=../../tcl9.0/win fi - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.7 binaries from DIR], + AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 9.0 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) @@ -1044,7 +1020,7 @@ AC_DEFUN([SC_WITH_TCL], [ # none # # Results -# Subst's the following values: +# Substitutes the following values: # TCLSH_PROG #------------------------------------------------------------------------ @@ -1090,7 +1066,7 @@ AC_DEFUN([SC_PROG_TCLSH], [ # none # # Results -# Subst's the following values: +# Substitutes the following values: # BUILD_TCLSH #------------------------------------------------------------------------ @@ -37,9 +37,8 @@ BEGIN BEGIN VALUE "FileDescription", "Tcl DLL\0" VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".dll\0" - VALUE "CompanyName", "ActiveState Corporation\0" VALUE "FileVersion", TCL_PATCH_LEVEL - VALUE "LegalCopyright", "Copyright \251 2001 by ActiveState Corporation, et al\0" + VALUE "LegalCopyright", "Copyright \251 1987-2022 Regents of the University of California and other parties\0" VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" VALUE "ProductVersion", TCL_PATCH_LEVEL END diff --git a/win/tclAppInit.c b/win/tclAppInit.c index be70492..8fad88a 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -15,17 +15,14 @@ */ #include "tcl.h" -#define WIN32_LEAN_AND_MEAN -#define STRICT /* See MSDN Article Q83456 */ -#include <windows.h> -#undef STRICT -#undef WIN32_LEAN_AND_MEAN -#include <locale.h> -#include <stdlib.h> -#include <tchar.h> -#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 +#if TCL_MAJOR_VERSION < 9 +# if defined(USE_TCL_STUBS) +# error "Don't build with USE_TCL_STUBS!" +# endif +# if TCL_MINOR_VERSION < 7 # define Tcl_LibraryInitProc Tcl_PackageInitProc # define Tcl_StaticLibrary Tcl_StaticPackage +# endif #endif #ifdef TCL_TEST @@ -39,6 +36,14 @@ extern Tcl_LibraryInitProc Dde_Init; extern Tcl_LibraryInitProc Dde_SafeInit; #endif +#define WIN32_LEAN_AND_MEAN +#define STRICT /* See MSDN Article Q83456 */ +#include <windows.h> +#undef STRICT +#undef WIN32_LEAN_AND_MEAN +#include <locale.h> +#include <stdlib.h> +#include <tchar.h> #if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS) int _CRT_glob = 0; #endif /* __GNUC__ || TCL_BROKEN_MAINARGS */ @@ -163,7 +168,7 @@ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { - if ((Tcl_Init)(interp) == TCL_ERROR) { + if (Tcl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } @@ -199,7 +204,7 @@ Tcl_AppInit( */ /* - * Call Tcl_CreateCommand for application-specific commands, if they + * Call Tcl_CreateObjCommand for application-specific commands, if they * weren't already created by the init procedures called above. */ @@ -210,8 +215,11 @@ Tcl_AppInit( * user-specific startup file will be run under any conditions. */ - (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, - Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY); + (void)Tcl_EvalEx(interp, + "set tcl_rcFileName [file tildeexpand ~/tclshrc.tcl]", + -1, + TCL_EVAL_GLOBAL); + return TCL_OK; } @@ -272,11 +280,10 @@ setargv( } } - /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ + /* Make sure we don't call Tcl_Alloc through the (not yet initialized) stub table */ # undef Tcl_Alloc -# undef Tcl_DbCkalloc - argSpace = (TCHAR *)ckalloc(size * sizeof(char *) + argSpace = (TCHAR *)Tcl_Alloc(size * sizeof(char *) + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); argv = (TCHAR **) argSpace; argSpace += size * (sizeof(char *)/sizeof(TCHAR)); diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in index 776dcb0..c980af6 100644 --- a/win/tclConfig.sh.in +++ b/win/tclConfig.sh.in @@ -23,11 +23,6 @@ TCL_CC='@CC@' # -D flags for use with the C compiler. TCL_DEFS='@DEFS@' -# TCL_DBGX used to be used to distinguish debug vs. non-debug builds. -# This was a righteous pain so the core doesn't do that any more. -# DEPRECATED, will be removed in Tcl 9! -TCL_DBGX='' - # Default flags used in an optimized and debuggable build, respectively. TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@' TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@' @@ -46,13 +41,7 @@ TCL_LIB_FILE='@TCL_LIB_FILE@' TCL_ZIP_FILE='@TCL_ZIP_FILE@' # Flag to indicate whether shared libraries need export files. -TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@ - -# String that can be evaluated to generate the part of the export file -# name that comes after the "libxxx" (includes version number, if any, -# extension, and anything else needed). May depend on the variables -# VERSION. On most UNIX systems this is ${VERSION}.exp. -TCL_EXPORT_FILE_SUFFIX='@CFG_TCL_EXPORT_FILE_SUFFIX@' +TCL_NEEDS_EXP_FILE='' # Additional libraries to use when linking Tcl. TCL_LIBS='@LIBS@' @@ -90,7 +79,7 @@ TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@' # Library file(s) to include in tclsh and other base applications # in order to provide facilities needed by DLOBJ above. -TCL_DL_LIBS='@DL_LIBS@' +TCL_DL_LIBS='' # Flags to pass to the compiler when linking object files into # an executable tclsh or tcltest binary. @@ -100,8 +89,8 @@ TCL_LD_FLAGS='@LDFLAGS@' # run-time dynamic linker where to look for shared libraries such as # libtcl.so. Used when linking applications. Only works if there # is a variable "LIB_RUNTIME_DIR" defined in the Makefile. -TCL_CC_SEARCH_FLAGS='@TCL_CC_SEARCH_FLAGS@' -TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@' +TCL_CC_SEARCH_FLAGS='' +TCL_LD_SEARCH_FLAGS='' # Additional object files linked with Tcl to provide compatibility # with standard facilities from ANSI C or POSIX. @@ -129,7 +118,7 @@ TCL_INCLUDE_SPEC='@TCL_INCLUDE_SPEC@' # ("ok" means it's safe to use switches like -ltcl7.5; "nodots" means # use switches like -ltcl75). SunOS and FreeBSD require "nodots", for # example. -TCL_LIB_VERSIONS_OK='@TCL_LIB_VERSIONS_OK@' +TCL_LIB_VERSIONS_OK='nodots' # String that can be evaluated to generate the part of a shared library # name that comes after the "libxxx" (includes version number, if any, @@ -179,3 +168,9 @@ TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@' # Path to the Tcl stub library in the install directory. TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@' + +# Name of the zlib library that extensions should use +TCL_ZLIB_LIB_NAME='@TCL_ZLIB_LIB_NAME@' + +# Name of the tommath library that extensions should use +TCL_TOMMATH_LIB_NAME='@TCL_TOMMATH_LIB_NAME@' diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 0e86611..01fa6c3 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -144,7 +144,7 @@ DllMain( *---------------------------------------------------------------------- */ -HINSTANCE +void * TclWinGetTclInstance(void) { return hInstance; @@ -247,8 +247,8 @@ TclWinEncodingsCleanup(void) dlIter = driveLetterLookup; while (dlIter != NULL) { dlIter2 = dlIter->nextPtr; - ckfree(dlIter->volumeName); - ckfree(dlIter); + Tcl_Free(dlIter->volumeName); + Tcl_Free(dlIter); dlIter = dlIter2; } Tcl_MutexUnlock(&mountPointMap); @@ -341,8 +341,8 @@ TclWinDriveLetterForVolMountPoint( * Now dlPtr2 points to the structure to free. */ - ckfree(dlPtr2->volumeName); - ckfree(dlPtr2); + Tcl_Free(dlPtr2->volumeName); + Tcl_Free(dlPtr2); /* * Restart the loop - we could try to be clever and continue half @@ -377,9 +377,9 @@ TclWinDriveLetterForVolMountPoint( } } if (!alreadyStored) { - dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); + dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap)); dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target); - dlPtr2->driveLetter = (char) drive[0]; + dlPtr2->driveLetter = (WCHAR) drive[0]; dlPtr2->nextPtr = driveLetterLookup; driveLetterLookup = dlPtr2; } @@ -403,9 +403,9 @@ TclWinDriveLetterForVolMountPoint( * that fact and store '-1' so we don't have to look it up each time. */ - dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); + dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap)); dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint); - dlPtr2->driveLetter = -1; + dlPtr2->driveLetter = (WCHAR)-1; dlPtr2->nextPtr = driveLetterLookup; driveLetterLookup = dlPtr2; Tcl_MutexUnlock(&mountPointMap); @@ -413,76 +413,6 @@ TclWinDriveLetterForVolMountPoint( } /* - *--------------------------------------------------------------------------- - * - * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf -- - * - * Convert between UTF-8 and Unicode when running Windows. - * - * On Mac and Unix, all strings exchanged between Tcl and the OS are - * "char" oriented. We need only one Tcl_Encoding to convert between - * UTF-8 and the system's native encoding. We use NULL to represent - * that encoding. - * - * On Windows, some strings exchanged between Tcl and the OS are "char" - * oriented, while others are in Unicode. We need two Tcl_Encoding APIs - * depending on whether we are targeting a "char" or Unicode interface. - * - * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding - * of NULL should always used to convert between UTF-8 and the system's - * "char" oriented encoding. The following two functions are used in - * Windows-specific code to convert between UTF-8 and Unicode strings. - * This saves you the trouble of writing the - * following type of fragment over and over: - * - * encoding <- Tcl_GetEncoding("unicode"); - * nativeBuffer <- UtfToExternal(encoding, utfBuffer); - * Tcl_FreeEncoding(encoding); - * - * By convention, in Windows a WCHAR is a Unicode character. If you plan - * on targeting a Unicode interface when running on Windows, these - * functions should be used. If you plan on targetting a "char" oriented - * function on Windows, use Tcl_UtfToExternal() with an encoding of NULL. - * - * Results: - * The result is a pointer to the string in the desired target encoding. - * Storage for the result string is allocated in dsPtr; the caller must - * call Tcl_DStringFree() when the result is no longer needed. - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#undef Tcl_WinUtfToTChar -TCHAR * -Tcl_WinUtfToTChar( - const char *string, /* Source string in UTF-8. */ - int len, /* Source string length in bytes, or -1 for - * strlen(). */ - Tcl_DString *dsPtr) /* Uninitialized or free DString in which the - * converted string is stored. */ -{ - Tcl_DStringInit(dsPtr); - return (TCHAR *)Tcl_UtfToWCharDString(string, len, dsPtr); -} -#undef Tcl_WinTCharToUtf -char * -Tcl_WinTCharToUtf( - const TCHAR *string, /* Source string in Unicode. */ - int len, /* Source string length in bytes, or -1 for - * platform-specific string length. */ - Tcl_DString *dsPtr) /* Uninitialized or free DString in which the - * converted string is stored. */ -{ - Tcl_DStringInit(dsPtr); - return Tcl_WCharToUtfDString((WCHAR *)string, len >> 1, dsPtr); -} -#endif /* !defined(TCL_NO_DEPRECATED) */ - -/* *------------------------------------------------------------------------ * * TclWinCPUID -- diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 62991fc..5f03138 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -72,33 +72,34 @@ typedef struct { * Static routines for this file: */ -static int FileBlockProc(ClientData instanceData, int mode); -static void FileChannelExitHandler(ClientData clientData); -static void FileCheckProc(ClientData clientData, int flags); -static int FileCloseProc(ClientData instanceData, +static int FileBlockProc(void *instanceData, int mode); +static void FileChannelExitHandler(void *clientData); +static void FileCheckProc(void *clientData, int flags); +static int FileCloseProc(void *instanceData, Tcl_Interp *interp, int flags); static int FileEventProc(Tcl_Event *evPtr, int flags); -static int FileGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); +static int FileGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int FileGetOptionProc(void *instanceData, + Tcl_Interp *interp, const char *optionName, + Tcl_DString *dsPtr); static ThreadSpecificData *FileInit(void); -static int FileInputProc(ClientData instanceData, char *buf, +static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int FileOutputProc(ClientData instanceData, +static int FileOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -#ifndef TCL_NO_DEPRECATED -static int FileSeekProc(ClientData instanceData, long offset, - int mode, int *errorCode); -#endif -static long long FileWideSeekProc(ClientData instanceData, +static long long FileWideSeekProc(void *instanceData, long long offset, int mode, int *errorCode); -static void FileSetupProc(ClientData clientData, int flags); -static void FileWatchProc(ClientData instanceData, int mask); -static void FileThreadActionProc(ClientData instanceData, +static void FileSetupProc(void *clientData, int flags); +static void FileWatchProc(void *instanceData, int mask); +static void FileThreadActionProc(void *instanceData, int action); -static int FileTruncateProc(ClientData instanceData, +static int FileTruncateProc(void *instanceData, long long length); static DWORD FileGetType(HANDLE handle); static int NativeIsComPort(const WCHAR *nativeName); +static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, + int permissions, int appendMode); /* * This structure describes the channel type structure for file based IO. @@ -107,16 +108,12 @@ static int NativeIsComPort(const WCHAR *nativeName); static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ -#ifndef TCL_NO_DEPRECATED - FileSeekProc, /* Seek proc. */ -#else NULL, -#endif NULL, /* Set option proc. */ - NULL, /* Get option proc. */ + FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ FileGetHandleProc, /* Get an OS handle from channel. */ FileCloseProc, /* close2proc. */ @@ -135,6 +132,42 @@ static const Tcl_ChannelType fileChannelType = { #define SET_FLAG(var, flag) ((var) |= (flag)) #define CLEAR_FLAG(var, flag) ((var) &= ~(flag)) #define TEST_FLAG(value, flag) (((value) & (flag)) != 0) + +/* + * The number of 100-ns intervals between the Windows system epoch (1601-01-01 + * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01). + */ + +#define POSIX_EPOCH_AS_FILETIME \ + ((long long) 116444736 * (long long) 1000000000) + + +/* + *---------------------------------------------------------------------- + * + * TclWinGenerateChannelName -- + * + * This function generates names for channels. + * + * Results: + * None. + * + * Side effects: + * Creates a new window and creates an exit handler. + * + *---------------------------------------------------------------------- + */ +void +TclWinGenerateChannelName( + char channelName[], /* Buffer to accept the name. */ + const char *channelTypeName,/* Name of type of channel. */ + void *channelImpl) /* Pointer to channel implementation + * structure, used to generate a unique + * ID. */ +{ + snprintf(channelName, 16 + TCL_INTEGER_SPACE, "%s%" TCL_Z_MODIFIER "x", + channelTypeName, (size_t) channelImpl); +} /* *---------------------------------------------------------------------- @@ -186,7 +219,7 @@ FileInit(void) static void FileChannelExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL); } @@ -210,7 +243,7 @@ FileChannelExitHandler( void FileSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileInfo *infoPtr; @@ -253,7 +286,7 @@ FileSetupProc( static void FileCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileEvent *evPtr; @@ -273,7 +306,7 @@ FileCheckProc( infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) { SET_FLAG(infoPtr->flags, FILE_PENDING); - evPtr = (FileEvent *)ckalloc(sizeof(FileEvent)); + evPtr = (FileEvent *)Tcl_Alloc(sizeof(FileEvent)); evPtr->header.proc = FileEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -352,7 +385,7 @@ FileEventProc( static int FileBlockProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -391,7 +424,7 @@ FileBlockProc( static int FileCloseProc( - ClientData instanceData, /* Pointer to FileInfo structure. */ + void *instanceData, /* Pointer to FileInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -445,92 +478,13 @@ FileCloseProc( break; } } - ckfree(fileInfoPtr); + Tcl_Free(fileInfoPtr); return errorCode; } /* *---------------------------------------------------------------------- * - * FileSeekProc -- - * - * Seeks on a file-based channel. Returns the new position. - * - * Results: - * -1 if failed, the new position if successful. If failed, it also sets - * *errorCodePtr to the error code. - * - * Side effects: - * Moves the location at which the channel will be accessed in future - * operations. - * - *---------------------------------------------------------------------- - */ -#ifndef TCL_NO_DEPRECATED -static int -FileSeekProc( - ClientData instanceData, /* File state. */ - long offset, /* Offset to seek to. */ - int mode, /* Relative to where should we seek? */ - int *errorCodePtr) /* To store error code. */ -{ - FileInfo *infoPtr = (FileInfo *)instanceData; - LONG newPos, newPosHigh, oldPos, oldPosHigh; - DWORD moveMethod; - - *errorCodePtr = 0; - if (mode == SEEK_SET) { - moveMethod = FILE_BEGIN; - } else if (mode == SEEK_CUR) { - moveMethod = FILE_CURRENT; - } else { - moveMethod = FILE_END; - } - - /* - * Save our current place in case we need to roll-back the seek. - */ - - oldPosHigh = 0; - oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT); - if (oldPos == (LONG) INVALID_SET_FILE_POINTER) { - DWORD winError = GetLastError(); - - if (winError != NO_ERROR) { - Tcl_WinConvertError(winError); - *errorCodePtr = errno; - return -1; - } - } - - newPosHigh = (offset < 0 ? -1 : 0); - newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod); - if (newPos == (LONG) INVALID_SET_FILE_POINTER) { - DWORD winError = GetLastError(); - - if (winError != NO_ERROR) { - Tcl_WinConvertError(winError); - *errorCodePtr = errno; - return -1; - } - } - - /* - * Check for expressability in our return type, and roll-back otherwise. - */ - - if (newPosHigh != 0) { - *errorCodePtr = EOVERFLOW; - SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN); - return -1; - } - return (int) newPos; -} -#endif - -/* - *---------------------------------------------------------------------- - * * FileWideSeekProc -- * * Seeks on a file-based channel. Returns the new position. @@ -548,7 +502,7 @@ FileSeekProc( static long long FileWideSeekProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ @@ -600,7 +554,7 @@ FileWideSeekProc( static int FileTruncateProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long long length) /* Length to truncate at. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -676,7 +630,7 @@ FileTruncateProc( static int FileInputProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ @@ -700,7 +654,7 @@ FileInputProc( if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead, (LPOVERLAPPED) NULL) != FALSE) { - return bytesRead; + return (int)bytesRead; } Tcl_WinConvertError(GetLastError()); @@ -731,7 +685,7 @@ FileInputProc( static int FileOutputProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -757,7 +711,7 @@ FileOutputProc( return -1; } infoPtr->dirty = 1; - return bytesWritten; + return (int)bytesWritten; } /* @@ -778,7 +732,7 @@ FileOutputProc( static void FileWatchProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ int mask) /* What events to watch for; OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -817,9 +771,9 @@ FileWatchProc( static int FileGetHandleProc( - ClientData instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -827,13 +781,202 @@ FileGetHandleProc( return TCL_ERROR; } - *handlePtr = (ClientData) infoPtr->handle; + *handlePtr = (void *) infoPtr->handle; return TCL_OK; } /* *---------------------------------------------------------------------- * + * FileGetOptionProc -- + * + * Gets an option associated with an open file. If the optionName arg is + * non-NULL, retrieves the value of that option. If the optionName arg is + * NULL, retrieves a list of alternating option names and values for the + * given channel. + * + * Results: + * A standard Tcl result. Also sets the supplied DString to the string + * value of the option(s) returned. Sets error message if needed + * (by calling Tcl_BadChannelOption). + * + *---------------------------------------------------------------------- + */ + +static inline ULONGLONG +CombineDwords( + DWORD hi, + DWORD lo) +{ + ULARGE_INTEGER converter; + + converter.LowPart = lo; + converter.HighPart = hi; + return converter.QuadPart; +} + +static inline void +StoreElementInDict( + Tcl_Obj *dictObj, + const char *name, + Tcl_Obj *valueObj) +{ + /* + * We assume that the dict is being built fresh and that there's never any + * duplicate keys. + */ + + Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1); + Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj); +} + +static inline time_t +ToCTime( + FILETIME fileTime) /* UTC time */ +{ + LARGE_INTEGER convertedTime; + + convertedTime.LowPart = fileTime.dwLowDateTime; + convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; + + return (time_t) ((convertedTime.QuadPart - + (long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000); +} + +static Tcl_Obj * +StatOpenFile( + FileInfo *infoPtr) +{ + DWORD attr; + int dev, nlink = 1; + unsigned short mode; + unsigned long long size, inode; + long long atime, ctime, mtime; + BY_HANDLE_FILE_INFORMATION data; + Tcl_Obj *dictObj; + + if (GetFileInformationByHandle(infoPtr->handle, &data) != TRUE) { + Tcl_SetErrno(ENOENT); + return NULL; + } + + atime = ToCTime(data.ftLastAccessTime); + mtime = ToCTime(data.ftLastWriteTime); + ctime = ToCTime(data.ftCreationTime); + attr = data.dwFileAttributes; + size = CombineDwords(data.nFileSizeHigh, data.nFileSizeLow); + nlink = data.nNumberOfLinks; + + /* + * Unfortunately our stat definition's inode field (unsigned short) will + * throw away most of the precision we have here, which means we can't + * rely on inode as a unique identifier of a file. We'd really like to do + * something like how we handle 'st_size'. + */ + + inode = CombineDwords(data.nFileIndexHigh, data.nFileIndexLow); + + dev = data.dwVolumeSerialNumber; + + /* + * Note that this code has no idea whether the file can be executed. + */ + + mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR|S_IEXEC : S_IFREG; + mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD|S_IWRITE; + mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3; + mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6; + + /* + * We don't construct a Tcl_StatBuf; we're using the info immediately. + */ + + TclNewObj(dictObj); +#define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value) + + STORE_ELEM("dev", Tcl_NewWideIntObj((long) dev)); + STORE_ELEM("ino", Tcl_NewWideIntObj((long long) inode)); + STORE_ELEM("nlink", Tcl_NewIntObj(nlink)); + STORE_ELEM("uid", Tcl_NewIntObj(0)); + STORE_ELEM("gid", Tcl_NewIntObj(0)); + STORE_ELEM("size", Tcl_NewWideIntObj((long long) size)); + STORE_ELEM("atime", Tcl_NewWideIntObj(atime)); + STORE_ELEM("mtime", Tcl_NewWideIntObj(mtime)); + STORE_ELEM("ctime", Tcl_NewWideIntObj(ctime)); + STORE_ELEM("mode", Tcl_NewWideIntObj(mode)); + + /* + * Windows only has files and directories, as far as we're concerned. + * Anything else and we definitely couldn't have got here anyway. + */ + if (attr & FILE_ATTRIBUTE_DIRECTORY) { + STORE_ELEM("type", Tcl_NewStringObj("directory", -1)); + } else { + STORE_ELEM("type", Tcl_NewStringObj("file", -1)); + } +#undef STORE_ELEM + + return dictObj; +} + +static int +FileGetOptionProc( + void *instanceData, /* The file state. */ + Tcl_Interp *interp, /* For error reporting. */ + const char *optionName, /* What option to read, or NULL for all. */ + Tcl_DString *dsPtr) /* Where to write the value read. */ +{ + FileInfo *infoPtr = (FileInfo *)instanceData; + int valid = 0; /* Flag if valid option parsed. */ + int len; + + if (optionName == NULL) { + len = 0; + valid = 1; + } else { + len = strlen(optionName); + } + + /* + * Get option -stat + * Option is readonly and returned by [fconfigure chan -stat] but not + * returned by [fconfigure chan] without explicit option name. + */ + + if ((len > 1) && (strncmp(optionName, "-stat", len) == 0)) { + Tcl_Obj *dictObj = StatOpenFile(infoPtr); + const char *dictContents; + Tcl_Size dictLength; + + if (dictObj == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read file channel status: %s", + Tcl_PosixError(interp))); + return TCL_ERROR; + } + + /* + * Transfer dictionary to the DString. Note that we don't do this as + * an element as this is an option that can't be retrieved with a + * general probe. + */ + + dictContents = Tcl_GetStringFromObj(dictObj, &dictLength); + Tcl_DStringAppend(dsPtr, dictContents, dictLength); + Tcl_DecrRefCount(dictObj); + return TCL_OK; + } + + if (valid) { + return TCL_OK; + } + return Tcl_BadChannelOption(interp, optionName, + "stat"); +} + +/* + *---------------------------------------------------------------------- + * * TclpOpenFileChannel -- * * Open an File based channel on Unix systems. @@ -937,7 +1080,7 @@ TclpOpenFileChannel( } /* - * For natively named Windows serial ports we are done. + * For natively-named Windows serial ports we are done. */ channel = TclWinOpenSerialChannel(handle, channelName, @@ -1035,7 +1178,7 @@ TclpOpenFileChannel( case FILE_TYPE_CHAR: case FILE_TYPE_DISK: case FILE_TYPE_UNKNOWN: - channel = TclWinOpenFileChannel(handle, channelName, + channel = OpenFileChannel(handle, channelName, channelPermissions, TEST_FLAG(mode, O_APPEND) ? FILE_APPEND : 0); break; @@ -1051,7 +1194,7 @@ TclpOpenFileChannel( "couldn't open \"%s\": bad file type", TclGetString(pathPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE", - NULL); + (void *)NULL); break; } @@ -1076,8 +1219,8 @@ TclpOpenFileChannel( Tcl_Channel Tcl_MakeFileChannel( - ClientData rawHandle, /* OS level handle */ - int mode) /* ORed combination of TCL_READABLE and + void *rawHandle, /* OS level handle */ + int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__) @@ -1090,7 +1233,7 @@ Tcl_MakeFileChannel( TclFile readFile = NULL, writeFile = NULL; BOOL result; - if (mode == 0) { + if ((mode & (TCL_READABLE|TCL_WRITABLE)) == 0) { return NULL; } @@ -1113,7 +1256,7 @@ Tcl_MakeFileChannel( case FILE_TYPE_DISK: case FILE_TYPE_CHAR: - channel = TclWinOpenFileChannel(handle, channelName, mode, 0); + channel = OpenFileChannel(handle, channelName, mode, 0); break; case FILE_TYPE_UNKNOWN: @@ -1247,7 +1390,7 @@ Tcl_MakeFileChannel( * is valid to something. */ - channel = TclWinOpenFileChannel(handle, channelName, mode, 0); + channel = OpenFileChannel(handle, channelName, mode, 0); } return channel; @@ -1325,9 +1468,8 @@ TclpGetDefaultStdChannel( */ if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK || - Tcl_SetChannelOption(NULL,channel,"-eofchar","\032 {}")!=TCL_OK || Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) { - Tcl_Close(NULL, channel); + Tcl_CloseEx(NULL, channel, 0); return (Tcl_Channel) NULL; } return channel; @@ -1336,7 +1478,7 @@ TclpGetDefaultStdChannel( /* *---------------------------------------------------------------------- * - * TclWinOpenFileChannel -- + * OpenFileChannel -- * * Constructs a File channel for the specified standard OS handle. This * is a helper function to break up the construction of channels into @@ -1353,7 +1495,7 @@ TclpGetDefaultStdChannel( */ Tcl_Channel -TclWinOpenFileChannel( +OpenFileChannel( HANDLE handle, /* Win32 HANDLE to swallow */ char *channelName, /* Buffer to receive channel name */ int permissions, /* OR'ed combination of TCL_READABLE, @@ -1373,11 +1515,12 @@ TclWinOpenFileChannel( for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->handle == (HANDLE) handle) { - return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL; + return ((permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION))==infoPtr->validMask) + ? infoPtr->channel : NULL; } } - infoPtr = (FileInfo *)ckalloc(sizeof(FileInfo)); + infoPtr = (FileInfo *)Tcl_Alloc(sizeof(FileInfo)); /* * TIP #218. Removed the code inserting the new structure into the global @@ -1386,13 +1529,12 @@ TclWinOpenFileChannel( */ infoPtr->nextPtr = NULL; - infoPtr->validMask = permissions; + infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION); infoPtr->watchMask = 0; infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; - sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); - + TclWinGenerateChannelName(channelName, "file", infoPtr); infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, infoPtr, permissions); @@ -1402,7 +1544,6 @@ TclWinOpenFileChannel( */ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); return infoPtr->channel; } @@ -1464,7 +1605,7 @@ TclWinFlushDirtyChannels(void) static void FileThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -1572,7 +1713,7 @@ NativeIsComPort( const WCHAR *nativePath) /* Path of file to access, native encoding. */ { const WCHAR *p = (const WCHAR *) nativePath; - int i, len = wcslen(p); + size_t i, len = wcslen(p); /* * 1. Look for com[1-9]:? diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index c3ba814..acd5851 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -2,123 +2,198 @@ * tclWinConsole.c -- * * This file implements the Windows-specific console functions, and the - * "console" channel driver. + * "console" channel driver. Windows 7 or later required. * - * Copyright © 1999 Scriptics Corp. + * Copyright © 2022 Ashok P. Nadkarni * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#ifdef TCL_CONSOLE_DEBUG +#undef NDEBUG /* Enable asserts */ +#endif + #include "tclWinInt.h" +#include <assert.h> +#include <ctype.h> /* - * The following variable is used to tell whether this module has been - * initialized. + * A general note on the design: The console channel driver differs from + * most other drivers in the following respects: + * + * - There can be at most 3 console handles at any time since Windows does + * support allocation of more than one console (with three handles + * corresponding to stdin, stdout, stderr) + * + * - Consoles are created / inherited at process startup. There is currently + * no way in Tcl to programmatically create a console. Even if these were + * added the above Windows limitation would still apply. + * + * - Unlike files, sockets etc. where there is a one-to-one + * correspondence between Tcl channels and operating system handles, + * std* channels are shared amongst threads which means there can be + * multiple Tcl channels corresponding to a single console handle. + * + * - Even with multiple threads, more than one file event handler is + * unlikely. It does not make sense for multiple threads to register + * handlers for stdin because the input would be randomly fragmented amongst + * the threads. + * + * Various design factors are driven by the above, e.g. use of lists instead + * of hash tables (at most 3 console handles) and use of global instead of + * per thread queues which simplifies lock management particularly because + * thread-console relation is not one-one and is likely more performant as + * well with fewer locks needing to be obtained. + * + * Some additional design notes/reminders for the future: + * + * Aligned, synchronous reads are done directly by interpreter thread. + * Unaligned or asynchronous reads are done through the reader thread. + * + * The reader thread does not read ahead. That is, it will not post a read + * until some interpreter thread is actually requesting a read. This is + * because an interpreter may (for example) turn off echo for passwords and + * the read ahead would come in the way of that. + * + * If multiple threads are reading from stdin, the input is sprayed in + * random fashion. This is not good application design and hence no plan to + * address this (not clear what should be done even in theory) + * + * For output, we do not restrict all output to the console writer threads. + * See ConsoleOutputProc for the conditions. + * + * Locks are never held when calling the ReadConsole/WriteConsole API's + * since they may block. */ -static int initialized = 0; +static int gInitialized = 0; /* - * The consoleMutex locks around access to the initialized variable, and it is - * used to protect background threads from being terminated while they are - * using APIs that hold locks. + * INPUT_BUFFER_SIZE is size of buffer passed to ReadConsole in bytes. + * Note that ReadConsole will only allow reading of line lengths up to the + * max of 256 and buffer size passed to it. So dropping this below 512 + * means user can type at most 256 chars. */ - -TCL_DECLARE_MUTEX(consoleMutex) +#ifndef INPUT_BUFFER_SIZE +#define INPUT_BUFFER_SIZE 8192 /* In bytes, so 4096 chars */ +#endif /* - * Bit masks used in the flags field of the ConsoleInfo structure below. + * CONSOLE_BUFFER_SIZE is size of storage used in ring buffers. + * In theory, at least sizeof(WCHAR) but note the Tcl channel bug + * https://core.tcl-lang.org/tcl/tktview/b3977d199b08e3979a8da970553d5209b3042e9c + * will cause failures in test suite if close to max input line in the suite. */ - -#define CONSOLE_PENDING (1<<0) /* Message is pending in the queue. */ -#define CONSOLE_ASYNC (1<<1) /* Channel is non-blocking. */ -#define CONSOLE_READ_OPS (1<<4) /* Channel supports read-related ops. */ -#define CONSOLE_RESET (1<<5) /* Console mode needs to be reset. */ +#ifndef CONSOLE_BUFFER_SIZE +#define CONSOLE_BUFFER_SIZE 8192 /* In bytes */ +#endif /* - * Bit masks used in the sharedFlags field of the ConsoleInfo structure below. + * Ring buffer for storing data. Actual data is from bufPtr[start]:bufPtr[size-1] + * and bufPtr[0]:bufPtr[length - (size-start)]. */ - -#define CONSOLE_EOF (1<<2) /* Console has reached EOF. */ -#define CONSOLE_BUFFERED (1<<3) /* Data was read into a buffer by the reader - * thread. */ - -#define CONSOLE_BUFFER_SIZE (8*1024) +typedef struct RingBuffer { + char *bufPtr; /* Pointer to buffer storage */ + Tcl_Size capacity; /* Size of the buffer in RingBufferChar */ + Tcl_Size start; /* Start of the data within the buffer. */ + Tcl_Size length; /* Number of RingBufferChar*/ +} RingBuffer; +#define RingBufferLength(ringPtr_) ((ringPtr_)->length) +#define RingBufferHasFreeSpace(ringPtr_) ((ringPtr_)->length < (ringPtr_)->capacity) +#define RINGBUFFER_ASSERT(ringPtr_) assert(RingBufferCheck(ringPtr_)) /* - * Structure containing handles associated with one of the special console - * threads. + * The Win32 console API does not support non-blocking I/O in any form. Thus + * the actual calls are made on a separate thread. Moreover, separate + * threads are needed for each handle because (for example) blocking on user + * input on stdin should not prevent output to stdout when non-blocking i/o + * is configured at the script level. + * + * In the input (e.g. stdin) case, the console stdin thread is the producer + * writing to the buffer ring buffer. The Tcl interpreter threads are the + * consumer. For the output (e.g. stdout/stderr) case, the Tcl interpreter + * are the producers while the console stdout/stderr threads are the + * consumers. + * + * Consoles are identified purely by handles and multiple threads may open + * them (as stdin/stdout/stderr are shared). + * + * Note on reference counting - a ConsoleHandleInfo instance has multiple + * references to it - one each from every channel that is attached to it + * plus one from the console thread itself which also serves as the reference + * from gConsoleHandleInfoList. */ - -typedef struct { - HANDLE thread; /* Handle to reader or writer thread. */ - HANDLE readyEvent; /* Manual-reset event to signal _to_ the main - * thread when the worker thread has finished - * waiting for its normal work to happen. */ - TclPipeThreadInfo *TI; /* Thread info structure of writer and reader. */ -} ConsoleThreadInfo; +typedef struct ConsoleHandleInfo { + struct ConsoleHandleInfo *nextPtr; /* Process-global list of consoles */ + HANDLE console; /* Console handle */ + HANDLE consoleThread; /* Handle to thread doing actual i/o on the console */ + SRWLOCK lock; /* Controls access to this structure. + * Cheaper than CRITICAL_SECTION but note does not + * support recursive locks or Try* style attempts.*/ + CONDITION_VARIABLE consoleThreadCV;/* For awakening console thread */ + CONDITION_VARIABLE interpThreadCV; /* For awakening interpthread(s) */ + RingBuffer buffer; /* Buffer for data transferred between console + * threads and Tcl threads. For input consoles, + * written by the console thread and read by Tcl + * threads. The converse for output threads */ + DWORD initMode; /* Initial console mode. */ + DWORD lastError; /* An error caused by the last background + * operation. Set to 0 if no error has been + * detected. */ + int numRefs; /* See comments above */ + int permissions; /* TCL_READABLE for input consoles, TCL_WRITABLE + * for output. Only one or the other can be set. */ + int flags; +#define CONSOLE_DATA_AWAITED 0x0001 /* An interpreter is awaiting data */ +} ConsoleHandleInfo; /* * This structure describes per-instance data for a console based channel. + * + * Note on locking - this structure has no locks because it is accessed + * only from the thread owning channel EXCEPT when a console traverses it + * looking for a channel that is watching for events on the console. Even + * in that case, no locking is required because that access is only under + * the gConsoleLock lock which prevents the channel from being removed from + * the gWatchingChannelList which in turn means it will not be deallocated + * from under the console thread. Access to individual fields does not need + * to be controlled because + * - the console thread does not write to any fields + * - changes to the nextWatchingChannelPtr field + * - changes to other fields do not matter because after being read for + * queueing events, they are verified again when the event is received + * in the interpreter thread (since they could have changed anyways while + * the event was in-flight on the event queue) + * + * Note on reference counting - a structure instance may be referenced from + * three places: + * - the Tcl channel subsystem. This reference is created when on channel + * opening and dropped on channel close. This also covers the reference + * from gWatchingChannelList since queueing / dequeuing from that list + * happens in conjunction with channel operations. + * - the Tcl event queue entries. This reference is added when the event + * is queued and dropped on receipt. */ - -typedef struct ConsoleInfo { - HANDLE handle; - int type; - struct ConsoleInfo *nextPtr;/* Pointer to next registered console. */ +typedef struct ConsoleChannelInfo { + HANDLE handle; /* Console handle */ + Tcl_ThreadId threadId; /* Id of owning thread */ + struct ConsoleChannelInfo + *nextWatchingChannelPtr; /* Pointer to next channel watching events. */ Tcl_Channel channel; /* Pointer to channel structure. */ - int validMask; /* OR'ed combination of TCL_READABLE, + DWORD initMode; /* Initial console mode. */ + int numRefs; /* See comments above */ + int permissions; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ int watchMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which events should be reported. */ - int flags; /* State flags, see above for a list. */ - Tcl_ThreadId threadId; /* Thread to which events should be reported. - * This value is used by the reader/writer - * threads. */ - ConsoleThreadInfo writer; /* A specialized thread for handling - * asynchronous writes to the console; the - * waiting starts when a control event is sent, - * and a reset event is sent back to the main - * thread when the write is done. */ - ConsoleThreadInfo reader; /* A specialized thread for handling - * asynchronous reads from the console; the - * waiting starts when a control event is sent, - * and a reset event is sent back to the main - * thread when input is available. */ - DWORD writeError; /* An error caused by the last background - * write. Set to 0 if no error has been - * detected. This word is shared with the - * writer thread so access must be - * synchronized with the writable object. */ - char *writeBuf; /* Current background output buffer. Access is - * synchronized with the writable object. */ - int writeBufLen; /* Size of write buffer. Access is - * synchronized with the writable object. */ - int toWrite; /* Current amount to be written. Access is - * synchronized with the writable object. */ - int readFlags; /* Flags that are shared with the reader - * thread. Access is synchronized with the - * readable object. */ - int bytesRead; /* Number of bytes in the buffer. */ - int offset; /* Number of bytes read out of the buffer. */ - DWORD initMode; /* Initial console mode. */ - char buffer[CONSOLE_BUFFER_SIZE]; - /* Data consumed by reader thread. */ -} ConsoleInfo; - -typedef struct { - /* - * The following pointer refers to the head of the list of consoles that - * are being watched for file events. - */ - - ConsoleInfo *firstConsolePtr; -} ThreadSpecificData; - -static Tcl_ThreadDataKey dataKey; + int flags; /* State flags */ +#define CONSOLE_EVENT_QUEUED 0x0001 /* Notification event already queued */ +#define CONSOLE_ASYNC 0x0002 /* Channel is non-blocking. */ +#define CONSOLE_READ_OPS 0x0004 /* Channel supports read-related ops. */ +} ConsoleChannelInfo; /* * The following structure is what is added to the Tcl event queue when @@ -126,51 +201,96 @@ static Tcl_ThreadDataKey dataKey; */ typedef struct { - Tcl_Event header; /* Information that is standard for all - * events. */ - ConsoleInfo *infoPtr; /* Pointer to console info structure. Note - * that we still have to verify that the - * console exists before dereferencing this - * pointer. */ + Tcl_Event header; /* Information that is standard for all events. */ + ConsoleChannelInfo *chanInfoPtr; /* Pointer to console info structure. Note + * that we still have to verify that the + * console exists before dereferencing this + * pointer. */ } ConsoleEvent; /* * Declarations for functions used only in this file. */ -static int ConsoleBlockModeProc(ClientData instanceData, - int mode); -static void ConsoleCheckProc(ClientData clientData, int flags); -static int ConsoleCloseProc(ClientData instanceData, - Tcl_Interp *interp, int flags); -static int ConsoleEventProc(Tcl_Event *evPtr, int flags); -static void ConsoleExitHandler(ClientData clientData); -static int ConsoleGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); -static int ConsoleGetOptionProc(ClientData instanceData, - Tcl_Interp *interp, const char *optionName, - Tcl_DString *dsPtr); -static void ConsoleInit(void); -static int ConsoleInputProc(ClientData instanceData, char *buf, - int toRead, int *errorCode); -static int ConsoleOutputProc(ClientData instanceData, - const char *buf, int toWrite, int *errorCode); +static int ConsoleBlockModeProc(void *instanceData, int mode); +static void ConsoleCheckProc(void *clientData, int flags); +static int ConsoleCloseProc(void *instanceData, + Tcl_Interp *interp, int flags); +static int ConsoleEventProc(Tcl_Event *evPtr, int flags); +static void ConsoleExitHandler(void *clientData); +static int ConsoleGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int ConsoleGetOptionProc(void *instanceData, + Tcl_Interp *interp, const char *optionName, + Tcl_DString *dsPtr); +static void ConsoleInit(void); +static int ConsoleInputProc(void *instanceData, char *buf, + int toRead, int *errorCode); +static int ConsoleOutputProc(void *instanceData, + const char *buf, int toWrite, int *errorCode); +static int ConsoleSetOptionProc(void *instanceData, + Tcl_Interp *interp, const char *optionName, + const char *value); +static void ConsoleSetupProc(void *clientData, int flags); +static void ConsoleWatchProc(void *instanceData, int mask); +static void ProcExitHandler(void *clientData); +static void ConsoleThreadActionProc(void *instanceData, int action); +static DWORD ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer, + Tcl_Size nChars, Tcl_Size *nCharsReadPtr); +static DWORD WriteConsoleChars(HANDLE hConsole, + const WCHAR *lpBuffer, Tcl_Size nChars, + Tcl_Size *nCharsWritten); +static void RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity); +static void RingBufferClear(RingBuffer *ringPtr); +static Tcl_Size RingBufferIn(RingBuffer *ringPtr, const char *srcPtr, + Tcl_Size srcLen, int partialCopyOk); +static Tcl_Size RingBufferOut(RingBuffer *ringPtr, char *dstPtr, + Tcl_Size dstCapacity, int partialCopyOk); +static ConsoleHandleInfo *AllocateConsoleHandleInfo(HANDLE consoleHandle, + int permissions); +static ConsoleHandleInfo *FindConsoleInfo(const ConsoleChannelInfo *); static DWORD WINAPI ConsoleReaderThread(LPVOID arg); -static int ConsoleSetOptionProc(ClientData instanceData, - Tcl_Interp *interp, const char *optionName, - const char *value); -static void ConsoleSetupProc(ClientData clientData, int flags); -static void ConsoleWatchProc(ClientData instanceData, int mask); static DWORD WINAPI ConsoleWriterThread(LPVOID arg); -static void ProcExitHandler(ClientData clientData); -static int WaitForRead(ConsoleInfo *infoPtr, int blocking); -static void ConsoleThreadActionProc(ClientData instanceData, - int action); -static BOOL ReadConsoleBytes(HANDLE hConsole, LPVOID lpBuffer, - DWORD nbytes, LPDWORD nbytesread); -static BOOL WriteConsoleBytes(HANDLE hConsole, - const void *lpBuffer, DWORD nbytes, - LPDWORD nbyteswritten); +static void NudgeWatchers(HANDLE consoleHandle); +#ifndef NDEBUG +static int RingBufferCheck(const RingBuffer *ringPtr); +#endif + +/* + * Static data. + */ + +typedef struct { + /* Currently this struct is only used to detect thread initialization */ + int notUsed; /* Dummy field */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* + * All access to static data is controlled through a single process-wide + * lock. A process can have only a single console at a time, with three + * handles for stdin, stdout and stderr. Creation/destruction of consoles is + * a relatively rare event (currently only possible during process start), + * the number of consoles (as opposed to channels) is small (only stdin, + * stdout and stderr), and contention low. More finer-grained locking would + * likely not only complicate implementation but be slower due to multiple + * locks being held. Note console channels also differ from other Tcl + * channel types in that the channel<->OS descriptor mapping is not one-to-one. + */ +SRWLOCK gConsoleLock; + + +/* Process-wide list of console handles. Access control through gConsoleLock */ +static ConsoleHandleInfo *gConsoleHandleInfoList; + +/* + * Process-wide list of channels that are listening for events. Again access + * control through gConsoleLock. Common list for all threads is simplifies + * locking and bookkeeping and is workable because in practice multiple + * threads are very unlikely to be all waiting on stdin (not workable + * because input would be randomly distributed to threads) + */ +static ConsoleChannelInfo *gWatchingChannelList; /* * This structure describes the channel type structure for command console @@ -178,82 +298,317 @@ static BOOL WriteConsoleBytes(HANDLE hConsole, */ static const Tcl_ChannelType consoleChannelType = { - "console", /* Type name. */ - TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ - ConsoleInputProc, /* Input proc. */ - ConsoleOutputProc, /* Output proc. */ - NULL, /* Seek proc. */ - ConsoleSetOptionProc, /* Set option proc. */ - ConsoleGetOptionProc, /* Get option proc. */ - ConsoleWatchProc, /* Set up notifier to watch the channel. */ - ConsoleGetHandleProc, /* Get an OS handle from channel. */ - ConsoleCloseProc, /* close2proc. */ - ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ - NULL, /* Flush proc. */ - NULL, /* Handler proc. */ - NULL, /* Wide seek proc. */ - ConsoleThreadActionProc, /* Thread action proc. */ - NULL /* Truncation proc. */ + "console", /* Type name. */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ + NULL, /* Close proc. */ + ConsoleInputProc, /* Input proc. */ + ConsoleOutputProc, /* Output proc. */ + NULL, /* Seek proc. */ + ConsoleSetOptionProc, /* Set option proc. */ + ConsoleGetOptionProc, /* Get option proc. */ + ConsoleWatchProc, /* Set up notifier to watch the channel. */ + ConsoleGetHandleProc, /* Get an OS handle from channel. */ + ConsoleCloseProc, /* close2proc. */ + ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ + NULL, /* Flush proc. */ + NULL, /* Handler proc. */ + NULL, /* Wide seek proc. */ + ConsoleThreadActionProc, /* Thread action proc. */ + NULL /* Truncation proc. */ }; + +/* + *------------------------------------------------------------------------ + * + * RingBufferInit -- + * + * Initializes the ring buffer to a given size. + * + * Results: + * None. + * + * Side effects: + * Panics on allocation failure. + * + *------------------------------------------------------------------------ + */ +static void +RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity) +{ + if (capacity <= 0 || capacity > TCL_SIZE_MAX) { + Tcl_Panic("Internal error: invalid ring buffer capacity requested."); + } + ringPtr->bufPtr = (char *)Tcl_Alloc(capacity); + ringPtr->capacity = capacity; + ringPtr->start = 0; + ringPtr->length = 0; +} /* - *---------------------------------------------------------------------- + *------------------------------------------------------------------------ * - * ReadConsoleBytes, WriteConsoleBytes -- + * RingBufferClear * - * Wrapper for ReadConsoleW, that takes and returns number of bytes - * instead of number of WCHARS. + * Clears the contents of a ring buffer. * - *---------------------------------------------------------------------- + * Results: + * None. + * + * Side effects: + * The allocated internal buffer is freed. + * + *------------------------------------------------------------------------ + */ +static void +RingBufferClear(RingBuffer *ringPtr) +{ + if (ringPtr->bufPtr) { + Tcl_Free(ringPtr->bufPtr); + ringPtr->bufPtr = NULL; + } + ringPtr->capacity = 0; + ringPtr->start = 0; + ringPtr->length = 0; +} + +/* + *------------------------------------------------------------------------ + * + * RingBufferIn -- + * + * Appends data to the ring buffer. + * + * Results: + * Returns number of bytes copied. + * + * Side effects: + * Internal buffer is updated. + * + *------------------------------------------------------------------------ */ +static Tcl_Size +RingBufferIn( + RingBuffer *ringPtr, + const char *srcPtr, /* Source to be copied */ + Tcl_Size srcLen, /* Length of source */ + int partialCopyOk /* If true, partial copy is permitted */ + ) +{ + Tcl_Size freeSpace; + + RINGBUFFER_ASSERT(ringPtr); + + freeSpace = ringPtr->capacity - ringPtr->length; + if (freeSpace < srcLen) { + if (!partialCopyOk) { + return 0; + } + /* Copy only as much as free space allows */ + srcLen = freeSpace; + } + + if (ringPtr->capacity - ringPtr->start > ringPtr->length) { + /* There is room at the back */ + Tcl_Size endSpaceStart = ringPtr->start + ringPtr->length; + Tcl_Size endSpace = ringPtr->capacity - endSpaceStart; + if (endSpace >= srcLen) { + /* Everything fits at the back */ + memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, srcLen); + } else { + /* srcLen > endSpace */ + memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, endSpace); + memmove(ringPtr->bufPtr, endSpace + srcPtr, srcLen - endSpace); + } + } else { + /* No room at the back. Existing data wrap to front. */ + Tcl_Size wrapLen = + ringPtr->start + ringPtr->length - ringPtr->capacity; + memmove(wrapLen + ringPtr->bufPtr, srcPtr, srcLen); + } + + ringPtr->length += srcLen; + + RINGBUFFER_ASSERT(ringPtr); + + return srcLen; +} + +/* + *------------------------------------------------------------------------ + * + * RingBufferOut -- + * + * Moves data out of the ring buffer. If dstPtr is NULL, the data + * is simply removed. + * + * Results: + * Returns number of bytes copied or removed. + * + * Side effects: + * Internal buffer is updated. + * + *------------------------------------------------------------------------ + */ +static Tcl_Size +RingBufferOut(RingBuffer *ringPtr, + char *dstPtr, /* Buffer for output data. May be NULL */ + Tcl_Size dstCapacity, /* Size of buffer */ + int partialCopyOk) /* If true, return what's available */ +{ + Tcl_Size leadLen; -static BOOL -ReadConsoleBytes( + RINGBUFFER_ASSERT(ringPtr); + + if (dstCapacity > ringPtr->length) { + if (dstPtr && !partialCopyOk) { + return 0; + } + dstCapacity = ringPtr->length; + } + + if (ringPtr->start <= (ringPtr->capacity - ringPtr->length)) { + /* No content wrap around. So leadLen is entire content */ + leadLen = ringPtr->length; + } else { + /* Content wraps around so lead segment stretches to end of buffer */ + leadLen = ringPtr->capacity - ringPtr->start; + } + if (leadLen >= dstCapacity) { + if (dstPtr) { + memmove(dstPtr, ringPtr->start + ringPtr->bufPtr, dstCapacity); + } + ringPtr->start += dstCapacity; + } else { + Tcl_Size wrapLen = dstCapacity - leadLen; + if (dstPtr) { + memmove(dstPtr, + ringPtr->start + ringPtr->bufPtr, + leadLen); + memmove( + leadLen + dstPtr, ringPtr->bufPtr, wrapLen); + } + ringPtr->start = wrapLen; + } + + ringPtr->length -= dstCapacity; + if (ringPtr->start == ringPtr->capacity || ringPtr->length == 0) { + ringPtr->start = 0; + } + + RINGBUFFER_ASSERT(ringPtr); + + return dstCapacity; +} + +#ifndef NDEBUG +static int +RingBufferCheck(const RingBuffer *ringPtr) +{ + return (ringPtr->bufPtr != NULL && ringPtr->capacity == CONSOLE_BUFFER_SIZE + && ringPtr->start < ringPtr->capacity + && ringPtr->length <= ringPtr->capacity); +} +#endif + +/* + *------------------------------------------------------------------------ + * + * ReadConsoleChars -- + * + * Wrapper for ReadConsoleW. + * + * Results: + * Returns 0 on success, else Windows error code. + * + * Side effects: + * On success the number of characters (not bytes) read is stored in + * *nCharsReadPtr. This will be 0 if the operation was interrupted by + * a Ctrl-C or a CancelIo call. + * + *------------------------------------------------------------------------ + */ +static DWORD +ReadConsoleChars( HANDLE hConsole, - LPVOID lpBuffer, - DWORD nbytes, - LPDWORD nbytesread) + WCHAR *lpBuffer, + Tcl_Size nChars, + Tcl_Size *nCharsReadPtr) { - DWORD ntchars; + DWORD nRead; BOOL result; /* - * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return - * success with ntchars == 0 and GetLastError() will be - * ERROR_OPERATION_ABORTED. We do not want to treat this case - * as EOF so we will loop around again. If no Ctrl signal handlers - * have been established, the default signal OS handler in a separate - * thread will terminate the program. If a Ctrl signal handler - * has been established (through an extension for example), it - * will run and take whatever action it deems appropriate. + * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return success + * with ntchars == 0 and GetLastError() will be ERROR_OPERATION_ABORTED. + * If no Ctrl signal handlers have been established, the default signal + * OS handler in a separate thread will terminate the program. If a Ctrl + * signal handler has been established (through an extension for + * example), it will run and take whatever action it deems appropriate. + * + * If one thread closes its channel, it calls CancelSynchronousIo on the + * console handle which results again in success being returned and + * GetLastError() being ERROR_OPERATION_ABORTED but ntchars in + * unmodified. + * + * In both cases above we will return success but with nbytesread as 0. + * This allows caller to check for thread termination etc. + * + * See https://bugs.python.org/issue30237 + * or https://github.com/microsoft/terminal/issues/12143 */ - do { - result = ReadConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, - NULL); - } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED); - if (nbytesread != NULL) { - *nbytesread = ntchars * sizeof(WCHAR); - } - return result; + nRead = (DWORD)-1; + result = ReadConsoleW(hConsole, lpBuffer, nChars, &nRead, NULL); + if (result) { + if ((nRead == 0 || nRead == (DWORD)-1) + && GetLastError() == ERROR_OPERATION_ABORTED) { + nRead = 0; + } + *nCharsReadPtr = nRead; + return 0; + } else + return GetLastError(); } + +/* + *------------------------------------------------------------------------ + * + * WriteConsoleChars -- + * + * Wrapper for WriteConsoleW. + * + * Results: + * Returns 0 on success, Windows error code on failure. + * + * Side effects: + * On success the number of characters (not bytes) written is stored in + * *nCharsWrittenPtr. This will be 0 if the operation was interrupted by + * a Ctrl-C or a CancelIo call. + * + *------------------------------------------------------------------------ + */ -static BOOL -WriteConsoleBytes( +static DWORD +WriteConsoleChars( HANDLE hConsole, - const void *lpBuffer, - DWORD nbytes, - LPDWORD nbyteswritten) + const WCHAR *lpBuffer, + Tcl_Size nChars, + Tcl_Size *nCharsWrittenPtr) { - DWORD ntchars; + DWORD nCharsWritten; BOOL result; - result = WriteConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, - NULL); - if (nbyteswritten != NULL) { - *nbyteswritten = ntchars * sizeof(WCHAR); + /* See comments in ReadConsoleChars, not sure that applies here */ + nCharsWritten = (DWORD)-1; + result = WriteConsoleW(hConsole, lpBuffer, nChars, &nCharsWritten, NULL); + if (result) { + if (nCharsWritten == (DWORD) -1) { + nCharsWritten = 0; + } + *nCharsWrittenPtr = nCharsWritten; + return 0; + } else { + return GetLastError(); } - return result; } /* @@ -280,19 +635,19 @@ ConsoleInit(void) * is a speed enhancement. */ - if (!initialized) { - Tcl_MutexLock(&consoleMutex); - if (!initialized) { - initialized = 1; + if (!gInitialized) { + AcquireSRWLockExclusive(&gConsoleLock); + if (!gInitialized) { + gInitialized = 1; Tcl_CreateExitHandler(ProcExitHandler, NULL); } - Tcl_MutexUnlock(&consoleMutex); + ReleaseSRWLockExclusive(&gConsoleLock); } if (TclThreadDataKeyGet(&dataKey) == NULL) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - tsdPtr->firstConsolePtr = NULL; + tsdPtr->notUsed = 0; Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL); } @@ -317,7 +672,7 @@ ConsoleInit(void) static void ConsoleExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); } @@ -341,11 +696,48 @@ ConsoleExitHandler( static void ProcExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { - Tcl_MutexLock(&consoleMutex); - initialized = 0; - Tcl_MutexUnlock(&consoleMutex); + AcquireSRWLockExclusive(&gConsoleLock); + gInitialized = 0; + ReleaseSRWLockExclusive(&gConsoleLock); +} + +/* + *------------------------------------------------------------------------ + * + * NudgeWatchers -- + * + * Wakes up all threads which have file event watchers on the passed + * console handle. + * + * The function locks and releases gConsoleLock. + * Caller must not be holding locks that will violate lock hierarchy. + * + * Results: + * None. + * + * Side effects: + * As above. + *------------------------------------------------------------------------ + */ +void NudgeWatchers (HANDLE consoleHandle) +{ + ConsoleChannelInfo *chanInfoPtr; + AcquireSRWLockShared(&gConsoleLock); /* Shared-read lock */ + for (chanInfoPtr = gWatchingChannelList; chanInfoPtr; + chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { + /* + * Notify channels interested in our handle AND that have + * a thread attached. + * No lock needed for chanInfoPtr. See ConsoleChannelInfo. + */ + if (chanInfoPtr->handle == consoleHandle + && chanInfoPtr->threadId != NULL) { + Tcl_ThreadAlert(chanInfoPtr->threadId); + } + } + ReleaseSRWLockShared(&gConsoleLock); } /* @@ -354,7 +746,9 @@ ProcExitHandler( * ConsoleSetupProc -- * * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an - * event. + * event. It walks the channel list and if any input channel has data + * available or output channel has space for data, sets the event loop + * blocking time to 0 so that it will poll immediately. * * Results: * None. @@ -367,37 +761,48 @@ ProcExitHandler( void ConsoleSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { - ConsoleInfo *infoPtr; + ConsoleChannelInfo *chanInfoPtr; Tcl_Time blockTime = { 0, 0 }; int block = 1; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return; } /* - * Look to see if any events are already pending. If they are, poll. + * Walk the list of channels. See general comments for struct + * ConsoleChannelInfo with regard to locking and field access. */ - - for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; - infoPtr = infoPtr->nextPtr) { - if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->writer.readyEvent, - 0) != WAIT_TIMEOUT) { - block = 0; - } - } - if (infoPtr->watchMask & TCL_READABLE) { - if (WaitForRead(infoPtr, 0) >= 0) { - block = 0; + AcquireSRWLockShared(&gConsoleLock); /* READ lock - no data modification */ + + for (chanInfoPtr = gWatchingChannelList; block && chanInfoPtr != NULL; + chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { + ConsoleHandleInfo *handleInfoPtr; + handleInfoPtr = FindConsoleInfo(chanInfoPtr); + if (handleInfoPtr != NULL) { + AcquireSRWLockShared(&handleInfoPtr->lock); + /* Remember at most one of READABLE, WRITABLE set */ + if (chanInfoPtr->watchMask & TCL_READABLE) { + if (RingBufferLength(&handleInfoPtr->buffer) > 0 + || handleInfoPtr->lastError != ERROR_SUCCESS) { + block = 0; /* Input data available */ + } + } else if (chanInfoPtr->watchMask & TCL_WRITABLE) { + if (RingBufferHasFreeSpace(&handleInfoPtr->buffer)) { + /* TCL_WRITABLE */ + block = 0; /* Output space available */ + } } + ReleaseSRWLockShared(&handleInfoPtr->lock); } } + ReleaseSRWLockShared(&gConsoleLock); + if (!block) { + /* At least one channel is readable/writable. Set block time to 0 */ Tcl_SetMaxBlockTime(&blockTime); } } @@ -421,57 +826,87 @@ ConsoleSetupProc( static void ConsoleCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { - ConsoleInfo *infoPtr; + ConsoleChannelInfo *chanInfoPtr; + Tcl_ThreadId me; int needEvent; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return; } + me = Tcl_GetCurrentThread(); + /* - * Queue events for any ready consoles that don't already have events - * queued. + * Acquire a shared lock. Note this is ok even though we potentially + * modify the chanInfoPtr->flags because chanInfoPtr is only modified + * when it belongs to this thread and no other thread will write to it. + * THe shared lock is intended to protect the global gWatchingChannelList + * as we traverse it. */ + AcquireSRWLockShared(&gConsoleLock); + + for (chanInfoPtr = gWatchingChannelList; chanInfoPtr != NULL; + chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { + ConsoleHandleInfo *handleInfoPtr; - for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; - infoPtr = infoPtr->nextPtr) { - if (infoPtr->flags & CONSOLE_PENDING) { + if (chanInfoPtr->threadId != me) { + /* Some other thread owns the channel */ + continue; + } + if (chanInfoPtr->flags & CONSOLE_EVENT_QUEUED) { + /* A notification event already queued. No point in another. */ continue; } - /* - * Queue an event if the console is signaled for reading or writing. - */ + handleInfoPtr = FindConsoleInfo(chanInfoPtr); + /* Pointer is safe to access as we are holding gConsoleLock */ - needEvent = 0; - if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->writer.readyEvent, - 0) != WAIT_TIMEOUT) { - needEvent = 1; - } + if (handleInfoPtr == NULL) { + /* Stale event */ + continue; } - if (infoPtr->watchMask & TCL_READABLE) { - if (WaitForRead(infoPtr, 0) >= 0) { - needEvent = 1; + needEvent = 0; + AcquireSRWLockShared(&handleInfoPtr->lock); + /* Rememeber channel is read or write, never both */ + if (chanInfoPtr->watchMask & TCL_READABLE) { + if (RingBufferLength(&handleInfoPtr->buffer) > 0 + || handleInfoPtr->lastError != ERROR_SUCCESS) { + needEvent = 1; /* Input data available or error/EOF */ + } + /* + * TCL_READABLE watch means someone is looking out for data being + * available, let reader thread know. Note channel need not be + * ASYNC! (Bug [baa51423c2]) + */ + handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; + WakeConditionVariable(&handleInfoPtr->consoleThreadCV); + } else if (chanInfoPtr->watchMask & TCL_WRITABLE) { + if (RingBufferHasFreeSpace(&handleInfoPtr->buffer)) { + needEvent = 1; /* Output space available */ } } + ReleaseSRWLockShared(&handleInfoPtr->lock); if (needEvent) { - ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent)); + ConsoleEvent *evPtr = (ConsoleEvent *)Tcl_Alloc(sizeof(ConsoleEvent)); - infoPtr->flags |= CONSOLE_PENDING; + /* See note above loop why this can be accessed without locks */ + chanInfoPtr->flags |= CONSOLE_EVENT_QUEUED; + chanInfoPtr->numRefs += 1; /* So it does not go away while event + is in queue */ evPtr->header.proc = ConsoleEventProc; - evPtr->infoPtr = infoPtr; + evPtr->chanInfoPtr = chanInfoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } + + ReleaseSRWLockShared(&gConsoleLock); } - + /* *---------------------------------------------------------------------- * @@ -490,11 +925,11 @@ ConsoleCheckProc( static int ConsoleBlockModeProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; + ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; /* * Consoles on Windows can not be switched between blocking and @@ -505,9 +940,9 @@ ConsoleBlockModeProc( */ if (mode == TCL_MODE_NONBLOCKING) { - infoPtr->flags |= CONSOLE_ASYNC; + chanInfoPtr->flags |= CONSOLE_ASYNC; } else { - infoPtr->flags &= ~CONSOLE_ASYNC; + chanInfoPtr->flags &= ~CONSOLE_ASYNC; } return 0; } @@ -530,102 +965,102 @@ ConsoleBlockModeProc( static int ConsoleCloseProc( - ClientData instanceData, /* Pointer to ConsoleInfo structure. */ + void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { - ConsoleInfo *consolePtr = (ConsoleInfo *)instanceData; + ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; + ConsoleHandleInfo *handleInfoPtr; int errorCode = 0; - ConsoleInfo *infoPtr, **nextPtrPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ConsoleChannelInfo **nextPtrPtr; + int closeHandle; if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { return EINVAL; } - /* - * Clean up the background thread if necessary. Note that this must be - * done before we can close the file, since the thread may be blocking - * trying to read from the console. + * Don't close the Win32 handle if the handle is a standard channel + * during the thread exit process. Otherwise, one thread may kill the + * stdio of another while exiting. Note an explicit close in script will + * still close the handle. That's historical behavior on all platforms. */ + if (!TclInThreadExit() + || ((GetStdHandle(STD_INPUT_HANDLE) != chanInfoPtr->handle) + && (GetStdHandle(STD_OUTPUT_HANDLE) != chanInfoPtr->handle) + && (GetStdHandle(STD_ERROR_HANDLE) != chanInfoPtr->handle))) { + closeHandle = 1; + } else { + closeHandle = 0; + } + + AcquireSRWLockExclusive(&gConsoleLock); - if (consolePtr->reader.thread) { - TclPipeThreadStop(&consolePtr->reader.TI, consolePtr->reader.thread); - CloseHandle(consolePtr->reader.thread); - CloseHandle(consolePtr->reader.readyEvent); - consolePtr->reader.thread = NULL; + /* Remove channel from watchers' list */ + for (nextPtrPtr = &gWatchingChannelList; *nextPtrPtr != NULL; + nextPtrPtr = &(*nextPtrPtr)->nextWatchingChannelPtr) { + if (*nextPtrPtr == (ConsoleChannelInfo *) chanInfoPtr) { + *nextPtrPtr = (*nextPtrPtr)->nextWatchingChannelPtr; + break; + } } - consolePtr->validMask &= ~TCL_READABLE; - /* - * 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. - */ + handleInfoPtr = FindConsoleInfo(chanInfoPtr); + if (handleInfoPtr) { + /* + * Console thread may be blocked either waiting for console i/o + * or waiting on the condition variable for buffer empty/full + */ + AcquireSRWLockShared(&handleInfoPtr->lock); + + if (closeHandle) { + handleInfoPtr->console = INVALID_HANDLE_VALUE; + } - if (consolePtr->writer.thread) { - if (consolePtr->toWrite) { + /* Break the thread out of blocking console i/o */ + handleInfoPtr->numRefs -= 1; /* Remove reference from this channel */ + if (handleInfoPtr->numRefs == 1) { /* - * We only need to wait if there is something to write. This may - * prevent infinite wait on exit. [Python Bug 216289] + * Abort the i/o if no other threads are listening on it. + * Note without this check, an input line will be skipped on + * the cancel. */ - - WaitForSingleObject(consolePtr->writer.readyEvent, 5000); + CancelSynchronousIo(handleInfoPtr->consoleThread); } - TclPipeThreadStop(&consolePtr->writer.TI, consolePtr->writer.thread); - CloseHandle(consolePtr->writer.thread); - CloseHandle(consolePtr->writer.readyEvent); - consolePtr->writer.thread = NULL; - } - consolePtr->validMask &= ~TCL_WRITABLE; - - /* - * If the user has been tinkering with the mode, reset it now. We ignore - * any errors from this; we're quite possibly about to close or exit - * anyway. - */ + /* + * Wake up the console handling thread. Note we do not explicitly + * tell it handle is closed (below). It will find out on next access + */ + WakeConditionVariable(&handleInfoPtr->consoleThreadCV); - if ((consolePtr->flags & CONSOLE_READ_OPS) && - (consolePtr->flags & CONSOLE_RESET)) { - SetConsoleMode(consolePtr->handle, consolePtr->initMode); + ReleaseSRWLockShared(&handleInfoPtr->lock); } - /* - * Don't close the Win32 handle if the handle is a standard channel during - * the thread exit process. Otherwise, one thread may kill the stdio of - * another. - */ + ReleaseSRWLockExclusive(&gConsoleLock); - if (!TclInThreadExit() - || ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle) - && (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle) - && (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) { - if (CloseHandle(consolePtr->handle) == FALSE) { + chanInfoPtr->channel = NULL; + chanInfoPtr->watchMask = 0; + chanInfoPtr->permissions = 0; + + if (closeHandle && chanInfoPtr->handle != INVALID_HANDLE_VALUE) { + if (CloseHandle(chanInfoPtr->handle) == FALSE) { Tcl_WinConvertError(GetLastError()); errorCode = errno; } + chanInfoPtr->handle = INVALID_HANDLE_VALUE; } - consolePtr->watchMask &= consolePtr->validMask; - /* - * Remove the file from the list of watched files. + * Note, we can check and manipulate numRefs without a lock because + * we have removed it from the watch queue so the console thread cannot + * get at it. */ - - for (nextPtrPtr = &tsdPtr->firstConsolePtr, infoPtr = *nextPtrPtr; - infoPtr != NULL; - nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) { - if (infoPtr == (ConsoleInfo *) consolePtr) { - *nextPtrPtr = infoPtr->nextPtr; - break; - } - } - if (consolePtr->writeBuf != NULL) { - ckfree(consolePtr->writeBuf); - consolePtr->writeBuf = 0; + if (chanInfoPtr->numRefs > 1) { + /* There may be references already on the event queue */ + chanInfoPtr->numRefs -= 1; + } else { + Tcl_Free(chanInfoPtr); } - ckfree(consolePtr); return errorCode; } @@ -647,80 +1082,147 @@ ConsoleCloseProc( * *---------------------------------------------------------------------- */ - static int ConsoleInputProc( - ClientData instanceData, /* Console state. */ - char *buf, /* Where to store data read. */ + void *instanceData, /* Console state. */ + char *bufPtr, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCode) /* Where to store error code. */ { - ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; - DWORD count, bytesRead = 0; - int result; - - *errorCode = 0; - - /* - * Synchronize with the reader thread. - */ + ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; + ConsoleHandleInfo *handleInfoPtr; + Tcl_Size numRead; - result = WaitForRead(infoPtr, (infoPtr->flags & CONSOLE_ASYNC) ? 0 : 1); + if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) { + return 0; /* EOF */ + } - /* - * If an error occurred, return immediately. - */ + *errorCode = 0; - if (result == -1) { - *errorCode = errno; - return -1; + AcquireSRWLockShared(&gConsoleLock); + handleInfoPtr = FindConsoleInfo(chanInfoPtr); + if (handleInfoPtr == NULL) { + /* Really shouldn't happen since channel is holding a reference */ + ReleaseSRWLockShared(&gConsoleLock); + return 0; /* EOF */ } + AcquireSRWLockExclusive(&handleInfoPtr->lock); + ReleaseSRWLockShared(&gConsoleLock); /* AFTER acquiring handleInfoPtr->lock */ - if (infoPtr->readFlags & CONSOLE_BUFFERED) { + while (1) { + numRead = RingBufferOut(&handleInfoPtr->buffer, bufPtr, bufSize, 1); /* - * Data is stored in the buffer. + * Note: even if channel is closed or has an error, as long there is + * buffered data, we will pass it up. */ + if (numRead != 0) { + break; + } + /* + * No data available. + * - If an error was recorded, generate that and reset it. + * - If EOF, indicate as much. It is up to the application to close + * the channel. + * - Otherwise, if non-blocking return EAGAIN or wait for more data. + */ + if (handleInfoPtr->lastError != 0) { + if (handleInfoPtr->lastError == ERROR_INVALID_HANDLE) { + numRead = 0; /* Treat as EOF */ + } else { + Tcl_WinConvertError(handleInfoPtr->lastError); + handleInfoPtr->lastError = 0; + *errorCode = Tcl_GetErrno(); + numRead = -1; + } + break; + } + if (handleInfoPtr->console == INVALID_HANDLE_VALUE) { + /* EOF - break with numRead == 0 */ + chanInfoPtr->handle = INVALID_HANDLE_VALUE; + break; + } - if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) { - memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize); - bytesRead = bufSize; - infoPtr->offset += bufSize; - } else { - memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize); - bytesRead = infoPtr->bytesRead - infoPtr->offset; - - /* - * Reset the buffer. - */ + /* For async, tell caller we are blocked */ + if (chanInfoPtr->flags & CONSOLE_ASYNC) { + *errorCode = EWOULDBLOCK; + numRead = -1; + break; + } - infoPtr->readFlags &= ~CONSOLE_BUFFERED; - infoPtr->offset = 0; + /* + * Blocking read. Just get data from directly from console. There + * is a small complication in that + * 1. The destination buffer should be WCHAR aligned. + * 2. We can only read even number of bytes (wide-character API). + * 3. Caller has large enough buffer (else length of line user can + * enter will be limited) + * If any condition is not met, we defer to the + * reader thread which handles these cases rather than dealing with + * them here (which is a little trickier than it might sound.) + * + * TODO - not clear this block is a useful optimization. bufSize by + * default is 4K which is < INPUT_BUFFER_SIZE and will rarely be + * increased on stdin. + */ + if ((1 & (size_t)bufPtr) == 0 /* aligned buffer */ + && (1 & bufSize) == 0 /* Even number of bytes */ + && bufSize > INPUT_BUFFER_SIZE) { + DWORD lastError; + Tcl_Size numChars; + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + lastError = ReadConsoleChars(chanInfoPtr->handle, + (WCHAR *)bufPtr, + bufSize / sizeof(WCHAR), + &numChars); + /* NOTE lock released so DON'T break. Return instead */ + if (lastError != ERROR_SUCCESS) { + Tcl_WinConvertError(lastError); + *errorCode = Tcl_GetErrno(); + return -1; + } else if (numChars > 0) { + /* Successfully read something. */ + return numChars * sizeof(WCHAR); + } else { + /* + * Ctrl-C/Ctrl-Brk interrupt. Loop around to retry. + * We have to reacquire the lock. No worried about handleInfoPtr + * having gone away since the channel holds a reference. + */ + AcquireSRWLockExclusive(&handleInfoPtr->lock); + continue; + } + } + /* + * Deferring blocking read to reader thread. + * Release the lock and sleep. Note that because the channel + * holds a reference count on handleInfoPtr, it will not + * be deallocated while the lock is released. + */ + handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; + WakeConditionVariable(&handleInfoPtr->consoleThreadCV); + if (!SleepConditionVariableSRW(&handleInfoPtr->interpThreadCV, + &handleInfoPtr->lock, + INFINITE, + 0)) { + Tcl_WinConvertError(GetLastError()); + *errorCode = Tcl_GetErrno(); + numRead = -1; + break; } - return bytesRead; + /* Lock is reacquired, loop back to try again */ } - /* - * Attempt to read bufSize bytes. The read will return immediately if - * there is any data available. Otherwise it will block until at least one - * byte is available or an EOF occurs. - */ - - if (ReadConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, - &count) == TRUE) { - /* - * TODO: This potentially writes beyond the limits specified - * by the caller. In practice this is harmless, since all writes - * are into ChannelBuffers, and those have padding, but still - * ought to remove this, unless some Windows wizard can give - * a reason not to. - */ - buf[count] = '\0'; - return count; + /* We read data. Ask for more if either async or watching for reads */ + if ((chanInfoPtr->flags & CONSOLE_ASYNC) + || (chanInfoPtr->watchMask & TCL_READABLE)) { + handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; + WakeConditionVariable(&handleInfoPtr->consoleThreadCV); } - return -1; + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + return numRead; } /* @@ -740,82 +1242,119 @@ ConsoleInputProc( * *---------------------------------------------------------------------- */ - static int ConsoleOutputProc( - ClientData instanceData, /* Console state. */ + void *instanceData, /* Console state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; - ConsoleThreadInfo *threadInfo = &infoPtr->writer; - DWORD bytesWritten, timeout; + ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; + ConsoleHandleInfo *handleInfoPtr; + Tcl_Size numWritten; *errorCode = 0; - /* avoid blocking if pipe-thread exited */ - timeout = (infoPtr->flags & CONSOLE_ASYNC) || !TclPipeThreadIsAlive(&threadInfo->TI) - || TclInExit() || TclInThreadExit() ? 0 : INFINITE; - if (WaitForSingleObject(threadInfo->readyEvent, timeout) == WAIT_TIMEOUT) { - /* - * The writer thread is blocked waiting for a write to complete and - * the channel is in non-blocking mode. - */ - - errno = EWOULDBLOCK; - goto error; + if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) { + /* Some other thread would have *previously* closed the stdio handle */ + *errorCode = EPIPE; + return -1; } - /* - * Check for a background error on the last write. - */ - - if (infoPtr->writeError) { - Tcl_WinConvertError(infoPtr->writeError); - infoPtr->writeError = 0; - goto error; + AcquireSRWLockShared(&gConsoleLock); + handleInfoPtr = FindConsoleInfo(chanInfoPtr); + if (handleInfoPtr == NULL) { + /* Really shouldn't happen since channel is holding a reference */ + *errorCode = EPIPE; + ReleaseSRWLockShared(&gConsoleLock); + return -1; } + AcquireSRWLockExclusive(&handleInfoPtr->lock); + ReleaseSRWLockShared(&gConsoleLock); /* AFTER acquiring handleInfoPtr->lock */ + + /* Keep looping until all written. Break out for async and errors */ + numWritten = 0; + while (1) { + /* Check for error and closing on every loop. */ + if (handleInfoPtr->lastError != 0) { + Tcl_WinConvertError(handleInfoPtr->lastError); + *errorCode = Tcl_GetErrno(); + numWritten = -1; + break; + } + if (handleInfoPtr->console == INVALID_HANDLE_VALUE) { + *errorCode = EPIPE; + chanInfoPtr->handle = INVALID_HANDLE_VALUE; + numWritten = -1; + break; + } - if (infoPtr->flags & CONSOLE_ASYNC) { /* - * The console is non-blocking, so copy the data into the output - * buffer and restart the writer thread. + * We can either write directly or through the console thread's + * ring buffer. We have to do the latter when + * (1) the operation is async since WriteConsoleChars is always blocking + * (2) when there is already data in the ring buffer because we don't + * want to reorder output from within a thread + * (3) when there are an odd number of bytes since WriteConsole + * takes whole WCHARs + * (4) when the pointer is not aligned on WCHAR + * The ring buffer deals with cases (3) and (4). It would be harder + * to duplicate that here. */ - - if (toWrite > infoPtr->writeBufLen) { + if ((chanInfoPtr->flags & CONSOLE_ASYNC) /* Case (1) */ + || RingBufferLength(&handleInfoPtr->buffer) != 0 /* Case (2) */ + || (toWrite & 1) != 0 /* Case (3) */ + || (PTR2INT(buf) & 1) != 0 /* Case (4) */ + ) { + numWritten += RingBufferIn(&handleInfoPtr->buffer, + numWritten + buf, + toWrite - numWritten, + 1); + if (numWritten == toWrite || chanInfoPtr->flags & CONSOLE_ASYNC) { + /* All done or async, just accept whatever was written */ + break; + } /* - * Reallocate the buffer to be large enough to hold the data. + * Release the lock and sleep. Note that because the channel + * holds a reference count on handleInfoPtr, it will not + * be deallocated while the lock is released. */ - - if (infoPtr->writeBuf) { - ckfree(infoPtr->writeBuf); + WakeConditionVariable(&handleInfoPtr->consoleThreadCV); + if (!SleepConditionVariableSRW(&handleInfoPtr->interpThreadCV, + &handleInfoPtr->lock, + INFINITE, + 0)) { + /* Report the error */ + Tcl_WinConvertError(GetLastError()); + *errorCode = Tcl_GetErrno(); + numWritten = -1; + break; + } + } else { + /* Direct output */ + DWORD winStatus; + HANDLE consoleHandle = handleInfoPtr->console; + /* Unlock before blocking in WriteConsole */ + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + /* UNLOCKED so return, DON'T break out of loop as it will unlock again! */ + winStatus = WriteConsoleChars(consoleHandle, + (WCHAR *)buf, + toWrite / sizeof(WCHAR), + &numWritten); + if (winStatus == ERROR_SUCCESS) { + return numWritten * sizeof(WCHAR); + } else { + Tcl_WinConvertError(winStatus); + *errorCode = Tcl_GetErrno(); + return -1; } - infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = (char *)ckalloc(toWrite); } - memcpy(infoPtr->writeBuf, buf, toWrite); - infoPtr->toWrite = toWrite; - ResetEvent(threadInfo->readyEvent); - TclPipeThreadSignal(&threadInfo->TI); - bytesWritten = toWrite; - } else { - /* - * In the blocking case, just try to write the buffer directly. This - * avoids an unnecessary copy. - */ - if (WriteConsoleBytes(infoPtr->handle, buf, (DWORD) toWrite, - &bytesWritten) == FALSE) { - Tcl_WinConvertError(GetLastError()); - goto error; - } + /* Lock must have been reacquired before continuing loop */ } - return bytesWritten; - - error: - *errorCode = errno; - return -1; + WakeConditionVariable(&handleInfoPtr->consoleThreadCV); + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + return numWritten; } /* @@ -846,66 +1385,84 @@ ConsoleEventProc( * such as TCL_FILE_EVENTS. */ { ConsoleEvent *consoleEvPtr = (ConsoleEvent *) evPtr; - ConsoleInfo *infoPtr; - int mask; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ConsoleChannelInfo *chanInfoPtr; + int freeChannel; + int mask = 0; if (!(flags & TCL_FILE_EVENTS)) { return 0; } + chanInfoPtr = consoleEvPtr->chanInfoPtr; /* - * Search through the list of watched consoles for the one whose handle - * matches the event. We do this rather than simply dereferencing the - * handle in the event so that consoles can be deleted while the event is - * in the queue. + * We know chanInfoPtr is valid because its reference count would have + * been incremented when the event was queued. The corresponding release + * happens in this function. */ - for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; - infoPtr = infoPtr->nextPtr) { - if (consoleEvPtr->infoPtr == infoPtr) { - infoPtr->flags &= ~CONSOLE_PENDING; - break; - } - } - /* - * Remove stale events. + * Global lock used for chanInfoPtr. A read (shared) lock suffices + * because all access is within the channel owning thread with the + * exception of watchers which is a read-only access. See comments + * to ConsoleChannelInfo. */ - - if (!infoPtr) { - return 1; - } + AcquireSRWLockShared(&gConsoleLock); + chanInfoPtr->flags &= ~CONSOLE_EVENT_QUEUED; /* - * Check to see if the console is readable. Note that we can't tell if a - * console is writable, so we always report it as being writable unless we - * have detected EOF. + * Only handle the event if the Tcl channel has not gone away AND is + * still owned by this thread AND is still watching events. */ - - mask = 0; - if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->writer.readyEvent, - 0) != WAIT_TIMEOUT) { - mask = TCL_WRITABLE; - } - } - - if (infoPtr->watchMask & TCL_READABLE) { - if (WaitForRead(infoPtr, 0) >= 0) { - if (infoPtr->readFlags & CONSOLE_EOF) { + if (chanInfoPtr->channel && chanInfoPtr->threadId == Tcl_GetCurrentThread() + && (chanInfoPtr->watchMask & (TCL_READABLE|TCL_WRITABLE))) { + ConsoleHandleInfo *handleInfoPtr; + handleInfoPtr = FindConsoleInfo(chanInfoPtr); + if (handleInfoPtr == NULL) { + /* Console was closed. EOF->read event only (not write) */ + if (chanInfoPtr->watchMask & TCL_READABLE) { mask = TCL_READABLE; - } else { - mask |= TCL_READABLE; } + } else { + AcquireSRWLockShared(&handleInfoPtr->lock); + /* Remember at most one of READABLE, WRITABLE set */ + if ((chanInfoPtr->watchMask & TCL_READABLE) + && RingBufferLength(&handleInfoPtr->buffer)) { + mask = TCL_READABLE; + } else if ((chanInfoPtr->watchMask & TCL_WRITABLE) + && RingBufferHasFreeSpace(&handleInfoPtr->buffer)) { + /* Generate write event space available */ + mask = TCL_WRITABLE; + } + ReleaseSRWLockShared(&handleInfoPtr->lock); } } /* - * Inform the channel of the events. + * Tcl_NotifyChannel can recurse through the file event callback so need + * to release locks first. Our reference still holds so no danger of + * chanInfoPtr being deallocated if the callback closes the channel. */ + ReleaseSRWLockShared(&gConsoleLock); + if (mask) { + Tcl_NotifyChannel(chanInfoPtr->channel, mask); + /* Note: chanInfoPtr ref count may have changed */ + } + + /* No need to lock - see comments earlier */ + + /* Remove the reference to the channel from event record */ + if (chanInfoPtr->numRefs > 1) { + chanInfoPtr->numRefs -= 1; + freeChannel = 0; + } else { + assert(chanInfoPtr->channel == NULL); + freeChannel = 1; + } + + if (freeChannel) { + Tcl_Free(chanInfoPtr); + } - Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask); return 1; } @@ -927,43 +1484,59 @@ ConsoleEventProc( static void ConsoleWatchProc( - ClientData instanceData, /* Console state. */ - int mask) /* What events to watch for, OR-ed combination - * of TCL_READABLE, TCL_WRITABLE and - * TCL_EXCEPTION. */ + void *instanceData, /* Console state. */ + int newMask) /* What events to watch for, one of + * of TCL_READABLE, TCL_WRITABLE + */ { - ConsoleInfo **nextPtrPtr, *ptr; - ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; - int oldMask = infoPtr->watchMask; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ConsoleChannelInfo **nextPtrPtr, *ptr; + ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; + int oldMask = chanInfoPtr->watchMask; /* * Since most of the work is handled by the background threads, we just * need to update the watchMask and then force the notifier to poll once. */ - infoPtr->watchMask = mask & infoPtr->validMask; - if (infoPtr->watchMask) { + chanInfoPtr->watchMask = newMask & chanInfoPtr->permissions; + if (chanInfoPtr->watchMask) { Tcl_Time blockTime = { 0, 0 }; if (!oldMask) { - infoPtr->nextPtr = tsdPtr->firstConsolePtr; - tsdPtr->firstConsolePtr = infoPtr; + AcquireSRWLockExclusive(&gConsoleLock); + /* Add to list of watched channels */ + chanInfoPtr->nextWatchingChannelPtr = gWatchingChannelList; + gWatchingChannelList = chanInfoPtr; + + /* + * For read channels, need to tell the console reader thread + * that we are looking for data since it will not do reads until + * it knows someone is awaiting. + */ + ConsoleHandleInfo *handleInfoPtr; + handleInfoPtr = FindConsoleInfo(chanInfoPtr); + if (handleInfoPtr) { + AcquireSRWLockExclusive(&handleInfoPtr->lock); + handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; + WakeConditionVariable(&handleInfoPtr->consoleThreadCV); + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + } + ReleaseSRWLockExclusive(&gConsoleLock); } Tcl_SetMaxBlockTime(&blockTime); } else if (oldMask) { - /* - * Remove the console from the list of watched consoles. - */ + /* Remove from list of watched channels */ - for (nextPtrPtr = &(tsdPtr->firstConsolePtr), ptr = *nextPtrPtr; + AcquireSRWLockExclusive(&gConsoleLock); + for (nextPtrPtr = &gWatchingChannelList, ptr = *nextPtrPtr; ptr != NULL; - nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) { - if (infoPtr == ptr) { - *nextPtrPtr = ptr->nextPtr; + nextPtrPtr = &ptr->nextWatchingChannelPtr, ptr = *nextPtrPtr) { + if (chanInfoPtr == ptr) { + *nextPtrPtr = ptr->nextWatchingChannelPtr; break; } } + ReleaseSRWLockExclusive(&gConsoleLock); } } @@ -987,120 +1560,69 @@ ConsoleWatchProc( static int ConsoleGetHandleProc( - ClientData instanceData, /* The console state. */ + void *instanceData, /* The console state. */ TCL_UNUSED(int) /*direction*/, - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { - ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; + ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; - *handlePtr = infoPtr->handle; - return TCL_OK; + if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) { + return TCL_ERROR; + } else { + *handlePtr = chanInfoPtr->handle; + return TCL_OK; + } } /* - *---------------------------------------------------------------------- + *------------------------------------------------------------------------ * - * WaitForRead -- + * ConsoleDataAvailable -- * - * Wait until some data is available, the console is at EOF or the reader - * thread is blocked waiting for data (if the channel is in non-blocking - * mode). + * Checks if there is data in the console input queue. * * Results: - * Returns 1 if console is readable. Returns 0 if there is no data on the - * console, but there is buffered data. Returns -1 if an error occurred. - * If an error occurred, the threads may not be synchronized. + * Returns 1 if the input queue has data, -1 on error else 0 if empty. * * Side effects: - * Updates the shared state flags. If no error occurred, the reader - * thread is blocked waiting for a signal from the main thread. + * None. * - *---------------------------------------------------------------------- + *------------------------------------------------------------------------ */ - -static int -WaitForRead( - ConsoleInfo *infoPtr, /* Console state. */ - int blocking) /* Indicates whether call should be blocking - * or not. */ + static int + ConsoleDataAvailable (HANDLE consoleHandle) { - DWORD timeout, count; - HANDLE *handle = (HANDLE *)infoPtr->handle; - ConsoleThreadInfo *threadInfo = &infoPtr->reader; - INPUT_RECORD input; - - while (1) { - /* - * Synchronize with the reader thread. - */ - - /* avoid blocking if pipe-thread exited */ - timeout = (!blocking || !TclPipeThreadIsAlive(&threadInfo->TI) - || TclInExit() || TclInThreadExit()) ? 0 : INFINITE; - if (WaitForSingleObject(threadInfo->readyEvent, timeout) == WAIT_TIMEOUT) { - /* - * The reader thread is blocked waiting for data and the channel - * is in non-blocking mode. - */ - - errno = EWOULDBLOCK; - return -1; - } - - /* - * At this point, the two threads are synchronized, so it is safe to - * access shared state. - */ - - /* - * If the console has hit EOF, it is always readable. - */ + INPUT_RECORD input[10]; + DWORD count; + DWORD i; - if (infoPtr->readFlags & CONSOLE_EOF) { - return 1; - } - - if (PeekConsoleInputW(handle, &input, 1, &count) == FALSE) { - /* - * Check to see if the peek failed because of EOF. - */ - - Tcl_WinConvertError(GetLastError()); - - if (errno == EOF) { - infoPtr->readFlags |= CONSOLE_EOF; - return 1; - } - - /* - * Ignore errors if there is data in the buffer. - */ - - if (infoPtr->readFlags & CONSOLE_BUFFERED) { - return 0; - } else { - return -1; - } - } - - /* - * If there is data in the buffer, the console must be readable (since - * it is a line-oriented device). - */ - - if (infoPtr->readFlags & CONSOLE_BUFFERED) { + /* + * Need at least one keyboard event. + */ + if (PeekConsoleInputW( + consoleHandle, input, sizeof(input) / sizeof(input[0]), &count) + == FALSE) { + return -1; + } + /* + * Even if windows size and mouse events are disabled, can still have + * events other than keyboard, like focus events. Look for at least one + * keydown event because a trailing LF keyup is always present from the + * last input. However, if our buffer is full, assume there is a key + * down somewhere in the unread buffer. I suppose we could expand the + * buffer but not worth... + */ + if (count == (sizeof(input)/sizeof(input[0]))) + return 1; + for (i = 0; i < count; ++i) { + if (input[i].EventType == KEY_EVENT + && input[i].Event.KeyEvent.bKeyDown) { return 1; } - - /* - * There wasn't any data available, so reset the thread and try again. - */ - - ResetEvent(threadInfo->readyEvent); - TclPipeThreadSignal(&threadInfo->TI); } + return 0; } - + /* *---------------------------------------------------------------------- * @@ -1110,12 +1632,10 @@ WaitForRead( * available on a console. * * Results: - * None. + * Always 0. * * Side effects: - * Signals the main thread when input become available. May cause the - * main thread to wake up by posting a message. May one line from the - * console for each wait operation. + * Signals the main thread when input become available. * *---------------------------------------------------------------------- */ @@ -1124,76 +1644,188 @@ static DWORD WINAPI ConsoleReaderThread( LPVOID arg) { - TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg; - ConsoleInfo *infoPtr = NULL; /* access info only after success init/wait */ - HANDLE *handle = NULL; - ConsoleThreadInfo *threadInfo = NULL; - int done = 0; + ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg; + ConsoleHandleInfo **iterator; + Tcl_Size inputLen = 0; + Tcl_Size inputOffset = 0; + Tcl_Size lastReadSize = 0; + DWORD sleepTime; + char inputChars[INPUT_BUFFER_SIZE]; - while (!done) { - /* - * Wait for the main thread to signal before attempting to read. - */ + /* + * Keep looping until one of the following happens. + * - there are no more channels listening on the console + * - the console handle has been closed + */ - if (!TclPipeThreadWaitForSignal(&pipeTI)) { - /* exit */ + /* This thread is holding a reference so pointer is safe */ + AcquireSRWLockExclusive(&handleInfoPtr->lock); + + while (1) { + + if (handleInfoPtr->numRefs == 1) { + /* + * Sole reference. That's this thread. Exit since no clients + * and no way for a thread to attach to a console after process + * start. + */ break; } - if (!infoPtr) { - infoPtr = (ConsoleInfo *)pipeTI->clientData; - handle = (HANDLE *)infoPtr->handle; - threadInfo = &infoPtr->reader; - } - /* - * Look for data on the console, but first ignore any events that are - * not KEY_EVENTs. + * Shared buffer has no data. If we have some in our private buffer + * copy that. Else check if there has been an error. In both cases + * notify the interp threads. */ + if (inputLen > 0 || handleInfoPtr->lastError != 0) { + HANDLE consoleHandle; + if (inputLen > 0) { + /* Private buffer has data. Copy it over. */ + Tcl_Size nStored; + + assert((inputLen - inputOffset) > 0); + nStored = RingBufferIn(&handleInfoPtr->buffer, + inputOffset + inputChars, + inputLen - inputOffset, + 1); + inputOffset += nStored; + if (inputOffset == inputLen) { + /* Temp buffer now empty */ + inputOffset = 0; + inputLen = 0; + } + } else { + /* + * On error, nothing but inform caller and wait + * We do not want to exit until there are no client interps. + */ + } - if (ReadConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE, - (LPDWORD) &infoPtr->bytesRead) != FALSE) { /* - * Data was stored in the buffer. + * Wake up any threads waiting either synchronously or + * asynchronously. Since we are providing data, turn off the + * AWAITED flag. If the data provided is not sufficient the + * clients will request again. Note we have to wake up ALL + * awaiting threads, not just one, so they can all reissue + * requests if needed. (In a properly designed app, at most one + * thread should be reading standard input but...) */ + handleInfoPtr->flags &= ~CONSOLE_DATA_AWAITED; + /* Wake synchronous channels */ + WakeAllConditionVariable(&handleInfoPtr->interpThreadCV); + /* + * Wake up async channels registered for file events. Note in + * order to follow the locking hierarchy, we need to release + * handleInfoPtr->lock before calling NudgeWatchers. + */ + consoleHandle = handleInfoPtr->console; + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + NudgeWatchers(consoleHandle); + AcquireSRWLockExclusive(&handleInfoPtr->lock); - infoPtr->readFlags |= CONSOLE_BUFFERED; - } else { - DWORD err = GetLastError(); - - if (err == (DWORD) EOF) { - infoPtr->readFlags = CONSOLE_EOF; - } - done = 1; + /* + * Loop back to recheck for exit conditions changes while the + * the lock was not held. + */ + continue; } - /* - * Signal the main thread by signalling the readable event and then - * waking up the notifier thread. - */ - - SetEvent(threadInfo->readyEvent); + assert(inputLen == 0); /* - * Alert the foreground thread. Note that we need to treat this like a - * critical section so the foreground thread does not terminate this - * thread while we are holding a mutex in the notifier code. + * Read more data in two cases: + * 1. The previous read filled the buffer and there could be more + * data in the console internal *text* buffer. Note + * ConsolePendingInput (checked in ConsoleDataAvailable) will NOT + * show this. It holds input events not yet translated to text. + * 2. Tcl threads want more data AND there is data in the + * ConsolePendingInput buffer. The latter check necessary because + * we do not want to read ahead because the interp thread might + * change the read mode, e.g. turning off echo for password + * input. So only do so if at least one interpreter has requested + * data. */ - - Tcl_MutexLock(&consoleMutex); - if (infoPtr->threadId != NULL) { + if (lastReadSize == sizeof(inputChars) + || ((handleInfoPtr->flags & CONSOLE_DATA_AWAITED) + && ConsoleDataAvailable(handleInfoPtr->console))) { + DWORD error; + /* Do not hold the lock while blocked in console */ + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + error = ReadConsoleChars(handleInfoPtr->console, + (WCHAR *)inputChars, + sizeof(inputChars) / sizeof(WCHAR), + &inputLen); + AcquireSRWLockExclusive(&handleInfoPtr->lock); + if (error == 0) { + inputLen *= sizeof(WCHAR); + lastReadSize = inputLen; + } + else { + /* + * We only store the last error. It is up to channel + * handlers whether to close or not in case of errors. + */ + lastReadSize = 0; + handleInfoPtr->lastError = error; + if (handleInfoPtr->lastError == ERROR_INVALID_HANDLE) { + handleInfoPtr->console = INVALID_HANDLE_VALUE; + } + } + } + else { /* - * TIP #218. When in flight ignore the event, no one will receive - * it anyway. + * Either no one was asking for data, or no data was available. + * In the former case, wait until someone wakes us asking for + * data. In the latter case, there is no alternative but to + * poll since ReadConsole does not support async operation. + * So sleep for a short while and loop back to retry. */ + sleepTime = + handleInfoPtr->flags & CONSOLE_DATA_AWAITED ? 50 : INFINITE; + SleepConditionVariableSRW(&handleInfoPtr->consoleThreadCV, + &handleInfoPtr->lock, + sleepTime, + 0); + } + + /* Loop again to check for exit or wait for readers to wake us */ + } - Tcl_ThreadAlert(infoPtr->threadId); + /* + * Exiting: + * - remove the console from global list + * - close the handle if still valid + * - release the structure + * Note there is not need to check for any watchers because we only + * exit when there are no channels open to this console. + */ + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + AcquireSRWLockExclusive(&gConsoleLock); /* Modifying - exclusive lock */ + for (iterator = &gConsoleHandleInfoList; *iterator; + iterator = &(*iterator)->nextPtr) { + if (*iterator == handleInfoPtr) { + *iterator = handleInfoPtr->nextPtr; + break; } - Tcl_MutexUnlock(&consoleMutex); } + ReleaseSRWLockExclusive(&gConsoleLock); - /* Worker exit, so inform the main thread or free TI-structure (if owned) */ - TclPipeThreadExit(&pipeTI); + /* No need for relocking - no other thread should have access to it now */ + RingBufferClear(&handleInfoPtr->buffer); + + if (handleInfoPtr->console != INVALID_HANDLE_VALUE + && handleInfoPtr->lastError != ERROR_INVALID_HANDLE) { + SetConsoleMode(handleInfoPtr->console, handleInfoPtr->initMode); + /* + * NOTE: we do not call CloseHandle(handleInfoPtr->console) here. + * As per the GetStdHandle documentation, it need not be closed. + * Other components may be directly using it. Note however that + * an explicit chan close script command does close the handle + * for all threads. + */ + } + + Tcl_Free(handleInfoPtr); return 0; } @@ -1210,89 +1842,259 @@ ConsoleReaderThread( * Always returns 0. * * Side effects: - - * Signals the main thread when an output operation is completed. May - * cause the main thread to wake up by posting a message. + * Signals the main thread when an output operation is completed. * *---------------------------------------------------------------------- */ - static DWORD WINAPI -ConsoleWriterThread( - LPVOID arg) +ConsoleWriterThread(LPVOID arg) { - TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg; - ConsoleInfo *infoPtr = NULL; /* access info only after success init/wait */ - HANDLE *handle = NULL; - ConsoleThreadInfo *threadInfo = NULL; - DWORD count, toWrite; - char *buf; - int done = 0; - - while (!done) { - /* - * Wait for the main thread to signal before attempting to write. - */ - if (!TclPipeThreadWaitForSignal(&pipeTI)) { - /* exit */ - break; - } - if (!infoPtr) { - infoPtr = (ConsoleInfo *)pipeTI->clientData; - handle = (HANDLE *)infoPtr->handle; - threadInfo = &infoPtr->writer; - } + ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg; + ConsoleHandleInfo **iterator; + BOOL success; + Tcl_Size numBytes; + /* + * This buffer size has no relation really with the size of the shared + * buffer. Could be bigger or smaller. Make larger as multiple threads + * could potentially be writing to it. + */ + char buffer[2*CONSOLE_BUFFER_SIZE]; - buf = infoPtr->writeBuf; - toWrite = infoPtr->toWrite; + /* + * Keep looping until one of the following happens. + * + * - there are not more channels listening on the console + * - the console handle has been closed + * + * On each iteration, + * - if the channel buffer is empty, wait for some channel writer to write + * - if there is data in our buffer, write it to the console + */ + + /* This thread is holding a reference so pointer is safe */ + AcquireSRWLockExclusive(&handleInfoPtr->lock); + while (1) { + /* handleInfoPtr->lock must be held on entry to loop */ + + int offset; + HANDLE consoleHandle; /* - * Loop until all of the bytes are written or an error occurs. + * Sadly, we need to do another copy because do not want to hold + * a lock on handleInfoPtr->buffer while calling WriteConsole as that + * might block. Also, we only want to copy an integral number of + * WCHAR's, i.e. even number of chars so do some length checks up + * front. */ - - while (toWrite > 0) { - if (WriteConsoleBytes(handle, buf, (DWORD) toWrite, - &count) == FALSE) { - infoPtr->writeError = GetLastError(); - done = 1; + numBytes = RingBufferLength(&handleInfoPtr->buffer); + numBytes &= ~1; /* Copy integral number of WCHARs -> even number of bytes */ + if (numBytes == 0) { + /* No data to write */ + if (handleInfoPtr->numRefs == 1) { + /* + * Sole reference. That's this thread. Exit since no clients + * and no buffered output. + */ break; } - toWrite -= count; - buf += count; + /* Wake up any threads waiting synchronously. */ + WakeConditionVariable(&handleInfoPtr->interpThreadCV); + success = SleepConditionVariableSRW(&handleInfoPtr->consoleThreadCV, + &handleInfoPtr->lock, + INFINITE, + 0); + /* Note: lock has been acquired again! */ + if (!success && GetLastError() != ERROR_TIMEOUT) { + /* TODO - what can be done? Should not happen */ + /* For now keep going */ + } + continue; } - /* - * Signal the main thread by signalling the writable event and then - * waking up the notifier thread. - */ - - SetEvent(threadInfo->readyEvent); + /* We have data to write */ + if ((size_t)numBytes > (sizeof(buffer) / sizeof(buffer[0]))) { + numBytes = sizeof(buffer); + } + /* No need to check result, we already checked length bytes available */ + RingBufferOut(&handleInfoPtr->buffer, buffer, numBytes, 0); + + consoleHandle = handleInfoPtr->console; + WakeConditionVariable(&handleInfoPtr->interpThreadCV); + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + offset = 0; + while (numBytes > 0) { + Tcl_Size numWChars = numBytes / sizeof(WCHAR); + DWORD status; + status = WriteConsoleChars(handleInfoPtr->console, + (WCHAR *)(offset + buffer), + numWChars, + &numWChars); + if (status != 0) { + /* Only overwrite if no previous error */ + if (handleInfoPtr->lastError == 0) { + handleInfoPtr->lastError = status; + } + if (status == ERROR_INVALID_HANDLE) { + handleInfoPtr->console = INVALID_HANDLE_VALUE; + } + /* Assume this write is done but keep looping in case + * it is a transient error. Not sure just closing handle + * and exiting thread is a good idea until all references + * from interp threads are gone. + */ + break; + } + numBytes -= numWChars * sizeof(WCHAR); + offset += numWChars * sizeof(WCHAR); + } + /* Wake up any threads waiting synchronously. */ + WakeConditionVariable(&handleInfoPtr->interpThreadCV); /* - * Alert the foreground thread. Note that we need to treat this like a - * critical section so the foreground thread does not terminate this - * thread while we are holding a mutex in the notifier code. + * Wake up all channels registered for file events. Note in + * order to follow the locking hierarchy, we cannot hold any locks + * when calling NudgeWatchers. */ + NudgeWatchers(consoleHandle); - Tcl_MutexLock(&consoleMutex); - if (infoPtr->threadId != NULL) { - /* - * TIP #218. When in flight ignore the event, no one will receive - * it anyway. - */ + AcquireSRWLockExclusive(&handleInfoPtr->lock); + } - Tcl_ThreadAlert(infoPtr->threadId); + /* + * Exiting: + * - remove the console from global list + * - release the structure + * NOTE: we do not call CloseHandle(handleInfoPtr->console) here. + * As per the GetStdHandle documentation, it need not be closed. + * Other components may be directly using it. Note however that + * an explicit chan close script command does close the handle + * for all threads. + */ + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + AcquireSRWLockExclusive(&gConsoleLock); /* Modifying - exclusive lock */ + for (iterator = &gConsoleHandleInfoList; *iterator; + iterator = &(*iterator)->nextPtr) { + if (*iterator == handleInfoPtr) { + *iterator = handleInfoPtr->nextPtr; + break; } - Tcl_MutexUnlock(&consoleMutex); } + ReleaseSRWLockExclusive(&gConsoleLock); + + RingBufferClear(&handleInfoPtr->buffer); - /* Worker exit, so inform the main thread or free TI-structure (if owned) */ - TclPipeThreadExit(&pipeTI); + Tcl_Free(handleInfoPtr); return 0; } /* + *------------------------------------------------------------------------ + * + * AllocateConsoleHandleInfo -- + * + * Allocates a ConsoleHandleInfo for the passed console handle. As + * a side effect starts a console thread to handle i/o on the handle. + * + * Important: Caller must be holding an EXCLUSIVE lock on gConsoleLock + * when calling this function. The lock continues to be held on return. + * + * Results: + * Pointer to an unlocked ConsoleHandleInfo structure. The reference + * count on the structure is 1. This corresponds to the common reference + * from the console thread and the gConsoleHandleInfoList. Returns NULL + * on error. + * + * Side effects: + * A console reader or writer thread is started. The returned structure + * is placed on the active console handler list gConsoleHandleInfoList. + * + *------------------------------------------------------------------------ + */ +static ConsoleHandleInfo * +AllocateConsoleHandleInfo( + HANDLE consoleHandle, + int permissions) /* TCL_READABLE or TCL_WRITABLE */ +{ + ConsoleHandleInfo *handleInfoPtr; + DWORD consoleMode; + + + handleInfoPtr = (ConsoleHandleInfo *)Tcl_Alloc(sizeof(*handleInfoPtr)); + memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); + memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); + handleInfoPtr->console = consoleHandle; + InitializeSRWLock(&handleInfoPtr->lock); + InitializeConditionVariable(&handleInfoPtr->consoleThreadCV); + InitializeConditionVariable(&handleInfoPtr->interpThreadCV); + RingBufferInit(&handleInfoPtr->buffer, CONSOLE_BUFFER_SIZE); + handleInfoPtr->lastError = 0; + handleInfoPtr->permissions = permissions; + handleInfoPtr->numRefs = 1; /* See function header */ + if (permissions == TCL_READABLE) { + GetConsoleMode(consoleHandle, &handleInfoPtr->initMode); + consoleMode = handleInfoPtr->initMode; + consoleMode &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); + consoleMode |= ENABLE_LINE_INPUT; + SetConsoleMode(consoleHandle, consoleMode); + } + handleInfoPtr->consoleThread = CreateThread( + NULL, /* default security descriptor */ + 2*CONSOLE_BUFFER_SIZE, /* Stack size - gets rounded up to granularity */ + permissions == TCL_READABLE ? ConsoleReaderThread : ConsoleWriterThread, + handleInfoPtr, /* Pass to thread */ + 0, /* Flags - no special cases */ + NULL); /* Don't care about thread id */ + if (handleInfoPtr->consoleThread == NULL) { + /* Note - SRWLock and condition variables do not need finalization */ + RingBufferClear(&handleInfoPtr->buffer); + Tcl_Free(handleInfoPtr); + return NULL; + } + + /* Chain onto global list */ + handleInfoPtr->nextPtr = gConsoleHandleInfoList; + gConsoleHandleInfoList = handleInfoPtr; + + return handleInfoPtr; +} + +/* + *------------------------------------------------------------------------ + * + * FindConsoleInfo -- + * + * Finds the ConsoleHandleInfo record for a given ConsoleChannelInfo. + * The found record must match the console handle. It is the caller's + * responsibility to check the permissions (read/write) in the returned + * ConsoleHandleInfo match permissions in chanInfoPtr. This function does + * not check that. + * + * Important: Caller must be holding an shared or exclusive lock on + * gConsoleMutex. That ensures the returned pointer stays valid on + * return without risk of deallocation by other threads. + * + * Results: + * Pointer to the found ConsoleHandleInfo or NULL if not found + * + * Side effects: + * None. + * + *------------------------------------------------------------------------ + */ +static ConsoleHandleInfo * +FindConsoleInfo(const ConsoleChannelInfo *chanInfoPtr) +{ + ConsoleHandleInfo *handleInfoPtr; + for (handleInfoPtr = gConsoleHandleInfoList; handleInfoPtr; handleInfoPtr = handleInfoPtr->nextPtr) { + if (handleInfoPtr->console == chanInfoPtr->handle) { + return handleInfoPtr; + } + } + return NULL; +} + +/* *---------------------------------------------------------------------- * * TclWinOpenConsoleChannel -- @@ -1309,33 +2111,30 @@ ConsoleWriterThread( * *---------------------------------------------------------------------- */ - Tcl_Channel TclWinOpenConsoleChannel( HANDLE handle, char *channelName, int permissions) { - char encoding[4 + TCL_INTEGER_SPACE]; - ConsoleInfo *infoPtr; - DWORD modes; + ConsoleChannelInfo *chanInfoPtr; + ConsoleHandleInfo *handleInfoPtr; - ConsoleInit(); - - /* - * See if a channel with this handle already exists. - */ + /* A console handle can either be input or output, not both */ + if (permissions != TCL_READABLE && permissions != TCL_WRITABLE) { + return NULL; + } - infoPtr = (ConsoleInfo *)ckalloc(sizeof(ConsoleInfo)); - memset(infoPtr, 0, sizeof(ConsoleInfo)); + ConsoleInit(); - infoPtr->validMask = permissions; - infoPtr->handle = handle; - infoPtr->channel = (Tcl_Channel) NULL; + chanInfoPtr = (ConsoleChannelInfo *)Tcl_Alloc(sizeof(*chanInfoPtr)); + memset(chanInfoPtr, 0, sizeof(*chanInfoPtr)); - wsprintfA(encoding, "cp%d", GetConsoleCP()); + chanInfoPtr->permissions = permissions; + chanInfoPtr->handle = handle; + chanInfoPtr->channel = (Tcl_Channel) NULL; - infoPtr->threadId = Tcl_GetCurrentThread(); + chanInfoPtr->threadId = Tcl_GetCurrentThread(); /* * Use the pointer for the name of the result channel. This keeps the @@ -1343,10 +2142,7 @@ TclWinOpenConsoleChannel( * for instance). */ - sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); - - infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, - infoPtr, permissions); + TclWinGenerateChannelName(channelName, "file", chanInfoPtr); if (permissions & TCL_READABLE) { /* @@ -1355,38 +2151,75 @@ TclWinOpenConsoleChannel( * we only want to catch when complete lines are ready for reading. */ - infoPtr->flags |= CONSOLE_READ_OPS; - GetConsoleMode(infoPtr->handle, &infoPtr->initMode); - modes = infoPtr->initMode; - modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); - modes |= ENABLE_LINE_INPUT; - SetConsoleMode(infoPtr->handle, modes); - - infoPtr->reader.readyEvent = CreateEventW(NULL, TRUE, TRUE, NULL); - infoPtr->reader.thread = CreateThread(NULL, 256, ConsoleReaderThread, - TclPipeThreadCreateTI(&infoPtr->reader.TI, infoPtr, - infoPtr->reader.readyEvent), 0, NULL); + chanInfoPtr->flags |= CONSOLE_READ_OPS; + GetConsoleMode(handle, &chanInfoPtr->initMode); + +#ifdef OBSOLETE + /* Why was priority being set on console input? Code smell */ SetThreadPriority(infoPtr->reader.thread, THREAD_PRIORITY_HIGHEST); +#endif + } else { + /* Already checked permissions is WRITABLE if not READABLE */ + /* TODO - enable ansi escape processing? */ } - if (permissions & TCL_WRITABLE) { + /* + * Global lock but that's ok. See comments top of file. Allocations + * will happen only a few times in the life of a process and that too + * generally at start up where only one thread is active. + */ + AcquireSRWLockExclusive(&gConsoleLock); /*Allocate needs exclusive lock */ - infoPtr->writer.readyEvent = CreateEventW(NULL, TRUE, TRUE, NULL); - infoPtr->writer.thread = CreateThread(NULL, 256, ConsoleWriterThread, - TclPipeThreadCreateTI(&infoPtr->writer.TI, infoPtr, - infoPtr->writer.readyEvent), 0, NULL); - SetThreadPriority(infoPtr->writer.thread, THREAD_PRIORITY_HIGHEST); + handleInfoPtr = FindConsoleInfo(chanInfoPtr); + if (handleInfoPtr == NULL) { + /* Not found. Allocate one */ + handleInfoPtr = AllocateConsoleHandleInfo(handle, permissions); + } else { + /* Found. Its direction (read/write) better be the same */ + if (handleInfoPtr->permissions != permissions) { + handleInfoPtr = NULL; + } + } + + if (handleInfoPtr == NULL) { + ReleaseSRWLockExclusive(&gConsoleLock); + if (permissions == TCL_READABLE) { + SetConsoleMode(handle, chanInfoPtr->initMode); + } + Tcl_Free(chanInfoPtr); + return NULL; } /* - * Files have default translation of AUTO and ^Z eof char, which means + * There is effectively a reference to this structure from the Tcl + * channel subsystem. So record that. This reference will be dropped + * when the Tcl channel is closed. + */ + chanInfoPtr->numRefs = 1; + + /* + * Need to keep track of number of referencing channels for closing. + * The pointer is safe since there is a reference held to it from + * gConsoleHandleInfoList but still need to lock the structure itself + */ + AcquireSRWLockExclusive(&handleInfoPtr->lock); + handleInfoPtr->numRefs += 1; + ReleaseSRWLockExclusive(&handleInfoPtr->lock); + + ReleaseSRWLockExclusive(&gConsoleLock); + + /* Note Tcl_CreateChannel never fails other than panic on error */ + chanInfoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, + chanInfoPtr, permissions); + + /* + * Consoles have default translation of auto and ^Z eof char, which means * that a ^Z will be accepted as EOF when reading. */ - Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "utf-16"); - return infoPtr->channel; + Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-translation", "auto"); + Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-encoding", "utf-16"); + return chanInfoPtr->channel; } /* @@ -1407,36 +2240,18 @@ TclWinOpenConsoleChannel( static void ConsoleThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { - ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; - - /* - * We do not access firstConsolePtr in the thread structures. This is not - * for all serials managed by the thread, but only those we are watching. - * Removal of the filevent handlers before transfer thus takes care of - * this structure. - */ + ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; - Tcl_MutexLock(&consoleMutex); + /* No need for any locks as no other thread will be writing to it */ if (action == TCL_CHANNEL_THREAD_INSERT) { - /* - * We can't copy the thread information from the channel when the - * channel is created. At this time the channel back pointer has not - * been set yet. However in that case the threadId has already been - * set by TclpCreateCommandChannel itself, so the structure is still - * good. - */ - - ConsoleInit(); - if (infoPtr->channel != NULL) { - infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel); - } + ConsoleInit(); /* Needed to set up event source handlers for this thread */ + chanInfoPtr->threadId = Tcl_GetCurrentThread(); } else { - infoPtr->threadId = NULL; + chanInfoPtr->threadId = NULL; } - Tcl_MutexUnlock(&consoleMutex); } /* @@ -1456,15 +2271,14 @@ ConsoleThreadActionProc( * *---------------------------------------------------------------------- */ - static int ConsoleSetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ { - ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; + ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; int len = strlen(optionName); int vlen = strlen(value); @@ -1472,11 +2286,11 @@ ConsoleSetOptionProc( * Option -inputmode normal|password|raw */ - if ((infoPtr->flags & CONSOLE_READ_OPS) && (len > 1) && + if ((chanInfoPtr->flags & CONSOLE_READ_OPS) && (len > 1) && (strncmp(optionName, "-inputmode", len) == 0)) { DWORD mode; - if (GetConsoleMode(infoPtr->handle, &mode) == 0) { + if (GetConsoleMode(chanInfoPtr->handle, &mode) == 0) { Tcl_WinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1485,30 +2299,30 @@ ConsoleSetOptionProc( } return TCL_ERROR; } - if (Tcl_UtfNcasecmp(value, "NORMAL", vlen) == 0) { - mode |= ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT; - } else if (Tcl_UtfNcasecmp(value, "PASSWORD", vlen) == 0) { - mode |= ENABLE_LINE_INPUT; + if (strncasecmp(value, "NORMAL", vlen) == 0) { + mode |= + ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT | ENABLE_PROCESSED_INPUT; + } else if (strncasecmp(value, "PASSWORD", vlen) == 0) { + mode |= ENABLE_LINE_INPUT|ENABLE_PROCESSED_INPUT; mode &= ~ENABLE_ECHO_INPUT; - } else if (Tcl_UtfNcasecmp(value, "RAW", vlen) == 0) { - mode &= ~(ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT); - } else if (Tcl_UtfNcasecmp(value, "RESET", vlen) == 0) { + } else if (strncasecmp(value, "RAW", vlen) == 0) { + mode &= ~(ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT | ENABLE_PROCESSED_INPUT); + } else if (strncasecmp(value, "RESET", vlen) == 0) { /* * Reset to the initial mode, whatever that is. */ - - mode = infoPtr->initMode; + mode = chanInfoPtr->initMode; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad mode \"%s\" for -inputmode: must be" " normal, password, raw, or reset", value)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", - "VALUE", NULL); + "VALUE", (void *)NULL); } return TCL_ERROR; } - if (SetConsoleMode(infoPtr->handle, mode) == 0) { + if (SetConsoleMode(chanInfoPtr->handle, mode) == 0) { Tcl_WinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1518,19 +2332,10 @@ ConsoleSetOptionProc( return TCL_ERROR; } - /* - * If we've changed the mode from default, schedule a reset later. - */ - - if (mode == infoPtr->initMode) { - infoPtr->flags &= ~CONSOLE_RESET; - } else { - infoPtr->flags |= CONSOLE_RESET; - } return TCL_OK; } - if (infoPtr->flags & CONSOLE_READ_OPS) { + if (chanInfoPtr->flags & CONSOLE_READ_OPS) { return Tcl_BadChannelOption(interp, optionName, "inputmode"); } else { return Tcl_BadChannelOption(interp, optionName, ""); @@ -1557,12 +2362,12 @@ ConsoleSetOptionProc( static int ConsoleGetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { - ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; + ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; int valid = 0; /* Flag if valid option parsed. */ unsigned int len; char buf[TCL_INTEGER_SPACE]; @@ -1580,7 +2385,7 @@ ConsoleGetOptionProc( * represents what almost all scripts really want to know. */ - if (infoPtr->flags & CONSOLE_READ_OPS) { + if (chanInfoPtr->flags & CONSOLE_READ_OPS) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-inputmode"); } @@ -1588,7 +2393,7 @@ ConsoleGetOptionProc( DWORD mode; valid = 1; - if (GetConsoleMode(infoPtr->handle, &mode) == 0) { + if (GetConsoleMode(chanInfoPtr->handle, &mode) == 0) { Tcl_WinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1607,42 +2412,52 @@ ConsoleGetOptionProc( Tcl_DStringAppendElement(dsPtr, "raw"); } } - } - - /* - * Get option -winsize - * Option is readonly and returned by [fconfigure chan -winsize] but not - * returned by [fconfigure chan] without explicit option name. - */ + } else { + /* + * Output channel. Get option -winsize + * Option is readonly and returned by [fconfigure chan -winsize] but not + * returned by [fconfigure chan] without explicit option name. + */ + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-winsize"); + } - if ((len > 1) && (strncmp(optionName, "-winsize", len) == 0)) { - CONSOLE_SCREEN_BUFFER_INFO consoleInfo; + if (len == 0 || (len > 1 && strncmp(optionName, "-winsize", len) == 0)) { + CONSOLE_SCREEN_BUFFER_INFO consoleInfo; - valid = 1; - if (!GetConsoleScreenBufferInfo(infoPtr->handle, &consoleInfo)) { - Tcl_WinConvertError(GetLastError()); - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read console size: %s", - Tcl_PosixError(interp))); + valid = 1; + if (!GetConsoleScreenBufferInfo(chanInfoPtr->handle, + &consoleInfo)) { + Tcl_WinConvertError(GetLastError()); + if (interp != NULL) { + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("couldn't read console size: %s", + Tcl_PosixError(interp))); + } + return TCL_ERROR; } - return TCL_ERROR; + Tcl_DStringStartSublist(dsPtr); + snprintf(buf, sizeof(buf), + "%d", + consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1); + Tcl_DStringAppendElement(dsPtr, buf); + snprintf(buf, sizeof(buf), + "%d", + consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1); + Tcl_DStringAppendElement(dsPtr, buf); + Tcl_DStringEndSublist(dsPtr); } - sprintf(buf, "%d", - consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1); - Tcl_DStringAppendElement(dsPtr, buf); - sprintf(buf, "%d", - consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1); - Tcl_DStringAppendElement(dsPtr, buf); } + if (valid) { return TCL_OK; } - if (infoPtr->flags & CONSOLE_READ_OPS) { - return Tcl_BadChannelOption(interp, optionName, "inputmode winsize"); + if (chanInfoPtr->flags & CONSOLE_READ_OPS) { + return Tcl_BadChannelOption(interp, optionName, "inputmode"); } else { - return Tcl_BadChannelOption(interp, optionName, ""); + return Tcl_BadChannelOption(interp, optionName, "winsize"); } } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 2570954..d883bac 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -79,7 +79,7 @@ static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.4.4" +#define TCL_DDE_VERSION "1.4.5" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME L"TclEval" #define TCL_DDE_EXECUTE_RESULT L"$TCLEVAL$EXECUTE$RESULT" @@ -90,8 +90,24 @@ static int ddeIsServer = 0; TCL_DECLARE_MUTEX(ddeMutex) +#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) +# if TCL_UTF_MAX > 3 +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) +# else +# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString +# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString +# endif +#ifndef Tcl_Size +# define Tcl_Size int +#endif +#ifndef Tcl_CreateObjCommand2 +# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand +#endif +#endif + /* - * Forward declarations for functions defined later in this file. + * Declarations for functions defined in this file. */ static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, @@ -114,43 +130,19 @@ static int MakeDdeConnection(Tcl_Interp *interp, const WCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(void *clientData, - Tcl_Interp *interp, int objc, + Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); -#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) -# if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) -# else -# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString -# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString -# endif -#endif - -static unsigned char * -getByteArrayFromObj( - Tcl_Obj *objPtr, - size_t *lengthPtr -) { - int length; - - unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length); -#if TCL_MAJOR_VERSION > 8 - if (sizeof(TCL_HASH_TYPE) > sizeof(int)) { - /* 64-bit and TIP #494 situation: */ - *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1; - } else -#endif - /* 32-bit or without TIP #494 */ - *lengthPtr = (size_t) (unsigned) length; - return result; -} - #ifdef __cplusplus extern "C" { #endif DLLEXPORT int Dde_Init(Tcl_Interp *interp); DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); +#if TCL_MAJOR_VERSION < 9 +/* With those additional entries, "load tcldde14.dll" works without 3th argument */ +DLLEXPORT int Tcldde_Init(Tcl_Interp *interp); +DLLEXPORT int Tcldde_SafeInit(Tcl_Interp *interp); +#endif #ifdef __cplusplus } #endif @@ -175,14 +167,22 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.5", 0)) { + if (!Tcl_InitStubs(interp, "8.5-", 0)) { return TCL_ERROR; } - Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } +#if TCL_MAJOR_VERSION < 9 +int +Tcldde_Init( + Tcl_Interp *interp) +{ + return Dde_Init(interp); +} +#endif /* *---------------------------------------------------------------------- @@ -210,6 +210,14 @@ Dde_SafeInit( } return result; } +#if TCL_MAJOR_VERSION < 9 +int +Tcldde_SafeInit( + Tcl_Interp *interp) +{ + return Dde_SafeInit(interp); +} +#endif /* *---------------------------------------------------------------------- @@ -309,12 +317,13 @@ DdeSetServerName( Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { - int suffix, offset; + int suffix; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; const WCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; - int n, srvCount = 0, lastSuffix, r = TCL_OK; + Tcl_Size n, srvCount = 0, offset; + int lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* @@ -440,7 +449,7 @@ DdeSetServerName( Tcl_ExposeCommand(interp, "dde", "dde"); } - Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, + Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd, riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); @@ -569,7 +578,7 @@ ExecuteRemoteObject( Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: " "a handler procedure must be defined for use in a safe " "interp", -1)); - Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL); + Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", (void *)NULL); result = TCL_ERROR; } @@ -647,7 +656,7 @@ DdeServerProc( /* Transaction-dependent data. */ { Tcl_DString dString; - size_t len; + Tcl_Size len; DWORD dlen; WCHAR *utilString; Tcl_Obj *ddeObjectPtr; @@ -767,8 +776,7 @@ DdeServerProc( CP_WINUNICODE); if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { returnString = - Tcl_GetString(convPtr->returnPackagePtr); - len = convPtr->returnPackagePtr->length; + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); if (uFmt != CF_TEXT) { Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(returnString, len, &dsBuf); @@ -790,8 +798,7 @@ DdeServerProc( convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - returnString = Tcl_GetString(variableObjPtr); - len = variableObjPtr->length; + returnString = Tcl_GetStringFromObj(variableObjPtr, &len); if (uFmt != CF_TEXT) { Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(returnString, len, &dsBuf); @@ -868,7 +875,7 @@ DdeServerProc( case XTYP_EXECUTE: { /* * Execute this script. The results will be saved into a list object - * which will be retreived later. See ExecuteRemoteObject. + * which will be retrieved later. See ExecuteRemoteObject. */ Tcl_Obj *returnPackagePtr; @@ -891,13 +898,13 @@ DdeServerProc( /* Empty binary array. */ ddeObjectPtr = Tcl_NewObj(); } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { - /* Cannot be unicode, so assume utf-8 */ + /* Cannot be Unicode, so assume utf-8 */ if (!string[dlen-1]) { dlen--; } ddeObjectPtr = Tcl_NewStringObj(string, dlen); } else { - /* unicode */ + /* Unicode */ Tcl_DString dsBuf; Tcl_DStringInit(&dsBuf); @@ -939,8 +946,8 @@ DdeServerProc( */ HSZPAIR *returnPtr; - int i; - int numItems; + Tcl_Size i; + DWORD numItems; for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL; i++, riPtr = riPtr->nextPtr) { @@ -949,12 +956,15 @@ DdeServerProc( */ } - numItems = i; + if ((size_t)i >= UINT_MAX/sizeof(HSZPAIR)) { + return NULL; + } + numItems = (DWORD)i; ddeReturn = DdeCreateDataHandle(ddeInstance, NULL, - (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0); + (numItems + 1) * (DWORD)sizeof(HSZPAIR), 0, 0, 0, 0); returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen); len = dlen; - for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; + for (i = 0, riPtr = tsdPtr->interpListPtr; i < (Tcl_Size)numItems; i++, riPtr = riPtr->nextPtr) { returnPtr[i].hszSvc = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); @@ -1040,7 +1050,7 @@ MakeDdeConnection( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no registered server named \"%s\"", Tcl_DStringValue(&dString))); Tcl_DStringFree(&dString); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (void *)NULL); } return TCL_ERROR; } @@ -1271,7 +1281,7 @@ SetDdeError( } Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, (void *)NULL); } /* @@ -1295,12 +1305,11 @@ static int DdeObjCmd( void *dummy, /* Not used. */ Tcl_Interp *interp, /* The interp we are sending from */ - int objc, /* Number of arguments */ + Tcl_Size objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { static const char *const ddeCommands[] = { - "servername", "execute", "poke", "request", "services", "eval", - (char *) NULL}; + "servername", "execute", "poke", "request", "services", "eval", NULL}; enum DdeSubcommands { DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL @@ -1324,8 +1333,8 @@ DdeObjCmd( "-binary", NULL }; - int index, i, argIndex; - size_t length; + int index, argIndex; + Tcl_Size length, i; int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; @@ -1488,9 +1497,8 @@ DdeObjCmd( Initialize(); if (firstArg != 1) { - const char *src = Tcl_GetString(objv[firstArg]); + const char *src = Tcl_GetStringFromObj(objv[firstArg], &length); - length = objv[firstArg]->length; Tcl_DStringInit(&serviceBuf); Tcl_UtfToWCharDString(src, length, &serviceBuf); serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf); @@ -1507,9 +1515,8 @@ DdeObjCmd( } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - const char *src = Tcl_GetString(objv[firstArg + 1]); + const char *src = Tcl_GetStringFromObj(objv[firstArg + 1], &length); - length = objv[firstArg + 1]->length; Tcl_DStringInit(&topicBuf); topicName = Tcl_UtfToWCharDString(src, length, &topicBuf); length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR); @@ -1539,19 +1546,18 @@ DdeObjCmd( break; case DDE_EXECUTE: { - size_t dataLength; + Tcl_Size dataLength; const void *dataString; Tcl_DString dsBuf; Tcl_DStringInit(&dsBuf); if (flags & DDE_FLAG_BINARY) { dataString = - getByteArrayFromObj(objv[firstArg + 2], &dataLength); + Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength); } else { const char *src; - src = Tcl_GetString(objv[firstArg + 2]); - dataLength = objv[firstArg + 2]->length; + src = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength); Tcl_DStringInit(&dsBuf); dataString = Tcl_UtfToWCharDString(src, dataLength, &dsBuf); @@ -1562,7 +1568,7 @@ DdeObjCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); Tcl_DStringFree(&dsBuf); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); result = TCL_ERROR; break; } @@ -1604,8 +1610,7 @@ DdeObjCmd( const WCHAR *itemString; const char *src; - src = Tcl_GetString(objv[firstArg + 2]); - length = objv[firstArg + 2]->length; + src = Tcl_GetStringFromObj(objv[firstArg + 2], &length); Tcl_DStringInit(&itemBuf); itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); @@ -1613,7 +1618,7 @@ DdeObjCmd( if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot request value of null data", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); result = TCL_ERROR; goto cleanup; } @@ -1646,7 +1651,7 @@ DdeObjCmd( if ((tmp >= sizeof(WCHAR)) && !dataString[tmp / sizeof(WCHAR) - 1]) { - tmp -= sizeof(WCHAR); + tmp -= (DWORD)sizeof(WCHAR); } Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(dataString, tmp>>1, &dsBuf); @@ -1672,26 +1677,24 @@ DdeObjCmd( BYTE *dataString; const char *src; - src = Tcl_GetString(objv[firstArg + 2]); - length = objv[firstArg + 2]->length; + src = Tcl_GetStringFromObj(objv[firstArg + 2], &length); Tcl_DStringInit(&itemBuf); itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot have a null item", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); result = TCL_ERROR; goto cleanup; } Tcl_DStringInit(&dsBuf); if (flags & DDE_FLAG_BINARY) { dataString = (BYTE *) - getByteArrayFromObj(objv[firstArg + 3], &length); + Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length); } else { const char *data = - Tcl_GetString(objv[firstArg + 3]); - length = objv[firstArg + 3]->length; + Tcl_GetStringFromObj(objv[firstArg + 3], &length); Tcl_DStringInit(&dsBuf); dataString = (BYTE *) Tcl_UtfToWCharDString(data, length, &dsBuf); @@ -1735,7 +1738,7 @@ DdeObjCmd( if (serviceName == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid service name \"\"", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (void *)NULL); result = TCL_ERROR; goto cleanup; } @@ -1784,14 +1787,14 @@ DdeObjCmd( "permission denied: a handler procedure must be" " defined for use in a safe interp", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", - NULL); + (void *)NULL); result = TCL_ERROR; } if (result == TCL_OK) { - if (objc == 1) + if (objc == 1) { objPtr = objv[0]; - else { + } else { objPtr = Tcl_ConcatObj(objc, objv); } if (riPtr->handlerPtr != NULL) { @@ -1849,14 +1852,13 @@ DdeObjCmd( invalidServerResponse: Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid data returned from server", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", (void *)NULL); result = TCL_ERROR; goto cleanup; } objPtr = Tcl_ConcatObj(objc, objv); - string = Tcl_GetString(objPtr); - length = objPtr->length; + string = Tcl_GetStringFromObj(objPtr, &length); Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(string, length, &dsBuf); string = Tcl_DStringValue(&dsBuf); @@ -1906,7 +1908,7 @@ DdeObjCmd( length = DdeGetData(ddeData, NULL, 0, 0); ddeDataString = (WCHAR *) Tcl_Alloc(length); DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); - if (length > sizeof(WCHAR)) { + if (length > (Tcl_Size)sizeof(WCHAR)) { length -= sizeof(WCHAR); } Tcl_DStringInit(&dsBuf); diff --git a/win/tclWinError.c b/win/tclWinError.c index 7e5898b..3e75a85 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -351,9 +351,9 @@ void Tcl_WinConvertError( unsigned errCode) /* Win32 error code. */ { - if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { + if ((unsigned)errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { errCode -= WSAEWOULDBLOCK; - if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) { + if ((unsigned)errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) { Tcl_SetErrno(errorTable[1]); } else { Tcl_SetErrno(wsaErrorTable[errCode]); @@ -381,7 +381,7 @@ Tcl_WinConvertError( *---------------------------------------------------------------------- */ -TCL_NORETURN void +void tclWinDebugPanic( const char *format, ...) { @@ -413,12 +413,6 @@ 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 3f6d7f4..4cb23ea 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -56,7 +56,7 @@ static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDD const char *const tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", - "-shortname", "-system", (char *) NULL + "-shortname", "-system", NULL }; const TclFileAttrProcs tclpFileAttrProcs[] = { @@ -309,7 +309,8 @@ DoRenameFile( if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { WCHAR *nativeSrcRest, *nativeDstRest; const char **srcArgv, **dstArgv; - int size, srcArgc, dstArgc; + size_t size; + Tcl_Size srcArgc, dstArgc; WCHAR nativeSrcPath[MAX_PATH]; WCHAR nativeDstPath[MAX_PATH]; Tcl_DString srcString, dstString; @@ -330,8 +331,8 @@ DoRenameFile( Tcl_DStringInit(&srcString); Tcl_DStringInit(&dstString); - src = Tcl_WCharToUtfDString(nativeSrcPath, -1, &srcString); - dst = Tcl_WCharToUtfDString(nativeDstPath, -1, &dstString); + src = Tcl_WCharToUtfDString(nativeSrcPath, TCL_INDEX_NONE, &srcString); + dst = Tcl_WCharToUtfDString(nativeDstPath, TCL_INDEX_NONE, &dstString); /* * Check whether the destination path is actually inside the @@ -378,8 +379,8 @@ DoRenameFile( Tcl_SetErrno(EXDEV); } - ckfree(srcArgv); - ckfree(dstArgv); + Tcl_Free((void *)srcArgv); + Tcl_Free((void *)dstArgv); } /* @@ -879,7 +880,7 @@ DoCreateDirectory( * * Recursively copies a directory. The target directory dst must not * already exist. Note that this function does not merge two directory - * hierarchies, even if the target directory is an an empty directory. + * hierarchies, even if the target directory is an empty directory. * * Results: * If the directory was successfully copied, returns TCL_OK. Otherwise @@ -915,8 +916,8 @@ TclpObjCopyDirectory( Tcl_DStringInit(&srcString); Tcl_DStringInit(&dstString); - Tcl_UtfToWCharDString(Tcl_GetString(normSrcPtr), -1, &srcString); - Tcl_UtfToWCharDString(Tcl_GetString(normDestPtr), -1, &dstString); + Tcl_UtfToWCharDString(TclGetString(normSrcPtr), TCL_INDEX_NONE, &srcString); + Tcl_UtfToWCharDString(TclGetString(normDestPtr), TCL_INDEX_NONE, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); @@ -929,7 +930,7 @@ TclpObjCopyDirectory( } else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) { *errorPtr = destPathPtr; } else { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_INDEX_NONE); } Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); @@ -989,7 +990,7 @@ TclpObjRemoveDirectory( return TCL_ERROR; } Tcl_DStringInit(&native); - Tcl_UtfToWCharDString(Tcl_GetString(normPtr), -1, &native); + Tcl_UtfToWCharDString(TclGetString(normPtr), TCL_INDEX_NONE, &native); ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { @@ -1002,7 +1003,7 @@ TclpObjRemoveDirectory( !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) { *errorPtr = pathPtr; } else { - *errorPtr = TclDStringToObj(&ds); + *errorPtr = Tcl_DStringToObj(&ds); } Tcl_IncrRefCount(*errorPtr); } @@ -1117,7 +1118,7 @@ DoRemoveJustDirectory( char *p; Tcl_DStringInit(errorPtr); - p = Tcl_WCharToUtfDString(nativePath, -1, errorPtr); + p = Tcl_WCharToUtfDString(nativePath, TCL_INDEX_NONE, errorPtr); for (; *p; ++p) { if (*p == '\\') *p = '/'; } @@ -1332,7 +1333,7 @@ TraverseWinTree( Tcl_WinConvertError(GetLastError()); if (errorPtr != NULL) { Tcl_DStringInit(errorPtr); - Tcl_WCharToUtfDString(nativeErrfile, -1, errorPtr); + Tcl_WCharToUtfDString(nativeErrfile, TCL_INDEX_NONE, errorPtr); } result = TCL_ERROR; } @@ -1398,7 +1399,7 @@ TraversalCopy( if (errorPtr != NULL) { Tcl_DStringInit(errorPtr); - Tcl_WCharToUtfDString(nativeDst, -1, errorPtr); + Tcl_WCharToUtfDString(nativeDst, TCL_INDEX_NONE, errorPtr); } return TCL_ERROR; } @@ -1454,7 +1455,7 @@ TraversalDelete( if (errorPtr != NULL) { Tcl_DStringInit(errorPtr); - Tcl_WCharToUtfDString(nativeSrc, -1, errorPtr); + Tcl_WCharToUtfDString(nativeSrc, TCL_INDEX_NONE, errorPtr); } return TCL_ERROR; } @@ -1535,8 +1536,8 @@ GetWinFileAttributes( * We test for, and fix that case, here. */ - int len; - const char *str = TclGetStringFromObj(fileName, &len); + Tcl_Size len; + const char *str = Tcl_GetStringFromObj(fileName, &len); if (len < 4) { if (len == 0) { @@ -1595,7 +1596,7 @@ ConvertFileNameFormat( int longShort, /* 0 to short name, 1 to long name. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { - int pathc, i; + Tcl_Size pathc, i, length; Tcl_Obj *splitPath; splitPath = Tcl_FSSplitPath(fileName, &pathc); @@ -1604,7 +1605,7 @@ ConvertFileNameFormat( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", - Tcl_GetString(fileName))); + TclGetString(fileName))); errno = ENOENT; Tcl_PosixError(interp); } @@ -1621,11 +1622,10 @@ ConvertFileNameFormat( for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; - int length; Tcl_ListObjIndex(NULL, splitPath, i, &elt); - pathv = TclGetStringFromObj(elt, &length); + pathv = Tcl_GetStringFromObj(elt, &length); if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':')) || (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) { /* @@ -1661,7 +1661,7 @@ ConvertFileNameFormat( * likely to lead to infinite loops. */ - tempString = TclGetStringFromObj(tempPath, &length); + tempString = Tcl_GetStringFromObj(tempPath, &length); Tcl_DStringInit(&ds); nativeName = Tcl_UtfToWCharDString(tempString, length, &ds); Tcl_DecrRefCount(tempPath); @@ -1712,27 +1712,16 @@ ConvertFileNameFormat( */ Tcl_DStringInit(&dsTemp); - Tcl_WCharToUtfDString(nativeName, -1, &dsTemp); + Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp); Tcl_DStringFree(&ds); - /* - * Deal with issues of tildes being absolute. - */ - - if (Tcl_DStringValue(&dsTemp)[0] == '~') { - TclNewLiteralStringObj(tempPath, "./"); - Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); - Tcl_DStringFree(&dsTemp); - } else { - tempPath = TclDStringToObj(&dsTemp); - } - Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); + tempPath = Tcl_DStringToObj(&dsTemp); + Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); FindClose(handle); } } - *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1); + *attributePtrPtr = Tcl_FSJoinPath(splitPath, TCL_INDEX_NONE); if (splitPath != NULL) { /* @@ -1896,7 +1885,7 @@ CannotSetAttribute( { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot set attribute \"%s\" for file \"%s\": attribute is readonly", - tclpFileAttrStrings[objIndex], Tcl_GetString(fileName))); + tclpFileAttrStrings[objIndex], TclGetString(fileName))); errno = EINVAL; Tcl_PosixError(interp); return TCL_ERROR; @@ -1952,14 +1941,14 @@ TclpObjListVolumes(void) buf[0] = (char) ('a' + i); if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0) || (GetLastError() == ERROR_NOT_READY)) { - elemPtr = Tcl_NewStringObj(buf, -1); + elemPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE); Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } } else { for (p = buf; *p != '\0'; p += 4) { p[2] = '/'; - elemPtr = Tcl_NewStringObj(p, -1); + elemPtr = Tcl_NewStringObj(p, TCL_INDEX_NONE); Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } @@ -2008,9 +1997,9 @@ TclpCreateTemporaryDirectory( goto useSystemTemp; } Tcl_DStringInit(&base); - Tcl_UtfToWCharDString(Tcl_GetString(dirObj), -1, &base); + Tcl_UtfToWCharDString(Tcl_GetString(dirObj), TCL_INDEX_NONE, &base); if (dirObj->bytes[dirObj->length - 1] != '\\') { - Tcl_UtfToWCharDString("\\", -1, &base); + Tcl_UtfToWCharDString("\\", TCL_INDEX_NONE, &base); } } else { useSystemTemp: @@ -2026,11 +2015,11 @@ TclpCreateTemporaryDirectory( #define SUFFIX_LENGTH 8 if (basenameObj) { - Tcl_UtfToWCharDString(Tcl_GetString(basenameObj), -1, &base); + Tcl_UtfToWCharDString(Tcl_GetString(basenameObj), TCL_INDEX_NONE, &base); } else { - Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, -1, &base); + Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, TCL_INDEX_NONE, &base); } - Tcl_UtfToWCharDString("_", -1, &base); + Tcl_UtfToWCharDString("_", TCL_INDEX_NONE, &base); /* * Now we keep on trying random suffixes until we get one that works @@ -2057,7 +2046,7 @@ TclpCreateTemporaryDirectory( tempbuf[i] = randChars[(int) (rand() % numRandChars)]; } Tcl_DStringSetLength(&base, baseLen); - Tcl_UtfToWCharDString(tempbuf, -1, &base); + Tcl_UtfToWCharDString(tempbuf, TCL_INDEX_NONE, &base); } while (!CreateDirectoryW((LPCWSTR) Tcl_DStringValue(&base), NULL) && (error = GetLastError()) == ERROR_ALREADY_EXISTS); @@ -2078,9 +2067,9 @@ TclpCreateTemporaryDirectory( */ Tcl_DStringInit(&name); - Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), -1, &name); + Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), TCL_INDEX_NONE, &name); Tcl_DStringFree(&base); - return TclDStringToObj(&name); + return Tcl_DStringToObj(&name); } /* diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 4a07f04..c0dd4fd 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -149,8 +149,8 @@ typedef struct { * Other typedefs required by this code. */ -static time_t ToCTime(FILETIME fileTime); -static void FromCTime(time_t posixTime, FILETIME *fileTime); +static __time64_t ToCTime(FILETIME fileTime); +static void FromCTime(__time64_t posixTime, FILETIME *fileTime); /* * Declarations for local functions defined in this file: @@ -170,14 +170,14 @@ static int NativeWriteReparse(const WCHAR *LinkDirectory, static int NativeMatchType(int isDrive, DWORD attr, const WCHAR *nativeName, Tcl_GlobTypeData *types); static int WinIsDrive(const char *name, size_t nameLen); -static int WinIsReserved(const char *path); +static size_t WinIsReserved(const char *path); static Tcl_Obj * WinReadLink(const WCHAR *LinkSource); static Tcl_Obj * WinReadLinkDirectory(const WCHAR *LinkDirectory); static int WinLink(const WCHAR *LinkSource, const WCHAR *LinkTarget, int linkAction); static int WinSymLinkDirectory(const WCHAR *LinkDirectory, const WCHAR *LinkTarget); -MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); +MODULE_SCOPE void tclWinDebugPanic(const char *format, ...); /* *-------------------------------------------------------------------- @@ -808,7 +808,7 @@ NativeWriteReparse( *---------------------------------------------------------------------- */ -TCL_NORETURN void +void tclWinDebugPanic( const char *format, ...) { @@ -838,16 +838,6 @@ 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) && defined (_M_IX86) - _asm {int 3} -#else - DebugBreak(); -#endif - abort(); } /* @@ -874,21 +864,12 @@ TclpFindExecutable( { WCHAR wName[MAX_PATH]; char name[MAX_PATH * 3]; - - /* - * Under Windows we ignore argv0, and return the path for the file used to - * create this process. Only if it is NULL, install a new panic handler. - */ - - if (argv0 == NULL) { -# undef Tcl_SetPanicProc - Tcl_SetPanicProc(tclWinDebugPanic); - } + (void)argv0; GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(WCHAR)); WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); TclWinNoBackslash(name); - TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL); + TclSetObjNameOfExecutable(Tcl_NewStringObj(name, TCL_INDEX_NONE), NULL); } /* @@ -938,10 +919,10 @@ TclpMatchInDirectory( * Match a single file directly. */ - int len; DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; - const char *str = TclGetStringFromObj(norm, &len); + Tcl_Size len = 0; + const char *str = Tcl_GetStringFromObj(norm, &len); native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); @@ -951,7 +932,7 @@ TclpMatchInDirectory( } attr = data.dwFileAttributes; - if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) { + if (NativeMatchType(WinIsDrive(str, len), attr, native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } } @@ -962,7 +943,7 @@ TclpMatchInDirectory( WIN32_FIND_DATAW data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ - int dirLength; + Tcl_Size dirLength; int matchSpecialDots; Tcl_DString ds; /* Native encoding of dir, also used * temporarily for other things. */ @@ -1001,7 +982,7 @@ TclpMatchInDirectory( */ Tcl_DStringInit(&dsOrig); - dirName = TclGetStringFromObj(fileNamePtr, &dirLength); + dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); lastChar = dirName[dirLength -1]; @@ -1024,13 +1005,13 @@ TclpMatchInDirectory( * pattern. */ - dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); + dirName = Tcl_DStringAppend(&dsOrig, pattern, TCL_INDEX_NONE); } else { dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); } Tcl_DStringInit(&ds); - native = Tcl_UtfToWCharDString(dirName, -1, &ds); + native = Tcl_UtfToWCharDString(dirName, TCL_INDEX_NONE, &ds); if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) { handle = FindFirstFileW(native, &data); } else { @@ -1103,7 +1084,7 @@ TclpMatchInDirectory( native = data.cFileName; attr = data.dwFileAttributes; Tcl_DStringInit(&ds); - utfname = Tcl_WCharToUtfDString(native, -1, &ds); + utfname = Tcl_WCharToUtfDString(native, TCL_INDEX_NONE, &ds); if (!matchSpecialDots) { /* @@ -1245,7 +1226,7 @@ WinIsDrive( * (not any trailing :). */ -static int +static size_t WinIsReserved( const char *path) /* Path in UTF-8 */ { @@ -1457,27 +1438,45 @@ TclpGetUserHome( if (domain == NULL) { const char *ptr; - /* - * No domain. Firstly check it's the current user - */ - + /* + * Treat the current user as a special case because the general case + * below does not properly retrieve the path. The NetUserGetInfo + * call returns an empty path and the code defaults to the user's + * name in the profiles directory. On modern Windows systems, this + * is generally wrong as when the account is a Microsoft account, + * for example abcdefghi@outlook.com, the directory name is + * abcde and not abcdefghi. + * + * Note we could have just used env(USERPROFILE) here but + * the intent is to retrieve (as on Unix) the system's view + * of the home irrespective of environment settings of HOME + * and USERPROFILE. + * + * Fixing this for the general user needs more investigating but + * at least for the current user we can use a direct call. + */ ptr = TclpGetUserName(&ds); if (ptr != NULL && strcasecmp(name, ptr) == 0) { - /* - * Try safest and fastest way to get current user home - */ - - ptr = TclGetEnv("HOME", &ds); - if (ptr != NULL) { - Tcl_JoinPath(1, &ptr, bufferPtr); - rc = 1; - result = Tcl_DStringValue(bufferPtr); + HANDLE hProcess; + WCHAR buf[MAX_PATH]; + DWORD nChars = sizeof(buf) / sizeof(buf[0]); + /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */ + hProcess = GetCurrentProcess(); /* Need not be closed */ + if (hProcess) { + HANDLE hToken; + if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) { + if (GetUserProfileDirectoryW(hToken, buf, &nChars)) { + result = Tcl_WCharToUtfDString(buf, nChars-1, (bufferPtr)); + rc = 1; + } + CloseHandle(hToken); + } } } Tcl_DStringFree(&ds); } else { Tcl_DStringInit(&ds); - wName = Tcl_UtfToWCharDString(domain + 1, -1, &ds); + wName = Tcl_UtfToWCharDString(domain + 1, TCL_INDEX_NONE, &ds); rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain); Tcl_DStringFree(&ds); nameLen = domain - name; @@ -1543,30 +1542,6 @@ TclpGetUserHome( if (wDomain != NULL) { NetApiBufferFree((void *) wDomain); } - if (result == NULL) { - /* - * Look in the "Password Lists" section of system.ini for the local - * user. There are also entries in that section that begin with a "*" - * character that are used by Windows for other purposes; ignore user - * names beginning with a "*". - */ - - char buf[MAX_PATH]; - - if (name[0] != '*') { - if (GetPrivateProfileStringA("Password Lists", name, "", buf, - MAX_PATH, "system.ini") > 0) { - /* - * User exists, but there is no such thing as a home directory - * in system.ini. Return "{Windows drive}:/". - */ - - GetWindowsDirectoryA(buf, MAX_PATH); - Tcl_DStringAppend(bufferPtr, buf, 3); - result = Tcl_DStringValue(bufferPtr); - } - } - } return result; } @@ -1685,7 +1660,7 @@ NativeAccess( } /* - * We cannnot verify the access fast, check it below using security + * We cannot verify the access fast, check it below using security * info. */ } @@ -1805,7 +1780,7 @@ NativeAccess( RevertToSelf(); /* - * Setup desiredAccess according to the access priveleges we are + * Setup desiredAccess according to the access privileges we are * checking. */ @@ -1989,7 +1964,7 @@ TclpGetCwd( native += 2; } Tcl_DStringInit(bufferPtr); - Tcl_WCharToUtfDString(native, -1, bufferPtr); + Tcl_WCharToUtfDString(native, TCL_INDEX_NONE, bufferPtr); /* * Convert to forward slashes for easier use in scripts. @@ -2062,7 +2037,7 @@ NativeStat( * 'getFileAttributesExProc', and if that isn't available, then on even * simpler routines. * - * Special consideration must be given to Windows hardcoded names like + * Special consideration must be given to Windows hard-coded names like * CON, NULL, COM1, LPT1 etc. For these, we still need to do the * CreateFile as some may not exist (e.g. there is no CON in wish by * default). However the subsequent GetFileInformationByHandle will @@ -2198,7 +2173,7 @@ NativeDev( GetFullPathNameW(nativePath, MAX_PATH, nativeFullPath, &nativePart); Tcl_DStringInit(&ds); - fullPath = Tcl_WCharToUtfDString(nativeFullPath, -1, &ds); + fullPath = Tcl_WCharToUtfDString(nativeFullPath, TCL_INDEX_NONE, &ds); if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { const char *p; @@ -2294,7 +2269,7 @@ NativeStatMode( * * ToCTime -- * - * Converts a Windows FILETIME to a time_t in UTC. + * Converts a Windows FILETIME to a __time64_t in UTC. * * Results: * Returns the count of seconds from the Posix epoch. @@ -2302,7 +2277,7 @@ NativeStatMode( *------------------------------------------------------------------------ */ -static time_t +static __time64_t ToCTime( FILETIME fileTime) /* UTC time */ { @@ -2311,7 +2286,7 @@ ToCTime( convertedTime.LowPart = fileTime.dwLowDateTime; convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; - return (time_t) ((convertedTime.QuadPart - + return (__time64_t) ((convertedTime.QuadPart - (long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000); } @@ -2320,7 +2295,7 @@ ToCTime( * * FromCTime -- * - * Converts a time_t to a Windows FILETIME + * Converts a __time64_t to a Windows FILETIME * * Results: * Returns the count of 100-ns ticks seconds from the Windows epoch. @@ -2330,7 +2305,7 @@ ToCTime( static void FromCTime( - time_t posixTime, + __time64_t posixTime, FILETIME *fileTime) /* UTC Time */ { LARGE_INTEGER convertedTime; @@ -2353,7 +2328,7 @@ FromCTime( * is either the given clientData, if the working directory hasn't * changed, or a new clientData (owned by our caller), giving the new * native path, or NULL if the current directory could not be determined. - * If NULL is returned, the caller can examine the standard posix error + * If NULL is returned, the caller can examine the standard Posix error * codes to determine the cause of the problem. * * Side effects: @@ -2362,9 +2337,9 @@ FromCTime( *---------------------------------------------------------------------- */ -ClientData +void * TclpGetNativeCwd( - ClientData clientData) + void *clientData) { WCHAR buffer[MAX_PATH]; @@ -2477,12 +2452,12 @@ TclpFilesystemPathType( if (normPath == NULL) { return NULL; } - path = Tcl_GetString(normPath); + path = TclGetString(normPath); if (path == NULL) { return NULL; } - firstSeparator = strchr(path, '/'); + firstSeparator = strchr((char *)path, '/'); if (firstSeparator == NULL) { found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); @@ -2501,8 +2476,8 @@ TclpFilesystemPathType( Tcl_DString ds; Tcl_DStringInit(&ds); - Tcl_WCharToUtfDString(volType, -1, &ds); - return TclDStringToObj(&ds); + Tcl_WCharToUtfDString(volType, TCL_INDEX_NONE, &ds); + return Tcl_DStringToObj(&ds); } #undef VOL_BUF_SIZE } @@ -2557,7 +2532,7 @@ TclpObjNormalizePath( Tcl_DString ds; /* Some workspace. */ Tcl_DStringInit(&dsNorm); - path = Tcl_GetString(pathPtr); + path = TclGetString(pathPtr); currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { @@ -2585,17 +2560,17 @@ TclpObjNormalizePath( */ if (isDrive) { - int len = WinIsReserved(path); + size_t len = WinIsReserved(path); if (len > 0) { /* * Actually it does exist - COM1, etc. */ - int i; + size_t i; for (i=0 ; i<len ; i++) { - WCHAR wc = ((WCHAR *) nativePath)[i]; + WCHAR wc = ((WCHAR *)nativePath)[i]; if (wc >= 'a') { wc -= ('a' - 'A'); @@ -2604,7 +2579,7 @@ TclpObjNormalizePath( } Tcl_DStringAppend(&dsNorm, (const char *)nativePath, - (int)(sizeof(WCHAR) * len)); + sizeof(WCHAR) * len); lastValidPathEnd = currentPathEndPosition; } else if (nextCheckpoint == 0) { /* @@ -2649,18 +2624,18 @@ TclpObjNormalizePath( */ nextCheckpoint = 0; - Tcl_AppendToObj(to, currentPathEndPosition, -1); + Tcl_AppendToObj(to, currentPathEndPosition, TCL_INDEX_NONE); /* * Convert link to forward slashes. */ - for (path = Tcl_GetString(to); *path != 0; path++) { + for (path = TclGetString(to); *path != 0; path++) { if (*path == '\\') { *path = '/'; } } - path = Tcl_GetString(to); + path = TclGetString(to); currentPathEndPosition = path + nextCheckpoint; if (temp != NULL) { Tcl_DecrRefCount(temp); @@ -2750,7 +2725,7 @@ TclpObjNormalizePath( sizeof(WCHAR)); Tcl_DStringAppend(&dsNorm, (const char *) nativeName, - (int) (wcslen(nativeName)*sizeof(WCHAR))); + wcslen(nativeName)*sizeof(WCHAR)); } } } @@ -2820,13 +2795,13 @@ TclpObjNormalizePath( * Not the end of the string. */ - int len; Tcl_Obj *tmpPathPtr; + Tcl_Size len; tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); - Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); - path = TclGetStringFromObj(tmpPathPtr, &len); + Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, TCL_INDEX_NONE); + path = Tcl_GetStringFromObj(tmpPathPtr, &len); Tcl_SetStringObj(pathPtr, path, len); Tcl_DecrRefCount(tmpPathPtr); } else { @@ -2895,10 +2870,10 @@ TclWinVolumeRelativeNormalize( * current volume. */ - const char *drive = Tcl_GetString(useThisCwd); + const char *drive = TclGetString(useThisCwd); absolutePath = Tcl_NewStringObj(drive,2); - Tcl_AppendToObj(absolutePath, path, -1); + Tcl_AppendToObj(absolutePath, path, TCL_INDEX_NONE); Tcl_IncrRefCount(absolutePath); /* @@ -2910,8 +2885,8 @@ TclWinVolumeRelativeNormalize( * also on drive C. */ - int cwdLen; - const char *drive = TclGetStringFromObj(useThisCwd, &cwdLen); + Tcl_Size cwdLen; + const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen); char drive_cur = path[0]; if (drive_cur >= 'a') { @@ -2951,7 +2926,7 @@ TclWinVolumeRelativeNormalize( Tcl_AppendToObj(absolutePath, "/", 1); } Tcl_IncrRefCount(absolutePath); - Tcl_AppendToObj(absolutePath, path+2, -1); + Tcl_AppendToObj(absolutePath, path+2, TCL_INDEX_NONE); } *useThisCwdPtr = useThisCwd; return absolutePath; @@ -2980,15 +2955,15 @@ TclWinVolumeRelativeNormalize( Tcl_Obj * TclpNativeToNormalized( - ClientData clientData) + void *clientData) { Tcl_DString ds; Tcl_Obj *objPtr; - int len; + size_t len; char *copy, *p; Tcl_DStringInit(&ds); - Tcl_WCharToUtfDString((const WCHAR *) clientData, -1, &ds); + Tcl_WCharToUtfDString((const WCHAR *) clientData, TCL_INDEX_NONE, &ds); copy = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); @@ -3040,14 +3015,14 @@ TclpNativeToNormalized( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { WCHAR *nativePathPtr = NULL; const char *str; Tcl_Obj *validPathPtr; - size_t len; + Tcl_Size len; WCHAR *wp; if (TclFSCwdIsNative()) { @@ -3084,10 +3059,9 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = Tcl_GetString(validPathPtr); - len = validPathPtr->length; + str = Tcl_GetStringFromObj(validPathPtr, &len); - if (strlen(str) != len) { + if (strlen(str) != (size_t)len) { /* * String contains NUL-bytes. This is invalid. */ @@ -3116,7 +3090,7 @@ TclNativeCreateNativeRep( * Overallocate 6 chars, making some room for extended paths */ - wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR)); + wp = nativePathPtr = (WCHAR *)Tcl_Alloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { goto done; } @@ -3202,9 +3176,9 @@ TclNativeCreateNativeRep( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeDupInternalRep( - ClientData clientData) + void *clientData) { char *copy; size_t len; @@ -3215,7 +3189,7 @@ TclNativeDupInternalRep( len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1); - copy = (char *)ckalloc(len); + copy = (char *)Tcl_Alloc(len); memcpy(copy, clientData, len); return copy; } @@ -3331,7 +3305,7 @@ TclWinFileOwned( bufsz = 0; GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); if (bufsz) { - buf = (LPBYTE)ckalloc(bufsz); + buf = (LPBYTE)Tcl_Alloc(bufsz); if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); } @@ -3347,7 +3321,7 @@ TclWinFileOwned( LocalFree(secd); /* Also frees ownerSid */ } if (buf) { - ckfree(buf); + Tcl_Free(buf); } return (owned != 0); /* Convert non-0 to 1 */ diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 647b870..b506111 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -124,14 +124,14 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; const char *bytes; - int length; + Tcl_Size length; TclNewObj(pathPtr); @@ -141,13 +141,13 @@ TclpInitLibraryPath( * installed DLL. */ - sprintf(installLib, "lib/tcl%s", TCL_VERSION); + snprintf(installLib, sizeof(installLib), "lib/tcl%s", TCL_VERSION); /* * Look for the library relative to the TCL_LIBRARY env variable. If the * last dirname in the TCL_LIBRARY path does not match the last dirname in * the installLib variable, use the last dir name of installLib in - * addition to the orginal TCL_LIBRARY path. + * addition to the original TCL_LIBRARY path. */ AppendEnvironment(pathPtr, installLib); @@ -167,9 +167,9 @@ TclpInitLibraryPath( TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; - bytes = TclGetStringFromObj(pathPtr, &length); + bytes = Tcl_GetStringFromObj(pathPtr, &length); *lengthPtr = length++; - *valuePtr = (char *)ckalloc(length); + *valuePtr = (char *)Tcl_Alloc(length); memcpy(*valuePtr, bytes, length); Tcl_DecrRefCount(pathPtr); } @@ -198,7 +198,7 @@ AppendEnvironment( Tcl_Obj *pathPtr, const char *lib) { - int pathc; + Tcl_Size pathc; WCHAR wBuf[MAX_PATH]; char buf[MAX_PATH * 3]; Tcl_Obj *objPtr; @@ -225,15 +225,15 @@ AppendEnvironment( } /* - * The "L" preceeding the TCL_LIBRARY string is used to tell VC++ that - * this is a unicode string. + * The "L" preceding the TCL_LIBRARY string is used to tell VC++ that + * this is a Unicode string. */ GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH); WideCharToMultiByte(CP_UTF8, 0, wBuf, -1, buf, MAX_PATH * 3, NULL, NULL); if (buf[0] != '\0') { - objPtr = Tcl_NewStringObj(buf, -1); + objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); TclWinNoBackslash(buf); @@ -255,12 +255,12 @@ AppendEnvironment( pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); (void) Tcl_JoinPath(pathc, pathv, &ds); - objPtr = TclDStringToObj(&ds); + objPtr = Tcl_DStringToObj(&ds); } else { - objPtr = Tcl_NewStringObj(buf, -1); + objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE); } Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - ckfree(pathv); + Tcl_Free((void *)pathv); } } @@ -284,10 +284,10 @@ AppendEnvironment( static void InitializeDefaultLibraryDir( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { - HMODULE hModule = TclWinGetTclInstance(); + HMODULE hModule = (HMODULE)TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; char *end, *p; @@ -304,9 +304,9 @@ InitializeDefaultLibraryDir( *end = '\\'; TclWinNoBackslash(name); - sprintf(end + 1, "lib/tcl%s", TCL_VERSION); + snprintf(end + 1, LIBRARY_SIZE, "lib/tcl%s", TCL_VERSION); *lengthPtr = strlen(name); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, *lengthPtr + 1); } @@ -332,10 +332,10 @@ InitializeDefaultLibraryDir( static void InitializeSourceLibraryDir( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { - HMODULE hModule = TclWinGetTclInstance(); + HMODULE hModule = (HMODULE)TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; char *end, *p; @@ -352,9 +352,9 @@ InitializeSourceLibraryDir( *end = '\\'; TclWinNoBackslash(name); - sprintf(end + 1, "../library"); + snprintf(end + 1, LIBRARY_SIZE, "../library"); *lengthPtr = strlen(name); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, *lengthPtr + 1); } @@ -404,7 +404,7 @@ Tcl_GetEncodingNameFromEnvironment( Tcl_DStringAppend(bufPtr, "utf-8", 5); } else { Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE); - wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP()); + snprintf(Tcl_DStringValue(bufPtr), 2+TCL_INTEGER_SPACE, "cp%d", GetACP()); Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr))); } return Tcl_DStringValue(bufPtr); @@ -485,7 +485,10 @@ TclpSetVariables( TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); - wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); + if (osInfo.dwMajorVersion == 10 && osInfo.dwBuildNumber >= 22000) { + osInfo.dwMajorVersion = 11; + } + snprintf(buffer, sizeof(buffer), "%ld.%ld", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", @@ -493,20 +496,6 @@ TclpSetVariables( TCL_GLOBAL_ONLY); } -#if !defined(NDEBUG) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - - /* - * The existence of the "debug" element of the tcl_platform array - * indicates that this particular Tcl shell has been compiled with debug - * information. Using "info exists tcl_platform(debug)" a Tcl script can - * direct the interpreter to load debug versions of DLLs with the load - * command. - */ - - Tcl_SetVar2(interp, "tcl_platform", "debug", "1", - TCL_GLOBAL_ONLY); -#endif - /* * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH * environment variables, if necessary. @@ -517,17 +506,24 @@ TclpSetVariables( if (ptr == NULL) { ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY); if (ptr != NULL) { - Tcl_DStringAppend(&ds, ptr, -1); + Tcl_DStringAppend(&ds, ptr, TCL_INDEX_NONE); } ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY); if (ptr != NULL) { - Tcl_DStringAppend(&ds, ptr, -1); + Tcl_DStringAppend(&ds, ptr, TCL_INDEX_NONE); } if (Tcl_DStringLength(&ds) > 0) { Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); } else { - Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); + /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ + ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); + if (ptr != NULL && ptr[0]) { + Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); + } else { + /* Last resort */ + Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); + } } } @@ -559,9 +555,10 @@ TclpSetVariables( * * Results: * The return value is the index in environ of an entry with the name - * "name", or -1 if there is no such entry. The integer at *lengthPtr is - * filled in with the length of name (if a matching entry is found) or - * the length of the environ array (if no matching entry is found). + * "name", or -1 if there is no such entry. The integer + * at *lengthPtr is filled in with the length of name (if a matching + * entry is found) or the length of the environ array (if no + * matching entry is found). * * Side effects: * None. @@ -569,19 +566,16 @@ TclpSetVariables( *---------------------------------------------------------------------- */ -# define tenviron2utfdstr(string, len, dsPtr) \ - (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)) - -int +Tcl_Size TclpFindVariable( const char *name, /* Name of desired environment variable * (UTF-8). */ - int *lengthPtr) /* Used to return length of name (for + Tcl_Size *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { - int i, length, result = -1; + Tcl_Size i, length, result = -1; const WCHAR *env; const char *p1, *p2; char *envUpper, *nameUpper; @@ -592,7 +586,7 @@ TclpFindVariable( */ length = strlen(name); - nameUpper = (char *)ckalloc(length + 1); + nameUpper = (char *)Tcl_Alloc(length + 1); memcpy(nameUpper, name, length+1); Tcl_UtfToUpper(nameUpper); @@ -612,7 +606,7 @@ TclpFindVariable( if (p1 == NULL) { continue; } - length = (int) (p1 - envUpper); + length = p1 - envUpper; Tcl_DStringSetLength(&envString, length+1); Tcl_UtfToUpper(envUpper); @@ -634,7 +628,7 @@ TclpFindVariable( done: Tcl_DStringFree(&envString); - ckfree(nameUpper); + Tcl_Free(nameUpper); return result; } diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 1b6e606..6de1432 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -43,8 +43,6 @@ MODULE_SCOPE void TclWinInit(HINSTANCE hInst); MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle); MODULE_SCOPE Tcl_Channel TclWinOpenConsoleChannel(HANDLE handle, char *channelName, int permissions); -MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName, - int permissions, int appendMode); MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle, char *channelName, int permissions); MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, const WCHAR *name, @@ -54,7 +52,8 @@ MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *LinkOriginal, int linkOnly); MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); - +MODULE_SCOPE void TclWinGenerateChannelName(char channelName[], + const char *channelTypeName, void *channelImpl); MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr); /* Needed by tclWinFile.c and tclWinFCmd.c */ @@ -81,7 +80,7 @@ typedef struct TclPipeThreadInfo { } TclPipeThreadInfo; -/* If pipe-workers will use some tcl subsystem, we can use ckalloc without +/* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without * more overhead for finalize thread (should be executed anyway) * * #define _PTI_USE_CKALLOC 1 diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index e262595..265c8e7 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -98,7 +98,7 @@ TclpDlopen( ERROR_MOD_NOT_FOUND : GetLastError(); Tcl_DStringInit(&ds); - nativeName = Tcl_UtfToWCharDString(Tcl_GetString(pathPtr), -1, &ds); + nativeName = Tcl_UtfToWCharDString(TclGetString(pathPtr), TCL_INDEX_NONE, &ds); hInstance = LoadLibraryExW(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); @@ -114,13 +114,14 @@ TclpDlopen( * first error for reporting purposes. */ if (firstError == ERROR_MOD_NOT_FOUND || - firstError == ERROR_DLL_NOT_FOUND) + firstError == ERROR_DLL_NOT_FOUND) { lastError = GetLastError(); - else + } else { lastError = firstError; + } errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", - Tcl_GetString(pathPtr)); + TclGetString(pathPtr)); /* * Check for possible DLL errors. This doesn't work quite right, @@ -132,37 +133,37 @@ TclpDlopen( if (interp) { switch (lastError) { case ERROR_MOD_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", (void *)NULL); goto notFoundMsg; case ERROR_DLL_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", (void *)NULL); notFoundMsg: Tcl_AppendToObj(errMsg, "this library or a dependent library" - " could not be found in library path", -1); + " could not be found in library path", TCL_INDEX_NONE); break; case ERROR_PROC_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", (void *)NULL); Tcl_AppendToObj(errMsg, "A function specified in the import" " table could not be resolved by the system. Windows" - " is not telling which one, I'm sorry.", -1); + " is not telling which one, I'm sorry.", TCL_INDEX_NONE); break; case ERROR_INVALID_DLL: - Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", (void *)NULL); Tcl_AppendToObj(errMsg, "this library or a dependent library" - " is damaged", -1); + " is damaged", TCL_INDEX_NONE); break; case ERROR_DLL_INIT_FAILED: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", (void *)NULL); Tcl_AppendToObj(errMsg, "the library initialization" - " routine failed", -1); + " routine failed", TCL_INDEX_NONE); break; case ERROR_BAD_EXE_FORMAT: - Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", NULL); - Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", -1); + Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", (void *)NULL); + Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", TCL_INDEX_NONE); break; default: Tcl_WinConvertError(lastError); - Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1); + Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), TCL_INDEX_NONE); } Tcl_SetObjResult(interp, errMsg); } @@ -173,8 +174,8 @@ TclpDlopen( * Succeded; package everything up for Tcl. */ - handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); - handlePtr->clientData = (ClientData) hInstance; + handlePtr = (Tcl_LoadHandle)Tcl_Alloc(sizeof(struct Tcl_LoadHandle_)); + handlePtr->clientData = (void *)hInstance; handlePtr->findSymbolProcPtr = &FindSymbol; handlePtr->unloadFileProcPtr = &UnloadFile; *loadHandle = handlePtr; @@ -219,14 +220,14 @@ FindSymbol( Tcl_DStringInit(&ds); TclDStringAppendLiteral(&ds, "_"); - sym2 = Tcl_DStringAppend(&ds, symbol, -1); + sym2 = Tcl_DStringAppend(&ds, symbol, TCL_INDEX_NONE); proc = (void *)GetProcAddress(hInstance, sym2); Tcl_DStringFree(&ds); } if (proc == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\"", symbol)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (void *)NULL); } return proc; } @@ -258,7 +259,7 @@ UnloadFile( HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; FreeLibrary(hInstance); - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* @@ -389,7 +390,7 @@ InitDLLDirectoryName(void) */ copyToGlobalBuffer: - dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR)); + dllDirectoryName = (WCHAR *)Tcl_Alloc((nameLen+1) * sizeof(WCHAR)); wcscpy(dllDirectoryName, name); return TCL_OK; } diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index fd39428..de4f8f2 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -14,7 +14,7 @@ #include "tclInt.h" /* - * The follwing static indicates whether this module has been initialized. + * The following static indicates whether this module has been initialized. */ #define INTERVAL_TIMER 1 /* Handle of interval timer. */ @@ -76,7 +76,7 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -100,7 +100,7 @@ TclpInitNotifier(void) clazz.style = 0; clazz.cbClsExtra = 0; clazz.cbWndExtra = 0; - clazz.hInstance = TclWinGetTclInstance(); + clazz.hInstance = (HINSTANCE) TclWinGetTclInstance(); clazz.hbrBackground = NULL; clazz.lpszMenuName = NULL; clazz.lpszClassName = className; @@ -148,7 +148,7 @@ TclpInitNotifier(void) void TclpFinalizeNotifier( - ClientData clientData) /* Pointer to notifier data. */ + void *clientData) /* Pointer to notifier data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -188,7 +188,7 @@ TclpFinalizeNotifier( if (notifierCount) { notifierCount--; if (notifierCount == 0) { - UnregisterClassW(className, TclWinGetTclInstance()); + UnregisterClassW(className, (HINSTANCE) TclWinGetTclInstance()); } } LeaveCriticalSection(¬ifierMutex); @@ -218,7 +218,7 @@ TclpFinalizeNotifier( void TclpAlertNotifier( - ClientData clientData) /* Pointer to thread data. */ + void *clientData) /* Pointer to thread data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -287,7 +287,7 @@ TclpSetTimer( * Windows seems to get confused by zero length timers. */ - timeout = timePtr->sec * 1000 + timePtr->usec / 1000; + timeout = (UINT)timePtr->sec * 1000 + (unsigned long)timePtr->usec / 1000; if (timeout == 0) { timeout = 1; } @@ -337,7 +337,8 @@ TclpServiceModeHook( if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED, - 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); + 0, 0, 0, 0, NULL, NULL, (HINSTANCE) TclWinGetTclInstance(), + NULL); /* * Send an initial message to the window to ensure that we wake up the @@ -436,7 +437,7 @@ NotifierProc( *---------------------------------------------------------------------- */ -ClientData +void * TclpNotifierData(void) { return NULL; @@ -489,7 +490,7 @@ TclpWaitForEvent( TclScaleTime(&myTime); } - timeout = myTime.sec * 1000 + myTime.usec / 1000; + timeout = (DWORD)myTime.sec * 1000 + (unsigned long)myTime.usec / 1000; } else { timeout = INFINITE; } @@ -609,7 +610,7 @@ Tcl_Sleep( */ TclScaleTime(&vdelay); - sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; + sleepTime = (DWORD)vdelay.sec * 1000 + (unsigned long)vdelay.usec / 1000; for (;;) { SleepEx(sleepTime, TRUE); @@ -624,7 +625,7 @@ Tcl_Sleep( vdelay.usec = desired.usec - now.usec; TclScaleTime(&vdelay); - sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; + sleepTime = (DWORD)vdelay.sec * 1000 + (unsigned long)vdelay.usec / 1000; } } diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c index 364673e..7928dcd 100644 --- a/win/tclWinPanic.c +++ b/win/tclWinPanic.c @@ -1,4 +1,4 @@ -/* + /* * tclWinPanic.c -- * * Contains the Windows-specific command-line panic proc. @@ -28,7 +28,7 @@ *---------------------------------------------------------------------- */ -void +TCL_NORETURN1 void Tcl_ConsolePanic( const char *format, ...) { @@ -56,10 +56,10 @@ Tcl_ConsolePanic( if (IsDebuggerPresent()) { OutputDebugStringW(msgString); } else if (_isatty(2)) { - WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0); + WriteConsoleW(handle, msgString, (DWORD)wcslen(msgString), &dummy, 0); } else { buf[0] = '\xEF'; buf[1] = '\xBB'; buf[2] = '\xBF'; /* UTF-8 bom */ - WriteFile(handle, buf, strlen(buf), &dummy, 0); + WriteFile(handle, buf, (DWORD)strlen(buf), &dummy, 0); WriteFile(handle, "\n", 1, &dummy, 0); FlushFileBuffers(handle); } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 29b1c03..60764e6 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -61,7 +61,7 @@ typedef struct { typedef struct ProcInfo { HANDLE hProcess; - DWORD dwProcessId; + int dwProcessId; struct ProcInfo *nextPtr; } ProcInfo; @@ -104,7 +104,7 @@ typedef struct PipeInfo { TclFile readFile; /* Output from pipe. */ TclFile writeFile; /* Input from pipe. */ TclFile errorFile; /* Error output from pipe. */ - int numPids; /* Number of processes attached to pipe. */ + size_t numPids; /* Number of processes attached to pipe. */ Tcl_Pid *pidPtr; /* Pids of attached processes. */ Tcl_ThreadId threadId; /* Thread to which events should be reported. * This value is used by the reader/writer @@ -171,28 +171,28 @@ typedef struct { static int ApplicationType(Tcl_Interp *interp, const char *fileName, char *fullName); -static void BuildCommandLine(const char *executable, int argc, +static void BuildCommandLine(const char *executable, size_t argc, const char **argv, Tcl_DString *linePtr); static BOOL HasConsole(void); -static int PipeBlockModeProc(ClientData instanceData, int mode); -static void PipeCheckProc(ClientData clientData, int flags); -static int PipeClose2Proc(ClientData instanceData, +static int PipeBlockModeProc(void *instanceData, int mode); +static void PipeCheckProc(void *clientData, int flags); +static int PipeClose2Proc(void *instanceData, Tcl_Interp *interp, int flags); static int PipeEventProc(Tcl_Event *evPtr, int flags); -static int PipeGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); +static int PipeGetHandleProc(void *instanceData, + int direction, void **handlePtr); static void PipeInit(void); -static int PipeInputProc(ClientData instanceData, char *buf, +static int PipeInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int PipeOutputProc(ClientData instanceData, +static int PipeOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); static DWORD WINAPI PipeReaderThread(LPVOID arg); -static void PipeSetupProc(ClientData clientData, int flags); -static void PipeWatchProc(ClientData instanceData, int mask); +static void PipeSetupProc(void *clientData, int flags); +static void PipeWatchProc(void *instanceData, int mask); static DWORD WINAPI PipeWriterThread(LPVOID arg); static int TempFileName(WCHAR name[MAX_PATH]); static int WaitForRead(PipeInfo *infoPtr, int blocking); -static void PipeThreadActionProc(ClientData instanceData, +static void PipeThreadActionProc(void *instanceData, int action); /* @@ -203,7 +203,7 @@ static void PipeThreadActionProc(ClientData instanceData, static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -310,7 +310,7 @@ TclpFinalizePipes(void) void PipeSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { PipeInfo *infoPtr; @@ -363,7 +363,7 @@ PipeSetupProc( static void PipeCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { PipeInfo *infoPtr; @@ -402,7 +402,7 @@ PipeCheckProc( if (needEvent) { infoPtr->flags |= PIPE_PENDING; - evPtr = (PipeEvent *)ckalloc(sizeof(PipeEvent)); + evPtr = (PipeEvent *)Tcl_Alloc(sizeof(PipeEvent)); evPtr->header.proc = PipeEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -433,7 +433,7 @@ TclWinMakeFile( { WinFile *filePtr; - filePtr = (WinFile *)ckalloc(sizeof(WinFile)); + filePtr = (WinFile *)Tcl_Alloc(sizeof(WinFile)); filePtr->type = WIN_FILE; filePtr->handle = handle; @@ -500,7 +500,7 @@ TclpMakeFile( HANDLE handle; if (Tcl_GetChannelHandle(channel, direction, - (ClientData *) &handle) == TCL_OK) { + (void **) &handle) == TCL_OK) { return TclWinMakeFile(handle); } else { return (TclFile) NULL; @@ -578,7 +578,7 @@ TclpOpenFile( } Tcl_DStringInit(&ds); - nativePath = Tcl_UtfToWCharDString(path, -1, &ds); + nativePath = Tcl_UtfToWCharDString(path, TCL_INDEX_NONE, &ds); /* * If the file is not being created, use the existing file attributes. @@ -651,7 +651,7 @@ TclpCreateTempFile( const char *contents) /* String to write into temp file, or NULL. */ { WCHAR name[MAX_PATH]; - const char *native; + const char *native = NULL; Tcl_DString dstring; HANDLE handle; @@ -679,7 +679,10 @@ TclpCreateTempFile( * Convert the contents from UTF to native encoding */ - native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) { + goto error; + } + native = Tcl_DStringValue(&dstring); toCopy = Tcl_DStringLength(&dstring); for (p = native; toCopy > 0; p++, toCopy--) { @@ -719,7 +722,9 @@ TclpCreateTempFile( Tcl_DStringFree(&dstring); } - Tcl_WinConvertError(GetLastError()); + if (native != NULL) { + Tcl_WinConvertError(GetLastError()); + } CloseHandle(handle); DeleteFileW(name); return NULL; @@ -826,7 +831,7 @@ TclpCloseFile( if (filePtr->handle != NULL && CloseHandle(filePtr->handle) == FALSE) { Tcl_WinConvertError(GetLastError()); - ckfree(filePtr); + Tcl_Free(filePtr); return -1; } } @@ -836,7 +841,7 @@ TclpCloseFile( Tcl_Panic("TclpCloseFile: unexpected file type"); } - ckfree(filePtr); + Tcl_Free(filePtr); return 0; } @@ -851,7 +856,7 @@ TclpCloseFile( * Results: * Returns the process id for the child process. If the pid was not known * by Tcl, either because the pid was not created by Tcl or the child - * process has already been reaped, -1 is returned. + * process has already been reaped, TCL_INDEX_NONE is returned. * * Side effects: * None. @@ -859,7 +864,7 @@ TclpCloseFile( *-------------------------------------------------------------------------- */ -int +Tcl_Size TclpGetPid( Tcl_Pid pid) /* The HANDLE of the child process. */ { @@ -869,13 +874,13 @@ TclpGetPid( Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == (DWORD) (size_t) pid) { + if (infoPtr->dwProcessId == (Tcl_Size)pid) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; } } Tcl_MutexUnlock(&pipeMutex); - return (unsigned long) -1; + return -1; } /* @@ -911,7 +916,7 @@ TclpCreateProcess( * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - int argc, /* Number of arguments in following array. */ + size_t argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings. argv[0] contains * the name of the executable converted to * native format (using the @@ -923,12 +928,12 @@ TclpCreateProcess( * receive no standard input. */ TclFile outputFile, /* If non-NULL, gives the file that receives * output from the child process. If - * outputFile file is not writeable or is + * outputFile file is not writable or is * NULL, output from the child will be * discarded. */ TclFile errorFile, /* If non-NULL, gives the file that receives * errors from the child process. If errorFile - * file is not writeable or is NULL, errors + * file is not writable or is NULL, errors * from the child will be discarded. errorFile * may be the same as outputFile. */ Tcl_Pid *pidPtr) /* If this function is successful, pidPtr is @@ -1163,7 +1168,7 @@ TclpCreateProcess( WaitForInputIdle(procInfo.hProcess, 5000); CloseHandle(procInfo.hThread); - *pidPtr = (Tcl_Pid) (size_t) procInfo.dwProcessId; + *pidPtr = (Tcl_Pid)INT2PTR(procInfo.dwProcessId); if (*pidPtr != 0) { TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId); } @@ -1285,12 +1290,12 @@ ApplicationType( applType = APPL_NONE; Tcl_DStringInit(&nameBuf); - Tcl_DStringAppend(&nameBuf, originalName, -1); + Tcl_DStringAppend(&nameBuf, originalName, TCL_INDEX_NONE); nameLen = Tcl_DStringLength(&nameBuf); for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { Tcl_DStringSetLength(&nameBuf, nameLen); - Tcl_DStringAppend(&nameBuf, extensions[i], -1); + Tcl_DStringAppend(&nameBuf, extensions[i], TCL_INDEX_NONE); Tcl_DStringInit(&ds); nativeName = Tcl_UtfToWCharDString(Tcl_DStringValue(&nameBuf), Tcl_DStringLength(&nameBuf), &ds); @@ -1311,7 +1316,7 @@ ApplicationType( continue; } Tcl_DStringInit(&ds); - strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, -1, &ds)); + strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, TCL_INDEX_NONE, &ds)); Tcl_DStringFree(&ds); ext = strrchr(fullName, '.'); @@ -1403,7 +1408,7 @@ ApplicationType( GetShortPathNameW(nativeFullPath, nativeFullPath, MAX_PATH); Tcl_DStringInit(&ds); - strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, -1, &ds)); + strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, TCL_INDEX_NONE, &ds)); Tcl_DStringFree(&ds); } return applType; @@ -1536,20 +1541,29 @@ static void BuildCommandLine( const char *executable, /* Full path of executable (including * extension). Replacement for argv[0]. */ - int argc, /* Number of arguments. */ + size_t argc, /* Number of arguments. */ const char **argv, /* Argument strings in UTF. */ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the * command line (WCHAR). */ { const char *arg, *start, *special, *bspos; - int quote = 0, i; + int quote = 0; + size_t i; Tcl_DString ds; +#ifdef TCL_WIN_PIPE_FULLESC + /* full escape inclusive %-subst avoidance */ static const char specMetaChars[] = "&|^<>!()%"; /* Characters to enclose in quotes if unpaired * quote flag set. */ static const char specMetaChars2[] = "%"; /* Character to enclose in quotes in any case * (regardless of unpaired-flag). */ +#else + /* escape considering quotation only (no %-subst avoidance) */ + static const char specMetaChars[] = "&|^<>!()"; + /* Characters to enclose in quotes if unpaired + * quote flag set. */ +#endif /* * Quote flags: * CL_ESCAPE - escape argument; @@ -1628,7 +1642,7 @@ BuildCommandLine( * Nothing to escape. */ - Tcl_DStringAppend(&ds, arg, -1); + Tcl_DStringAppend(&ds, arg, TCL_INDEX_NONE); } else { start = arg; for (special = arg; *special != '\0'; ) { @@ -1687,7 +1701,7 @@ BuildCommandLine( start = !bspos ? special : bspos; continue; } - +#ifdef TCL_WIN_PIPE_FULLESC /* * Special case for % - should be enclosed always (paired * also) @@ -1704,6 +1718,7 @@ BuildCommandLine( start = !bspos ? special : bspos; continue; } +#endif /* * Other not special (and not meta) character @@ -1759,11 +1774,11 @@ TclpCreateCommandChannel( TclFile writeFile, /* If non-null, gives the file for writing. */ TclFile errorFile, /* If non-null, gives the file where errors * can be read. */ - int numPids, /* The number of pids in the pid array. */ + size_t numPids, /* The number of pids in the pid array. */ Tcl_Pid *pidPtr) /* An array of process identifiers. */ { char channelName[16 + TCL_INTEGER_SPACE]; - PipeInfo *infoPtr = (PipeInfo *)ckalloc(sizeof(PipeInfo)); + PipeInfo *infoPtr = (PipeInfo *)Tcl_Alloc(sizeof(PipeInfo)); PipeInit(); @@ -1822,18 +1837,11 @@ TclpCreateCommandChannel( * unique, in case channels share handles (stdin/stdout). */ - sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); + TclWinGenerateChannelName(channelName, "file", infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, infoPtr, infoPtr->validMask); - /* - * Pipes have AUTO translation mode on Windows and ^Z eof char, which - * means that a ^Z will be appended to them at close. This is needed for - * Windows programs that expect a ^Z at EOF. - */ - Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); return infoPtr->channel; } @@ -1872,10 +1880,10 @@ Tcl_CreatePipe( return TCL_ERROR; } - *rchan = Tcl_MakeFileChannel((ClientData) readHandle, TCL_READABLE); + *rchan = Tcl_MakeFileChannel((void *) readHandle, TCL_READABLE); Tcl_RegisterChannel(interp, *rchan); - *wchan = Tcl_MakeFileChannel((ClientData) writeHandle, TCL_WRITABLE); + *wchan = Tcl_MakeFileChannel((void *) writeHandle, TCL_WRITABLE); Tcl_RegisterChannel(interp, *wchan); return TCL_OK; @@ -1906,7 +1914,7 @@ TclGetAndDetachPids( PipeInfo *pipePtr; const Tcl_ChannelType *chanTypePtr; Tcl_Obj *pidsObj; - int i; + size_t i; /* * Punt if the channel is not a command channel. @@ -1921,13 +1929,13 @@ TclGetAndDetachPids( TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, pidsObj, - Tcl_NewWideIntObj((unsigned) + Tcl_NewWideIntObj( TclpGetPid(pipePtr->pidPtr[i]))); Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); pipePtr->numPids = 0; } } @@ -1950,7 +1958,7 @@ TclGetAndDetachPids( static int PipeBlockModeProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -1989,7 +1997,7 @@ PipeBlockModeProc( static int PipeClose2Proc( - ClientData instanceData, /* Pointer to PipeInfo structure. */ + void *instanceData, /* Pointer to PipeInfo structure. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { @@ -2112,10 +2120,12 @@ PipeClose2Proc( if (pipePtr->errorFile) { WinFile *filePtr = (WinFile *) pipePtr->errorFile; - errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle, + errChan = Tcl_MakeFileChannel((void *) filePtr->handle, TCL_READABLE); - ckfree(filePtr); - } else { + Tcl_Free(filePtr); + Tcl_SetChannelOption(NULL, errChan, "-profile", "replace"); + } + else { errChan = NULL; } @@ -2124,14 +2134,14 @@ PipeClose2Proc( } if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); } if (pipePtr->writeBuf != NULL) { - ckfree(pipePtr->writeBuf); + Tcl_Free(pipePtr->writeBuf); } - ckfree(pipePtr); + Tcl_Free(pipePtr); if (errorCode == 0) { return result; @@ -2159,7 +2169,7 @@ PipeClose2Proc( static int PipeInputProc( - ClientData instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -2253,7 +2263,7 @@ PipeInputProc( static int PipeOutputProc( - ClientData instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -2300,10 +2310,10 @@ PipeOutputProc( */ if (infoPtr->writeBuf) { - ckfree(infoPtr->writeBuf); + Tcl_Free(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = (char *)ckalloc(toWrite); + infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; @@ -2435,7 +2445,7 @@ PipeEventProc( static void PipeWatchProc( - ClientData instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -2497,21 +2507,21 @@ PipeWatchProc( static int PipeGetHandleProc( - ClientData instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr; if (direction == TCL_READABLE && infoPtr->readFile) { filePtr = (WinFile*) infoPtr->readFile; - *handlePtr = (ClientData) filePtr->handle; + *handlePtr = (void *) filePtr->handle; return TCL_OK; } if (direction == TCL_WRITABLE && infoPtr->writeFile) { filePtr = (WinFile*) infoPtr->writeFile; - *handlePtr = (ClientData) filePtr->handle; + *handlePtr = (void *) filePtr->handle; return TCL_OK; } return TCL_ERROR; @@ -2565,7 +2575,7 @@ Tcl_WaitPid( prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == (DWORD) (size_t) pid) { + if (infoPtr->dwProcessId == (Tcl_Size)pid) { *prevPtrPtr = infoPtr->nextPtr; break; } @@ -2675,7 +2685,7 @@ Tcl_WaitPid( } else { errno = ECHILD; *statPtr = 0xC0000000 | ECHILD; - result = (Tcl_Pid) -1; + result = (Tcl_Pid)-1; } /* @@ -2683,7 +2693,7 @@ Tcl_WaitPid( */ CloseHandle(infoPtr->hProcess); - ckfree(infoPtr); + Tcl_Free(infoPtr); return result; } @@ -2709,9 +2719,9 @@ Tcl_WaitPid( void TclWinAddProcess( void *hProcess, /* Handle to process */ - unsigned long id) /* Global process identifier */ + Tcl_Size id) /* Global process identifier */ { - ProcInfo *procPtr = (ProcInfo*)ckalloc(sizeof(ProcInfo)); + ProcInfo *procPtr = (ProcInfo *)Tcl_Alloc(sizeof(ProcInfo)); PipeInit(); @@ -2742,7 +2752,7 @@ TclWinAddProcess( int Tcl_PidObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -2750,7 +2760,7 @@ Tcl_PidObjCmd( Tcl_Channel chan; const Tcl_ChannelType *chanTypePtr; PipeInfo *pipePtr; - int i; + size_t i; Tcl_Obj *resultPtr; if (objc > 2) { @@ -2758,9 +2768,9 @@ Tcl_PidObjCmd( return TCL_ERROR; } if (objc == 1) { - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(getpid())); } else { - chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), + chan = Tcl_GetChannel(interp, TclGetString(objv[1]), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; @@ -2774,7 +2784,7 @@ Tcl_PidObjCmd( TclNewObj(resultPtr); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, - Tcl_NewWideIntObj((unsigned) + Tcl_NewWideIntObj( TclpGetPid(pipePtr->pidPtr[i]))); } Tcl_SetObjResult(interp, resultPtr); @@ -2811,7 +2821,7 @@ WaitForRead( * or not. */ { DWORD timeout, count; - HANDLE *handle = (HANDLE *)((WinFile *) infoPtr->readFile)->handle; + HANDLE handle = ((WinFile *) infoPtr->readFile)->handle; while (1) { /* @@ -3136,7 +3146,7 @@ PipeWriterThread( static void PipeThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { PipeInfo *infoPtr = (PipeInfo *) instanceData; @@ -3144,7 +3154,7 @@ PipeThreadActionProc( /* * We do not access firstPipePtr in the thread structures. This is not for * all pipes managed by the thread, but only those we are watching. - * Removal of the filevent handlers before transfer thus takes care of + * Removal of the fileevent handlers before transfer thus takes care of * this structure. */ @@ -3197,7 +3207,8 @@ TclpOpenTemporaryFile( char *namePtr; HANDLE handle; DWORD flags = FILE_ATTRIBUTE_TEMPORARY; - int length, counter, counter2; + Tcl_Size length; + int counter, counter2; Tcl_DString buf; if (!resultingNameObj) { @@ -3211,7 +3222,7 @@ TclpOpenTemporaryFile( } namePtr += length * sizeof(WCHAR); if (basenameObj) { - const char *string = TclGetStringFromObj(basenameObj, &length); + const char *string = Tcl_GetStringFromObj(basenameObj, &length); Tcl_DStringInit(&buf); Tcl_UtfToWCharDString(string, length, &buf); @@ -3232,7 +3243,7 @@ TclpOpenTemporaryFile( do { char number[TCL_INTEGER_SPACE + 4]; - sprintf(number, "%d.TMP", counter); + snprintf(number, sizeof(number), "%d.TMP", counter); counter = (unsigned short) (counter + 1); Tcl_DStringInit(&buf); Tcl_UtfToWCharDString(number, strlen(number), &buf); @@ -3256,7 +3267,7 @@ TclpOpenTemporaryFile( TclDecrRefCount(tmpObj); } - return Tcl_MakeFileChannel((ClientData) handle, + return Tcl_MakeFileChannel((void *) handle, TCL_READABLE|TCL_WRITABLE); gotError: @@ -3280,14 +3291,14 @@ TclpOpenTemporaryFile( TclPipeThreadInfo * TclPipeThreadCreateTI( TclPipeThreadInfo **pipeTIPtr, - ClientData clientData, + void *clientData, HANDLE wakeEvent) { TclPipeThreadInfo *pipeTI; #ifndef _PTI_USE_CKALLOC pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo)); #else - pipeTI = (TclPipeThreadInfo *)ckalloc(sizeof(TclPipeThreadInfo)); + pipeTI = (TclPipeThreadInfo *)Tcl_Alloc(sizeof(TclPipeThreadInfo)); #endif /* !_PTI_USE_CKALLOC */ pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL); pipeTI->state = PTI_STATE_IDLE; @@ -3648,7 +3659,7 @@ TclPipeThreadStop( #ifndef _PTI_USE_CKALLOC free(pipeTI); #else - ckfree(pipeTI); + Tcl_Free(pipeTI); #endif /* !_PTI_USE_CKALLOC */ } } @@ -3698,7 +3709,7 @@ TclPipeThreadExit( #ifndef _PTI_USE_CKALLOC free(pipeTI); #else - ckfree(pipeTI); + Tcl_Free(pipeTI); /* be sure all subsystems used are finalized */ Tcl_FinalizeThread(); #endif /* !_PTI_USE_CKALLOC */ diff --git a/win/tclWinPort.h b/win/tclWinPort.h index b61e481..f549420 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -92,12 +92,6 @@ typedef DWORD_PTR * PDWORD_PTR; # include <inttypes.h> #endif #include <limits.h> -#ifdef HAVE_STDINT_H -# include <stdint.h> -#else -# include "../compat/stdint.h" -#endif - #ifndef __GNUC__ # define strncasecmp _strnicmp # define strcasecmp _stricmp @@ -461,6 +455,9 @@ typedef DWORD_PTR * PDWORD_PTR; # pragma warning(disable:4090) /* see: https://developercommunity.visualstudio.com/t/c-compiler-incorrect-propagation-of-const-qualifie/390711 */ # pragma warning(disable:4146) # pragma warning(disable:4244) +#if !defined(_WIN64) +# pragma warning(disable:4305) +#endif # pragma warning(disable:4267) # pragma warning(disable:4996) #endif @@ -514,12 +511,12 @@ typedef DWORD_PTR * PDWORD_PTR; * use by tclAlloc.c. */ -#define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \ - (DWORD)0, (DWORD)size)) +#define TclpSysAlloc(size) ((void*)HeapAlloc(GetProcessHeap(), \ + 0, size)) #define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \ - (DWORD)0, (HGLOBAL)ptr)) + 0, (HGLOBAL)ptr)) #define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \ - (DWORD)0, (LPVOID)ptr, (DWORD)size)) + 0, (LPVOID)ptr, size)) /* This type is not defined in the Windows headers */ #define socklen_t int @@ -530,7 +527,7 @@ typedef DWORD_PTR * PDWORD_PTR; * address platform-specific issues. */ -#define TclpReleaseFile(file) ckfree(file) +#define TclpReleaseFile(file) Tcl_Free(file) /* * The following macros and declarations wrap the C runtime library @@ -547,7 +544,4 @@ typedef DWORD_PTR * PDWORD_PTR; # define LABEL_SECURITY_INFORMATION (0x00000010L) #endif -#define Tcl_DirEntry void -#define TclDIR void - #endif /* _TCLWINPORT */ diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 998521c..9ef62c6 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -86,12 +86,28 @@ static const char *const typeNames[] = { static DWORD lastType = REG_RESOURCE_LIST; +#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) +# if TCL_UTF_MAX > 3 +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) +# else +# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString +# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString +# endif +#ifndef Tcl_Size +# define Tcl_Size int +#endif +#ifndef Tcl_CreateObjCommand2 +# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand +#endif +#endif + /* * Declarations for functions defined in this file. */ static void AppendSystemError(Tcl_Interp *interp, DWORD error); -static int BroadcastValue(Tcl_Interp *interp, int objc, +static int BroadcastValue(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); static void DeleteCmd(void *clientData); @@ -118,46 +134,22 @@ static int ParseKeyName(Tcl_Interp *interp, char *name, static DWORD RecursiveDeleteKey(HKEY hStartKey, const WCHAR * pKeyName, REGSAM mode); static int RegistryObjCmd(void *clientData, - Tcl_Interp *interp, int objc, + Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); -#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) -# if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) -# else -# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString -# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString -# endif -#endif - -static unsigned char * -getByteArrayFromObj( - Tcl_Obj *objPtr, - size_t *lengthPtr -) { - int length; - - unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length); -#if TCL_MAJOR_VERSION > 8 - if (sizeof(TCL_HASH_TYPE) > sizeof(int)) { - /* 64-bit and TIP #494 situation: */ - *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1; - } else -#endif - /* 32-bit or without TIP #494 */ - *lengthPtr = (size_t) (unsigned) length; - return result; -} - #ifdef __cplusplus extern "C" { #endif DLLEXPORT int Registry_Init(Tcl_Interp *interp); DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); +#if TCL_MAJOR_VERSION < 9 +/* With those additional entries, "load tclregistry13.dll" works without 3th argument */ +DLLEXPORT int Tclregistry_Init(Tcl_Interp *interp); +DLLEXPORT int Tclregistry_Unload(Tcl_Interp *interp, int flags); +#endif #ifdef __cplusplus } #endif @@ -184,15 +176,23 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } - cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, + cmd = Tcl_CreateObjCommand2(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); - return Tcl_PkgProvideEx(interp, "registry", "1.3.6", NULL); + return Tcl_PkgProvideEx(interp, "registry", "1.3.7", NULL); } +#if TCL_MAJOR_VERSION < 9 +int +Tclregistry_Init( + Tcl_Interp *interp) +{ + return Registry_Init(interp); +} +#endif /* *---------------------------------------------------------------------- @@ -239,6 +239,15 @@ Registry_Unload( return TCL_OK; } +#if TCL_MAJOR_VERSION < 9 +int +Tclregistry_Unload( + Tcl_Interp *interp, + int flags) +{ + return Registry_Unload(interp, flags); +} +#endif /* *---------------------------------------------------------------------- @@ -286,11 +295,11 @@ static int RegistryObjCmd( void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - int n = 1; - int index, argc; + Tcl_Size n = 1, argc; + int index; REGSAM mode = 0; const char *errString = NULL; @@ -438,13 +447,14 @@ DeleteKey( DWORD result; Tcl_DString buf; REGSAM saveMode = mode; + Tcl_Size len; /* * Find the parent of the key being deleted and open it. */ - keyName = Tcl_GetString(keyNameObj); - buffer = (char *)Tcl_Alloc(keyNameObj->length + 1); + keyName = Tcl_GetStringFromObj(keyNameObj, &len); + buffer = (char *)Tcl_Alloc(len + 1); strcpy(buffer, keyName); if (ParseKeyName(interp, buffer, &hostName, &rootKey, @@ -456,7 +466,7 @@ DeleteKey( if (*keyName == '\0') { Tcl_SetObjResult(interp, Tcl_NewStringObj("bad key: cannot delete root keys", -1)); - Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL); + Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", (void *)NULL); Tcl_Free(buffer); return TCL_ERROR; } @@ -532,6 +542,7 @@ DeleteValue( char *valueName; DWORD result; Tcl_DString ds; + Tcl_Size len; /* * Attempt to open the key for deletion. @@ -542,9 +553,9 @@ DeleteValue( return TCL_ERROR; } - valueName = Tcl_GetString(valueNameObj); + valueName = Tcl_GetStringFromObj(valueNameObj, &len); Tcl_DStringInit(&ds); - Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); + Tcl_UtfToWCharDString(valueName, len, &ds); result = RegDeleteValueW(key, (const WCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { @@ -685,6 +696,7 @@ GetType( Tcl_DString ds; const char *valueName; const WCHAR *nativeValue; + Tcl_Size len; /* * Attempt to open the key for reading. @@ -699,9 +711,9 @@ GetType( * Get the type of the value. */ - valueName = Tcl_GetString(valueNameObj); + valueName = Tcl_GetStringFromObj(valueNameObj, &len); Tcl_DStringInit(&ds); - nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); + nativeValue = Tcl_UtfToWCharDString(valueName, len, &ds); result = RegQueryValueExW(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); @@ -757,6 +769,7 @@ GetValue( const WCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; + Tcl_Size len; /* * Attempt to open the key for reading. @@ -773,7 +786,7 @@ GetValue( * length to TCL_DSTRING_STATIC_SIZE, but this should be safer if the * implementation of Dstrings changes. * - * This allows short values to be read from the registy in one call. + * This allows short values to be read from the registry in one call. * Longer values need a second call with an expanded DString. */ @@ -781,9 +794,9 @@ GetValue( Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); length = TCL_DSTRING_STATIC_SIZE/sizeof(WCHAR) - 1; - valueName = Tcl_GetString(valueNameObj); + valueName = Tcl_GetStringFromObj(valueNameObj, &len); Tcl_DStringInit(&buf); - nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &buf); + nativeValue = Tcl_UtfToWCharDString(valueName, len, &buf); result = RegQueryValueExW(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); @@ -795,7 +808,7 @@ GetValue( */ length = Tcl_DStringLength(&data) * (2 / sizeof(WCHAR)); - Tcl_DStringSetLength(&data, (int) length * sizeof(WCHAR)); + Tcl_DStringSetLength(&data, length * sizeof(WCHAR)); result = RegQueryValueExW(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } @@ -856,7 +869,7 @@ GetValue( */ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj( - (BYTE *) Tcl_DStringValue(&data), (int) length)); + (BYTE *) Tcl_DStringValue(&data), length)); } Tcl_DStringFree(&data); return result; @@ -867,7 +880,7 @@ GetValue( * * GetValueNames -- * - * This function enumerates the values of the a given key. If the + * This function enumerates the values of the given key. If the * optional pattern is supplied, then only value names that match the * pattern will be returned. * @@ -905,7 +918,7 @@ GetValueNames( resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); + Tcl_DStringSetLength(&buffer, MAX_KEY_LENGTH * sizeof(WCHAR)); index = 0; result = TCL_OK; @@ -975,9 +988,10 @@ OpenKey( char *keyName, *buffer, *hostName; HKEY rootKey; DWORD result; + Tcl_Size len; - keyName = Tcl_GetString(keyNameObj); - buffer = (char *)Tcl_Alloc(keyNameObj->length + 1); + keyName = Tcl_GetStringFromObj(keyNameObj, &len); + buffer = (char *)Tcl_Alloc(len + 1); strcpy(buffer, keyName); result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); @@ -1002,7 +1016,7 @@ OpenKey( * * OpenSubKey -- * - * This function opens a given subkey of a root key on the specified + * Opens a given subkey of the given root key on the specified * host. * * Results: @@ -1087,7 +1101,7 @@ OpenSubKey( * * ParseKeyName -- * - * This function parses a key name into the host, root, and subkey parts. + * Parses a key name into the host, root, and subkey parts. * * Results: * The pointers to the start of the host and subkey names are returned in @@ -1133,7 +1147,7 @@ ParseKeyName( if (!rootName) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad key \"%s\": must start with a valid root", name)); - Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL); + Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", (void *)NULL); return TCL_ERROR; } @@ -1211,7 +1225,7 @@ RecursiveDeleteKey( } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); + Tcl_DStringSetLength(&subkey, MAX_KEY_LENGTH * sizeof(WCHAR)); mode = saveMode; while (result == ERROR_SUCCESS) { @@ -1285,6 +1299,7 @@ SetValue( HKEY key; const char *valueName; Tcl_DString nameBuf; + Tcl_Size len; if (typeObj == NULL) { type = REG_SZ; @@ -1300,9 +1315,9 @@ SetValue( return TCL_ERROR; } - valueName = Tcl_GetString(valueNameObj); + valueName = Tcl_GetStringFromObj(valueNameObj, &len); Tcl_DStringInit(&nameBuf); - valueName = (char *) Tcl_UtfToWCharDString(valueName, valueNameObj->length, &nameBuf); + valueName = (char *) Tcl_UtfToWCharDString(valueName, len, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { int value; @@ -1318,7 +1333,7 @@ SetValue( (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; - int objc, i; + Tcl_Size objc, i; Tcl_Obj **objv; if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) { @@ -1335,9 +1350,9 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - const char *bytes = Tcl_GetString(objv[i]); + const char *bytes = Tcl_GetStringFromObj(objv[i], &len); - Tcl_DStringAppend(&data, bytes, objv[i]->length); + Tcl_DStringAppend(&data, bytes, len); /* * Add a null character to separate this value from the next. @@ -1356,10 +1371,10 @@ SetValue( Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; - const char *data = Tcl_GetString(dataObj); + const char *data = Tcl_GetStringFromObj(dataObj, &len); Tcl_DStringInit(&buf); - data = (char *) Tcl_UtfToWCharDString(data, dataObj->length, &buf); + data = (char *) Tcl_UtfToWCharDString(data, len, &buf); /* * Include the null in the length, padding if needed for WCHAR. @@ -1372,13 +1387,13 @@ SetValue( Tcl_DStringFree(&buf); } else { BYTE *data; - size_t bytelength; + Tcl_Size bytelength; /* * Store binary data in the registry. */ - data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength); + data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength); result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, data, (DWORD) bytelength); } @@ -1415,21 +1430,20 @@ SetValue( static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { LRESULT result; DWORD_PTR sendResult; int timeout = 3000; - size_t len; + Tcl_Size len; const char *str; Tcl_Obj *objPtr; WCHAR *wstr; Tcl_DString ds; if (objc == 3) { - str = Tcl_GetString(objv[1]); - len = objv[1]->length; + str = Tcl_GetStringFromObj(objv[1], &len); if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) { return TCL_BREAK; } @@ -1438,9 +1452,9 @@ BroadcastValue( } } - str = Tcl_GetString(objv[0]); + str = Tcl_GetStringFromObj(objv[0], &len); Tcl_DStringInit(&ds); - wstr = Tcl_UtfToWCharDString(str, objv[0]->length, &ds); + wstr = Tcl_UtfToWCharDString(str, len, &ds); if (Tcl_DStringLength(&ds) == 0) { wstr = NULL; } @@ -1466,7 +1480,7 @@ BroadcastValue( * * AppendSystemError -- * - * This routine formats a Windows system error message and places it into + * Formats a Windows system error message and places it into * the interpreter result. * * Results: @@ -1498,7 +1512,7 @@ AppendSystemError( MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr, 0, NULL); if (length == 0) { - sprintf(msgBuf, "unknown error: %ld", error); + snprintf(msgBuf, sizeof(msgBuf), "unknown error: %ld", error); msg = msgBuf; } else { char *msgPtr; @@ -1524,8 +1538,8 @@ AppendSystemError( msg = msgPtr; } - sprintf(id, "%ld", error); - Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL); + snprintf(id, sizeof(id), "%ld", error); + Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (void *)NULL); Tcl_AppendToObj(resultPtr, msg, length); Tcl_SetObjResult(interp, resultPtr); @@ -1539,7 +1553,7 @@ AppendSystemError( * * ConvertDWORD -- * - * This function determines whether a DWORD needs to be byte swapped, and + * Determines whether a DWORD needs to be byte swapped, and * returns the appropriately swapped value. * * Results: diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 403c9d5..14f36fd 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -85,7 +85,7 @@ typedef struct SerialInfo { int readable; /* Flag that the channel is readable. */ int writable; /* Flag that the channel is writable. */ int blockTime; /* Maximum blocktime in msec. */ - unsigned int lastEventTime; /* Time in milliseconds since last readable + unsigned long long lastEventTime; /* Time in milliseconds since last readable * event. */ /* Next readable event only after blockTime */ DWORD error; /* pending error code returned by @@ -165,30 +165,30 @@ static COMMTIMEOUTS no_timeout = { * Declarations for functions used only in this file. */ -static int SerialBlockProc(ClientData instanceData, int mode); -static void SerialCheckProc(ClientData clientData, int flags); -static int SerialCloseProc(ClientData instanceData, +static int SerialBlockProc(void *instanceData, int mode); +static void SerialCheckProc(void *clientData, int flags); +static int SerialCloseProc(void *instanceData, Tcl_Interp *interp, int flags); static int SerialEventProc(Tcl_Event *evPtr, int flags); -static void SerialExitHandler(ClientData clientData); -static int SerialGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); +static void SerialExitHandler(void *clientData); +static int SerialGetHandleProc(void *instanceData, + int direction, void **handlePtr); static ThreadSpecificData *SerialInit(void); -static int SerialInputProc(ClientData instanceData, char *buf, +static int SerialInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int SerialOutputProc(ClientData instanceData, +static int SerialOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -static void SerialSetupProc(ClientData clientData, int flags); -static void SerialWatchProc(ClientData instanceData, int mask); -static void ProcExitHandler(ClientData clientData); -static int SerialGetOptionProc(ClientData instanceData, +static void SerialSetupProc(void *clientData, int flags); +static void SerialWatchProc(void *instanceData, int mask); +static void ProcExitHandler(void *clientData); +static int SerialGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -static int SerialSetOptionProc(ClientData instanceData, +static int SerialSetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value); static DWORD WINAPI SerialWriterThread(LPVOID arg); -static void SerialThreadActionProc(ClientData instanceData, +static void SerialThreadActionProc(void *instanceData, int action); static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr); @@ -204,7 +204,7 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, static const Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ SerialInputProc, /* Input proc. */ SerialOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -285,7 +285,7 @@ SerialInit(void) static void SerialExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); SerialInfo *infoPtr; @@ -323,7 +323,7 @@ SerialExitHandler( static void ProcExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_MutexLock(&serialMutex); initialized = 0; @@ -335,7 +335,7 @@ ProcExitHandler( * * SerialBlockTime -- * - * Wrapper to set Tcl's block time in msec + * Wrapper to set Tcl's block time in msec. * * Results: * None. @@ -373,14 +373,14 @@ SerialBlockTime( *---------------------------------------------------------------------- */ -static unsigned int +static unsigned long long SerialGetMilliseconds(void) { Tcl_Time time; Tcl_GetTime(&time); - return (time.sec * 1000 + time.usec / 1000); + return ((unsigned long long)time.sec * 1000 + (unsigned long)time.usec / 1000); } /* @@ -406,7 +406,7 @@ SerialGetMilliseconds(void) void SerialSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; @@ -461,7 +461,7 @@ SerialSetupProc( static void SerialCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; @@ -469,7 +469,7 @@ SerialCheckProc( int needEvent; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); COMSTAT cStat; - unsigned int time; + unsigned long long time; if (!(flags & TCL_FILE_EVENTS)) { return; @@ -519,8 +519,8 @@ SerialCheckProc( (infoPtr->error & SERIAL_READ_ERRORS)) { infoPtr->readable = 1; time = SerialGetMilliseconds(); - if ((unsigned int) (time - infoPtr->lastEventTime) - >= (unsigned int) infoPtr->blockTime) { + if ((time - infoPtr->lastEventTime) + >= (unsigned long long) infoPtr->blockTime) { needEvent = 1; infoPtr->lastEventTime = time; } @@ -535,7 +535,7 @@ SerialCheckProc( if (needEvent) { infoPtr->flags |= SERIAL_PENDING; - evPtr = (SerialEvent *)ckalloc(sizeof(SerialEvent)); + evPtr = (SerialEvent *)Tcl_Alloc(sizeof(SerialEvent)); evPtr->header.proc = SerialEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -561,7 +561,7 @@ SerialCheckProc( static int SerialBlockProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -600,7 +600,7 @@ SerialBlockProc( static int SerialCloseProc( - ClientData instanceData, /* Pointer to SerialInfo structure. */ + void *instanceData, /* Pointer to SerialInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -670,10 +670,10 @@ SerialCloseProc( */ if (serialPtr->writeBuf != NULL) { - ckfree(serialPtr->writeBuf); + Tcl_Free(serialPtr->writeBuf); serialPtr->writeBuf = NULL; } - ckfree(serialPtr); + Tcl_Free(serialPtr); if (errorCode == 0) { return result; @@ -796,7 +796,7 @@ SerialBlockingWrite( LeaveCriticalSection(&infoPtr->csWrite); if (result == FALSE) { - int err = GetLastError(); + DWORD err = GetLastError(); switch (err) { case ERROR_IO_PENDING: @@ -855,7 +855,7 @@ SerialBlockingWrite( static int SerialInputProc( - ClientData instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -904,7 +904,7 @@ SerialInputProc( } } else { /* - * BLOCKING mode: Tcl trys to read a full buffer of 4 kBytes here. + * BLOCKING mode: Tcl tries to read a full buffer of 4 kBytes here. */ if (cStat.cbInQue > 0) { @@ -918,7 +918,7 @@ SerialInputProc( } if (bufSize == 0) { - return bytesRead = 0; + return 0; } /* @@ -962,7 +962,7 @@ SerialInputProc( static int SerialOutputProc( - ClientData instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -973,9 +973,9 @@ SerialOutputProc( *errorCode = 0; /* - * At EXIT Tcl trys to flush all open channels in blocking mode. We avoid + * At EXIT Tcl tries to flush all open channels in blocking mode. We avoid * blocking output after ExitProc or CloseHandler(chan) has been called by - * checking the corrresponding variables. + * checking the corresponding variables. */ if (!initialized || TclInExit()) { @@ -1035,10 +1035,10 @@ SerialOutputProc( */ if (infoPtr->writeBuf) { - ckfree(infoPtr->writeBuf); + Tcl_Free(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = (char *)ckalloc(toWrite); + infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; @@ -1192,7 +1192,7 @@ SerialEventProc( static void SerialWatchProc( - ClientData instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1249,13 +1249,13 @@ SerialWatchProc( static int SerialGetHandleProc( - ClientData instanceData, /* The serial state. */ + void *instanceData, /* The serial state. */ TCL_UNUSED(int) /*direction*/, - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; - *handlePtr = (ClientData) infoPtr->handle; + *handlePtr = (void *) infoPtr->handle; return TCL_OK; } @@ -1455,10 +1455,10 @@ TclWinOpenSerialChannel( SerialInit(); - infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo)); + infoPtr = (SerialInfo *)Tcl_Alloc(sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); - infoPtr->validMask = permissions; + infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE); infoPtr->handle = handle; infoPtr->channel = (Tcl_Channel) NULL; infoPtr->readable = 0; @@ -1476,8 +1476,7 @@ TclWinOpenSerialChannel( * are shared between multiple channels (stdin/stdout). */ - sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); - + TclWinGenerateChannelName(channelName, "file", infoPtr); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, infoPtr, permissions); @@ -1508,13 +1507,7 @@ TclWinOpenSerialChannel( infoPtr->evWritable), 0, NULL); } - /* - * Files have default translation of AUTO and ^Z eof char, which means - * that a ^Z will be accepted as EOF when reading. - */ - Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); return infoPtr->channel; } @@ -1564,7 +1557,7 @@ SerialErrorStr( if (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) { char buf[TCL_INTEGER_SPACE + 1]; - wsprintfA(buf, "%d", error); + snprintf(buf, sizeof(buf), "%ld", error); Tcl_DStringAppendElement(dsPtr, buf); } } @@ -1619,7 +1612,7 @@ SerialModemStatusStr( static int SerialSetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -1630,7 +1623,7 @@ SerialSetOptionProc( size_t len, vlen; Tcl_DString ds; const WCHAR *native; - int argc; + Tcl_Size argc; const char **argv; infoPtr = (SerialInfo *) instanceData; @@ -1648,12 +1641,12 @@ SerialSetOptionProc( */ if ((len > 2) && (strncmp(optionName, "-closemode", len) == 0)) { - if (Tcl_UtfNcasecmp(value, "DEFAULT", vlen) == 0) { + if (strncasecmp(value, "DEFAULT", vlen) == 0) { infoPtr->flags &= ~SERIAL_CLOSE_MASK; - } else if (Tcl_UtfNcasecmp(value, "DRAIN", vlen) == 0) { + } else if (strncasecmp(value, "DRAIN", vlen) == 0) { infoPtr->flags &= ~SERIAL_CLOSE_MASK; infoPtr->flags |= SERIAL_CLOSE_DRAIN; - } else if (Tcl_UtfNcasecmp(value, "DISCARD", vlen) == 0) { + } else if (strncasecmp(value, "DISCARD", vlen) == 0) { infoPtr->flags &= ~SERIAL_CLOSE_MASK; infoPtr->flags |= SERIAL_CLOSE_DISCARD; } else { @@ -1662,7 +1655,7 @@ SerialSetOptionProc( "bad mode \"%s\" for -closemode: must be" " default, discard, or drain", value)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", - "VALUE", NULL); + "VALUE", (void *)NULL); } return TCL_ERROR; } @@ -1678,7 +1671,7 @@ SerialSetOptionProc( goto getStateFailed; } Tcl_DStringInit(&ds); - native = Tcl_UtfToWCharDString(value, -1, &ds); + native = Tcl_UtfToWCharDString(value, TCL_INDEX_NONE, &ds); result = BuildCommDCBW(native, &dcb); Tcl_DStringFree(&ds); @@ -1687,7 +1680,7 @@ SerialSetOptionProc( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -mode: should be baud,parity,data,stop", value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (void *)NULL); } return TCL_ERROR; } @@ -1751,7 +1744,7 @@ SerialSetOptionProc( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -handshake: must be one of" " xonxoff, rtscts, dtrdsr or none", value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", (void *)NULL); } return TCL_ERROR; } @@ -1779,10 +1772,10 @@ SerialSetOptionProc( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -xchar: should be a list of" - " two elements with each a single 8-bit character", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); + " two elements with each a single 8-bit character", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", (void *)NULL); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } @@ -1813,7 +1806,7 @@ SerialSetOptionProc( } dcb.XoffChar = (char) character; } - ckfree(argv); + Tcl_Free((void *)argv); if (!SetCommState(infoPtr->handle, &dcb)) { goto setStateFailed; @@ -1826,7 +1819,8 @@ SerialSetOptionProc( */ if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { - int i, res = TCL_OK; + Tcl_Size i; + int res = TCL_OK; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; @@ -1836,9 +1830,9 @@ SerialSetOptionProc( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -ttycontrol: should be " "a list of signal,value pairs", value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", (void *)NULL); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } @@ -1852,9 +1846,9 @@ SerialSetOptionProc( (DWORD) (flag ? SETDTR : CLRDTR))) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't set DTR signal", -1)); + "can't set DTR signal", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", - "FCONFIGURE", "TTY_SIGNAL", NULL); + "FCONFIGURE", "TTY_SIGNAL", (void *)NULL); } res = TCL_ERROR; break; @@ -1864,9 +1858,9 @@ SerialSetOptionProc( (DWORD) (flag ? SETRTS : CLRRTS))) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't set RTS signal", -1)); + "can't set RTS signal", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", - "FCONFIGURE", "TTY_SIGNAL", NULL); + "FCONFIGURE", "TTY_SIGNAL", (void *)NULL); } res = TCL_ERROR; break; @@ -1876,9 +1870,9 @@ SerialSetOptionProc( (DWORD) (flag ? SETBREAK : CLRBREAK))) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't set BREAK signal", -1)); + "can't set BREAK signal", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", - "FCONFIGURE", "TTY_SIGNAL", NULL); + "FCONFIGURE", "TTY_SIGNAL", (void *)NULL); } res = TCL_ERROR; break; @@ -1889,14 +1883,14 @@ SerialSetOptionProc( "bad signal name \"%s\" for -ttycontrol: must be" " DTR, RTS or BREAK", argv[i])); Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL", - NULL); + (void *)NULL); } res = TCL_ERROR; break; } } - ckfree(argv); + Tcl_Free((void *)argv); return res; } @@ -1922,14 +1916,14 @@ SerialSetOptionProc( inSize = atoi(argv[0]); outSize = atoi(argv[1]); } - ckfree(argv); + Tcl_Free((void *)argv); if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -sysbuffer: should be " "a list of one or two integers > 0", value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", (void *)NULL); } return TCL_ERROR; } @@ -2042,7 +2036,7 @@ SerialSetOptionProc( static int SerialGetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ @@ -2110,7 +2104,7 @@ SerialGetOptionProc( stop = (dcb.StopBits == ONESTOPBIT) ? "1" : (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2"; - wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, + snprintf(buf, sizeof(buf), "%ld,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize, stop); Tcl_DStringAppendElement(dsPtr, buf); } @@ -2126,7 +2120,7 @@ SerialGetOptionProc( char buf[TCL_INTEGER_SPACE + 1]; valid = 1; - wsprintfA(buf, "%d", infoPtr->blockTime); + snprintf(buf, sizeof(buf), "%d", infoPtr->blockTime); Tcl_DStringAppendElement(dsPtr, buf); } @@ -2142,9 +2136,9 @@ SerialGetOptionProc( char buf[TCL_INTEGER_SPACE + 1]; valid = 1; - wsprintfA(buf, "%d", infoPtr->sysBufRead); + snprintf(buf, sizeof(buf), "%ld", infoPtr->sysBufRead); Tcl_DStringAppendElement(dsPtr, buf); - wsprintfA(buf, "%d", infoPtr->sysBufWrite); + snprintf(buf, sizeof(buf), "%ld", infoPtr->sysBufWrite); Tcl_DStringAppendElement(dsPtr, buf); } if (len == 0) { @@ -2225,9 +2219,9 @@ SerialGetOptionProc( count = (int) cStat.cbOutQue + infoPtr->writeQueue; LeaveCriticalSection(&infoPtr->csWrite); - wsprintfA(buf, "%d", inBuffered + cStat.cbInQue); + snprintf(buf, sizeof(buf), "%ld", inBuffered + cStat.cbInQue); Tcl_DStringAppendElement(dsPtr, buf); - wsprintfA(buf, "%d", outBuffered + count); + snprintf(buf, sizeof(buf), "%d", outBuffered + count); Tcl_DStringAppendElement(dsPtr, buf); } @@ -2279,7 +2273,7 @@ SerialGetOptionProc( static void SerialThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { SerialInfo *infoPtr = (SerialInfo *) instanceData; @@ -2287,7 +2281,7 @@ SerialThreadActionProc( /* * We do not access firstSerialPtr in the thread structures. This is not * for all serials managed by the thread, but only those we are watching. - * Removal of the filevent handlers before transfer thus takes care of + * Removal of the fileevent handlers before transfer thus takes care of * this structure. */ diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 60575df..d600f1f 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -55,13 +55,6 @@ #endif /* - * Support for control over sockets' KEEPALIVE and NODELAY behavior is - * currently disabled. - */ - -#undef TCL_FEATURE_KEEPALIVE_NAGLE - -/* * Helper macros to make parts of this file clearer. The macros do exactly * what they say on the tin. :-) They also only ever refer to their arguments * once, and so can be used without regard to side effects. @@ -72,8 +65,7 @@ #define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ -#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) -#define SOCK_TEMPLATE "sock%p" +#define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) /* * The following variable is used to tell whether this module has been @@ -112,7 +104,7 @@ typedef union { #endif /* - * This structure describes per-instance state of a tcp based channel. + * This structure describes per-instance state of a tcp-based channel. */ typedef struct TcpState TcpState; @@ -125,11 +117,9 @@ typedef struct TcpFdList { struct TcpState { Tcl_Channel channel; /* Channel associated with this socket. */ - int testFlags; /* bit field for tests. Is set by testsocket - * test procedure */ - struct TcpFdList *sockets; /* Windows SOCKET handle. */ int flags; /* Bit field comprised of the flags described * below. */ + struct TcpFdList *sockets; /* Windows SOCKET handle. */ int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE, * FD_CLOSE, FD_ACCEPT and FD_CONNECT that * indicate which events are interesting. */ @@ -149,7 +139,7 @@ struct TcpState { * protected by semaphore */ Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */ - ClientData acceptProcData; /* The data for the accept proc. */ + void *acceptProcData; /* The data for the accept proc. */ /* * Only needed for client sockets @@ -170,7 +160,7 @@ struct TcpState { }; /* - * These bits may be ORed together into the "flags" field of a TcpState + * These bits may be OR'ed together into the "flags" field of a TcpState * structure. */ @@ -186,12 +176,7 @@ struct TcpState { * still pending */ #define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */ -/* - * These bits may be ORed together into the "testFlags" field of a TcpState - * structure. - */ - -#define TCP_ASYNC_TEST_MODE (1<<0) /* Async testing activated. Do not +#define TCP_ASYNC_TEST_MODE (1<<8) /* Async testing activated. Do not * automatically continue connection * process */ @@ -243,12 +228,11 @@ static WNDCLASSW windowClass; static int TcpConnect(Tcl_Interp *interp, TcpState *state); -static void InitSockets(void); +static void InitSocketWindowClass(void); static TcpState * NewSocketInfo(SOCKET socket); -static void SocketExitHandler(ClientData clientData); +static void SocketExitHandler(void *clientData); static LRESULT CALLBACK SocketProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); -static int SocketsEnabled(void); static void TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr); static int WaitForConnect(TcpState *statePtr, int *errorCodePtr); static int WaitForSocketEvent(TcpState *statePtr, int events, @@ -256,14 +240,14 @@ static int WaitForSocketEvent(TcpState *statePtr, int events, static void AddSocketInfoFd(TcpState *statePtr, SOCKET socket); static int FindFDInList(TcpState *statePtr, SOCKET socket); static DWORD WINAPI SocketThread(LPVOID arg); -static void TcpThreadActionProc(ClientData instanceData, +static void TcpThreadActionProc(void *instanceData, int action); +static int TcpCloseProc(void *, Tcl_Interp *); static Tcl_EventCheckProc SocketCheckProc; static Tcl_EventProc SocketEventProc; static Tcl_EventSetupProc SocketSetupProc; static Tcl_DriverBlockModeProc TcpBlockModeProc; -static Tcl_DriverCloseProc TcpCloseProc; static Tcl_DriverClose2Proc TcpClose2Proc; static Tcl_DriverSetOptionProc TcpSetOptionProc; static Tcl_DriverGetOptionProc TcpGetOptionProc; @@ -280,11 +264,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc; static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ -#ifndef TCL_NO_DEPRECATED - TcpCloseProc, /* Close proc. */ -#else - TCL_CLOSE2PROC, /* Close proc. */ -#endif + NULL, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -364,7 +344,7 @@ printaddrinfolist( void InitializeHostName( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { WCHAR wbuf[256]; @@ -377,31 +357,30 @@ InitializeHostName( * Convert string from native to UTF then change to lowercase. */ - Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, -1, &ds)); + Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, TCL_INDEX_NONE, &ds)); } else { - if (TclpHasSockets(NULL) == TCL_OK) { - /* - * The buffer size of 256 is recommended by the MSDN page that - * documents gethostname() as being always adequate. - */ + TclInitSockets(); + /* + * The buffer size of 256 is recommended by the MSDN page that + * documents gethostname() as being always adequate. + */ - Tcl_DString inDs; + Tcl_DString inDs; - Tcl_DStringInit(&inDs); - Tcl_DStringSetLength(&inDs, 256); - if (gethostname(Tcl_DStringValue(&inDs), - Tcl_DStringLength(&inDs)) == 0) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1, - &ds); - } - Tcl_DStringFree(&inDs); + Tcl_DStringInit(&inDs); + Tcl_DStringSetLength(&inDs, 256); + if (gethostname(Tcl_DStringValue(&inDs), + Tcl_DStringLength(&inDs)) == 0) { + Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&inDs), + TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); } + Tcl_DStringFree(&inDs); } *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); Tcl_DStringFree(&ds); } @@ -433,15 +412,13 @@ Tcl_GetHostName(void) /* *---------------------------------------------------------------------- * - * TclpHasSockets -- + * TclInitSockets -- * - * This function determines whether sockets are available on the current - * system and returns an error in interp if they are not. Note that - * interp may be NULL. + * Initialization of sockets for the thread. Also creates message + * handling window class for the process if needed. * * Results: - * Returns TCL_OK if the system supports sockets, or TCL_ERROR with an - * error in interp (if non-NULL). + * Nothing. Panics on failure. * * Side effects: * If not already prepared, initializes the TSD structure and socket @@ -451,24 +428,61 @@ Tcl_GetHostName(void) *---------------------------------------------------------------------- */ -int -TclpHasSockets( - Tcl_Interp *interp) /* Where to write an error message if sockets - * are not present, or NULL if no such message - * is to be written. */ +void +TclInitSockets() { - Tcl_MutexLock(&socketMutex); - InitSockets(); - Tcl_MutexUnlock(&socketMutex); + /* Then Per thread initialization. */ + DWORD id; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); - if (SocketsEnabled()) { - return TCL_OK; + if (tsdPtr != NULL) { + return; } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "sockets are not available on this system", -1)); + + InitSocketWindowClass(); + + /* + * OK, this thread has never done anything with sockets before. Construct + * a worker thread to handle asynchronous events related to sockets + * assigned to _this_ thread. + */ + + tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->pendingTcpState = NULL; + tsdPtr->socketList = NULL; + tsdPtr->hwnd = NULL; + tsdPtr->threadId = Tcl_GetCurrentThread(); + tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); + if (tsdPtr->readyEvent == NULL) { + goto initFailure; + } + tsdPtr->socketListLock = CreateEventW(NULL, FALSE, TRUE, NULL); + if (tsdPtr->socketListLock == NULL) { + goto initFailure; } - return TCL_ERROR; + tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0, + &id); + if (tsdPtr->socketThread == NULL) { + goto initFailure; + } + + SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); + + /* + * Wait for the thread to signal when the window has been created and if + * it is ready to go. + */ + + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); + + if (tsdPtr->hwnd != NULL) { + Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); + return; + } + + initFailure: + Tcl_Panic("InitSockets failed"); + return; } /* @@ -548,7 +562,7 @@ TclpFinalizeSockets(void) static int TcpBlockModeProc( - ClientData instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ @@ -558,7 +572,7 @@ TcpBlockModeProc( if (mode == TCL_MODE_NONBLOCKING) { SET_BITS(statePtr->flags, TCP_NONBLOCKING); } else { - CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING); + CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING); } return 0; } @@ -579,8 +593,8 @@ TcpBlockModeProc( * May return two error codes: * * EWOULDBLOCK: if connect is still in progress * * ENOTCONN: if connect failed. This would be the error message - * of a rect or sendto syscall so this is emulated here. - * * Null: Called by a backround operation. Do not block and don't + * of a recv or sendto syscall so this is emulated here. + * * Null: Called by a background operation. Do not block and don't * return any error code. * * Results: @@ -589,7 +603,7 @@ TcpBlockModeProc( * * Side effects: * Processes socket events off the system queue. May process - * asynchroneous connect. + * asynchronous connect. * *---------------------------------------------------------------------- */ @@ -630,7 +644,7 @@ WaitForConnect( * - Call by the event queue (errorCodePtr == NULL) */ - if (GOT_BITS(statePtr->testFlags, TCP_ASYNC_TEST_MODE) + if (GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE) && errorCodePtr != NULL && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { *errorCodePtr = EWOULDBLOCK; @@ -656,19 +670,19 @@ WaitForConnect( WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* - * Check for connect event. - */ + * Check for connect event. + */ if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) { /* - * Consume the connect event. - */ + * Consume the connect event. + */ CLEAR_BITS(statePtr->readyEvents, FD_CONNECT); /* * For blocking sockets and foreground processing, disable async - * connect as we continue now synchoneously. + * connect as we continue now synchronously. */ if (errorCodePtr != NULL && @@ -677,26 +691,26 @@ WaitForConnect( } /* - * Free list lock. - */ + * Free list lock. + */ SetEvent(tsdPtr->socketListLock); /* - * Continue connect. If switched to synchroneous connect, the + * Continue connect. If switched to synchronous connect, the * connect is terminated. */ result = TcpConnect(NULL, statePtr); /* - * Restore event service mode. - */ + * Restore event service mode. + */ (void) Tcl_SetServiceMode(oldMode); /* - * Check for Succesfull connect or async connect restart + * Check for Successful connect or async connect restart */ if (result == TCL_OK) { @@ -779,7 +793,7 @@ WaitForConnect( static int TcpInputProc( - ClientData instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -793,17 +807,6 @@ TcpInputProc( *errorCodePtr = 0; /* - * 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()) { - *errorCodePtr = EFAULT; - return -1; - } - - /* * First check to see if EOF was already detected, to prevent calling the * socket stack after the first time EOF is detected. */ @@ -834,9 +837,9 @@ TcpInputProc( SendSelectMessage(tsdPtr, UNSELECT, statePtr); /* - * Single fd operation: this proc is only called for a connected - * socket. - */ + * Single fd operation: this proc is only called for a connected + * socket. + */ bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0); CLEAR_BITS(statePtr->readyEvents, FD_READ); @@ -867,7 +870,7 @@ TcpInputProc( /* * If an RST comes, then ignore the error and report an EOF just like - * on unix. + * on Unix. */ if (error == WSAECONNRESET) { @@ -881,7 +884,7 @@ TcpInputProc( */ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING) - || (error != WSAEWOULDBLOCK)) { + || (error != WSAEWOULDBLOCK)) { Tcl_WinConvertError(error); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; @@ -923,7 +926,7 @@ TcpInputProc( static int TcpOutputProc( - ClientData instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ @@ -936,17 +939,6 @@ TcpOutputProc( *errorCodePtr = 0; /* - * 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()) { - *errorCodePtr = EFAULT; - return -1; - } - - /* * Check if there is an async connect running. * For blocking sockets terminate connect, otherwise do one step. * For a non blocking socket return EWOULDBLOCK if connect not terminated @@ -960,9 +952,9 @@ TcpOutputProc( SendSelectMessage(tsdPtr, UNSELECT, statePtr); /* - * Single fd operation: this proc is only called for a connected - * socket. - */ + * Single fd operation: this proc is only called for a connected + * socket. + */ written = send(statePtr->sockets->fd, buf, toWrite, 0); if (written != SOCKET_ERROR) { @@ -1038,7 +1030,7 @@ TcpOutputProc( static int TcpCloseProc( - ClientData instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ TCL_UNUSED(Tcl_Interp *)) { TcpState *statePtr = (TcpState *)instanceData; @@ -1047,28 +1039,20 @@ TcpCloseProc( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * 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. + * Clean up the OS socket handle. The default Windows setting for a + * socket is SO_DONTLINGER, which does a graceful shutdown in the + * background. */ - if (SocketsEnabled()) { - /* - * Clean up the OS socket handle. The default Windows setting for a - * socket is SO_DONTLINGER, which does a graceful shutdown in the - * background. - */ + while (statePtr->sockets != NULL) { + TcpFdList *thisfd = statePtr->sockets; - while (statePtr->sockets != NULL) { - TcpFdList *thisfd = statePtr->sockets; - - statePtr->sockets = thisfd->next; - if (closesocket(thisfd->fd) == SOCKET_ERROR) { - Tcl_WinConvertError((DWORD) WSAGetLastError()); - errorCode = Tcl_GetErrno(); - } - ckfree(thisfd); + statePtr->sockets = thisfd->next; + if (closesocket(thisfd->fd) == SOCKET_ERROR) { + Tcl_WinConvertError((DWORD) WSAGetLastError()); + errorCode = Tcl_GetErrno(); } + Tcl_Free(thisfd); } if (statePtr->addrlist != NULL) { @@ -1088,16 +1072,16 @@ TcpCloseProc( if (tsdPtr->pendingTcpState != NULL && tsdPtr->pendingTcpState == statePtr) { /* - * Get infoPtr lock, because this concerns the notifier thread. - */ + * Get infoPtr lock, because this concerns the notifier thread. + */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); tsdPtr->pendingTcpState = NULL; /* - * Free list lock. - */ + * Free list lock. + */ SetEvent(tsdPtr->socketListLock); } @@ -1109,7 +1093,7 @@ TcpCloseProc( * fear of damaging the list. */ - ckfree(statePtr); + Tcl_Free(statePtr); return errorCode; } @@ -1132,7 +1116,7 @@ TcpCloseProc( static int TcpClose2Proc( - ClientData instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { @@ -1182,48 +1166,31 @@ TcpClose2Proc( static int TcpSetOptionProc( - ClientData instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to set. */ - TCL_UNUSED(const char *) /*value*/) /* New value for option. */ + const char *value) /* New value for option. */ { -#ifdef TCL_FEATURE_KEEPALIVE_NAGLE - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; SOCKET sock; -#else - (void)instanceData; -#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ - - /* - * 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. - */ + size_t len = 0; - if (!SocketsEnabled()) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "winsock is not initialized", -1)); - } - return TCL_ERROR; + if (optionName != NULL) { + len = strlen(optionName); } -#ifdef TCL_FEATURE_KEEPALIVE_NAGLE -#error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list" sock = statePtr->sockets->fd; - if (!strcasecmp(optionName, "-keepalive")) { - BOOL val = FALSE; - int boolVar, rtn; + if ((len > 1) && (optionName[1] == 'k') && + (strncmp(optionName, "-keepalive", len) == 0)) { + BOOL boolVar; + int rtn; if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) { return TCL_ERROR; } - if (boolVar) { - val = TRUE; - } rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, - (const char *) &val, sizeof(BOOL)); + (const char *) &boolVar, sizeof(boolVar)); if (rtn != 0) { Tcl_WinConvertError(WSAGetLastError()); if (interp) { @@ -1234,18 +1201,17 @@ TcpSetOptionProc( return TCL_ERROR; } return TCL_OK; - } else if (!strcasecmp(optionName, "-nagle")) { - BOOL val = FALSE; - int boolVar, rtn; + } + if ((len > 1) && (optionName[1] == 'n') && + (strncmp(optionName, "-nodelay", len) == 0)) { + BOOL boolVar; + int rtn; if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) { return TCL_ERROR; } - if (!boolVar) { - val = TRUE; - } rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, - (const char *) &val, sizeof(BOOL)); + (const char *) &boolVar, sizeof(boolVar)); if (rtn != 0) { Tcl_WinConvertError(WSAGetLastError()); if (interp) { @@ -1257,11 +1223,7 @@ TcpSetOptionProc( } return TCL_OK; } - - return Tcl_BadChannelOption(interp, optionName, "keepalive nagle"); -#else - return Tcl_BadChannelOption(interp, optionName, ""); -#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ + return Tcl_BadChannelOption(interp, optionName, "keepalive nodelay"); } /* @@ -1287,7 +1249,7 @@ TcpSetOptionProc( static int TcpGetOptionProc( - ClientData instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to retrieve the value * for, or NULL to get all options and their @@ -1303,27 +1265,13 @@ TcpGetOptionProc( #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" /* - * 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()) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "winsock is not initialized", -1)); - } - return TCL_ERROR; - } - - /* * Go one step in async connect * - * If any error is thrown save it as backround error to report eventually + * If any error is thrown save it as background error to report eventually * below. */ - if (!GOT_BITS(statePtr->testFlags, TCP_ASYNC_TEST_MODE)) { + if (!GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE)) { WaitForConnect(statePtr, NULL); } @@ -1335,8 +1283,8 @@ TcpGetOptionProc( if ((len > 1) && (optionName[1] == 'e') && (strncmp(optionName, "-error", len) == 0)) { /* - * Do not return any errors if async connect is running. - */ + * Do not return any errors if async connect is running. + */ if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) { @@ -1348,7 +1296,7 @@ TcpGetOptionProc( if (statePtr->connectError != 0) { Tcl_DStringAppend(dsPtr, - Tcl_ErrnoMsg(statePtr->connectError), -1); + Tcl_ErrnoMsg(statePtr->connectError), TCL_INDEX_NONE); statePtr->connectError = 0; } } else { @@ -1383,8 +1331,7 @@ TcpGetOptionProc( if (err) { Tcl_WinConvertError(err); - Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), - -1); + Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), TCL_INDEX_NONE); } } } @@ -1395,12 +1342,12 @@ TcpGetOptionProc( (strncmp(optionName, "-connecting", len) == 0)) { Tcl_DStringAppend(dsPtr, GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING) - ? "1" : "0", -1); + ? "1" : "0", TCL_INDEX_NONE); return TCL_OK; } if (interp != NULL - && Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { + && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) { reverseDNS = NI_NUMERICHOST; } @@ -1421,7 +1368,7 @@ TcpGetOptionProc( return TCL_OK; } } else if (getpeername(sock, (LPSOCKADDR) &(peername.sa), - &size) == 0) { + &size) == 0) { /* * Peername fetch succeeded - output list */ @@ -1479,7 +1426,7 @@ TcpGetOptionProc( * In async connect output an empty string */ - found = 1; + found = 1; } else { for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { sock = fds->fd; @@ -1536,54 +1483,43 @@ TcpGetOptionProc( } } -#ifdef TCL_FEATURE_KEEPALIVE_NAGLE - if (len == 0 || !strncmp(optionName, "-keepalive", len)) { + if ((len == 0) || ((len > 1) && (optionName[1] == 'k') && + (strncmp(optionName, "-keepalive", len) == 0))) { int optlen; BOOL opt = FALSE; if (len == 0) { + sock = statePtr->sockets->fd; Tcl_DStringAppendElement(dsPtr, "-keepalive"); } optlen = sizeof(BOOL); getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen); - if (opt) { - Tcl_DStringAppendElement(dsPtr, "1"); - } else { - Tcl_DStringAppendElement(dsPtr, "0"); - } + Tcl_DStringAppendElement(dsPtr, opt ? "1" : "0"); if (len > 0) { return TCL_OK; } } - if (len == 0 || !strncmp(optionName, "-nagle", len)) { + if ((len == 0) || ((len > 1) && (optionName[1] == 'n') && + (strncmp(optionName, "-nodelay", len) == 0))) { int optlen; BOOL opt = FALSE; if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-nagle"); + sock = statePtr->sockets->fd; + Tcl_DStringAppendElement(dsPtr, "-nodelay"); } optlen = sizeof(BOOL); getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen); - if (opt) { - Tcl_DStringAppendElement(dsPtr, "0"); - } else { - Tcl_DStringAppendElement(dsPtr, "1"); - } + Tcl_DStringAppendElement(dsPtr, opt ? "1" : "0"); if (len > 0) { return TCL_OK; } } -#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ if (len > 0) { -#ifdef TCL_FEATURE_KEEPALIVE_NAGLE - return Tcl_BadChannelOption(interp, optionName, - "connecting peername sockname keepalive nagle"); -#else return Tcl_BadChannelOption(interp, optionName, - "connecting peername sockname"); -#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ + "connecting keepalive nodelay peername sockname"); } return TCL_OK; @@ -1609,7 +1545,7 @@ TcpGetOptionProc( static void TcpWatchProc( - ClientData instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1663,17 +1599,15 @@ TcpWatchProc( static int TcpGetHandleProc( - ClientData instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ TCL_UNUSED(int) /*direction*/, - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { TcpState *statePtr = (TcpState *)instanceData; *handlePtr = INT2PTR(statePtr->sockets->fd); return TCL_OK; } - - /* *---------------------------------------------------------------------- @@ -1732,9 +1666,9 @@ TcpConnect( for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; statePtr->addr = statePtr->addr->ai_next) { - for (statePtr->myaddr = statePtr->myaddrlist; - statePtr->myaddr != NULL; - statePtr->myaddr = statePtr->myaddr->ai_next) { + for (statePtr->myaddr = statePtr->myaddrlist; + statePtr->myaddr != NULL; + statePtr->myaddr = statePtr->myaddr->ai_next) { /* * No need to try combinations of local and remote addresses * of different families. @@ -1754,8 +1688,8 @@ TcpConnect( } /* - * Get statePtr lock. - */ + * Get statePtr lock. + */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); @@ -1767,17 +1701,17 @@ TcpConnect( Tcl_SetErrno(0); statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, - SOCK_STREAM, 0); + SOCK_STREAM, 0); /* - * Free list lock. - */ + * Free list lock. + */ SetEvent(tsdPtr->socketListLock); /* - * Continue on socket creation error. - */ + * Continue on socket creation error. + */ if (statePtr->sockets->fd == INVALID_SOCKET) { Tcl_WinConvertError((DWORD) WSAGetLastError()); @@ -1790,14 +1724,14 @@ TcpConnect( */ SetHandleInformation((HANDLE) statePtr->sockets->fd, - HANDLE_FLAG_INHERIT, 0); + HANDLE_FLAG_INHERIT, 0); /* * Set kernel space buffering */ TclSockMinimumBuffers((void *) statePtr->sockets->fd, - TCP_BUFFER_SIZE); + TCP_BUFFER_SIZE); /* * Try to bind to a local port. @@ -1810,7 +1744,7 @@ TcpConnect( } /* - * For asynchroneous connect set the socket in nonblocking mode + * For asynchronous connect set the socket in nonblocking mode * and activate connect notification */ @@ -1819,8 +1753,8 @@ TcpConnect( int in_socket_list = 0; /* - * Get statePtr lock. - */ + * Get statePtr lock. + */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); @@ -1848,7 +1782,7 @@ TcpConnect( /* * Set connect mask to connect events - * + * * This is activated by a SOCKET_SELECT message to the * notifier thread. */ @@ -1861,9 +1795,9 @@ TcpConnect( SetEvent(tsdPtr->socketListLock); - /* - * Activate accept notification. - */ + /* + * Activate accept notification. + */ SendSelectMessage(tsdPtr, SELECT, statePtr); } @@ -1880,7 +1814,7 @@ TcpConnect( if (async_connect && error == WSAEWOULDBLOCK) { /* - * Asynchroneous connect + * Asynchronous connect * * Remember that we jump back behind this next round */ @@ -1899,33 +1833,33 @@ TcpConnect( CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); /* - * Get statePtr lock. - */ + * Get statePtr lock. + */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* - * Get signaled connect error. - */ + * Get signaled connect error. + */ Tcl_WinConvertError((DWORD) statePtr->notifierConnectError); /* - * Clear eventual connect flag. - */ + * Clear eventual connect flag. + */ CLEAR_BITS(statePtr->selectEvents, FD_CONNECT); /* - * Free list lock. - */ + * Free list lock. + */ SetEvent(tsdPtr->socketListLock); } /* * Clear the tsd socket list pointer if we did not wait for - * the FD_CONNECT asynchroneously + * the FD_CONNECT asynchronously */ tsdPtr->pendingTcpState = NULL; @@ -1949,7 +1883,7 @@ TcpConnect( if (Tcl_GetErrno() == 0) { /* - * Succesfully connected + * Successfully connected * * Set up the select mask for read/write events. */ @@ -1977,38 +1911,38 @@ TcpConnect( statePtr->selectEvents = FD_WRITE|FD_READ; /* - * Get statePtr lock. - */ + * Get statePtr lock. + */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* - * Signal ready readable and writable events. - */ + * Signal ready readable and writable events. + */ SET_BITS(statePtr->readyEvents, FD_WRITE | FD_READ); /* - * Flag error to event routine. - */ + * Flag error to event routine. + */ SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); /* - * Save connect error to be reported by 'fconfigure -error'. - */ + * Save connect error to be reported by 'fconfigure -error'. + */ statePtr->connectError = Tcl_GetErrno(); /* - * Free list lock. - */ + * Free list lock. + */ SetEvent(tsdPtr->socketListLock); } /* - * Error message on synchroneous connect + * Error message on synchronous connect */ if (interp != NULL) { @@ -2053,19 +1987,7 @@ Tcl_OpenTcpClient( struct addrinfo *addrlist = NULL, *myaddrlist = NULL; char channelName[SOCK_CHAN_LENGTH]; - if (TclpHasSockets(interp) != TCL_OK) { - return NULL; - } - - /* - * 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; - } + TclInitSockets(); /* * Do the name lookups for the local and remote addresses. @@ -2099,17 +2021,16 @@ Tcl_OpenTcpClient( return NULL; } - sprintf(channelName, SOCK_TEMPLATE, statePtr); - + TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, (TCL_READABLE | TCL_WRITABLE)); if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf")) { - Tcl_Close(NULL, statePtr->channel); + Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel, "-eofchar", "")) { - Tcl_Close(NULL, statePtr->channel); + Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } return statePtr->channel; @@ -2133,15 +2054,13 @@ Tcl_OpenTcpClient( Tcl_Channel Tcl_MakeTcpClientChannel( - ClientData sock) /* The socket to wrap up into a channel. */ + void *sock) /* The socket to wrap up into a channel. */ { TcpState *statePtr; char channelName[SOCK_CHAN_LENGTH]; ThreadSpecificData *tsdPtr; - if (TclpHasSockets(NULL) != TCL_OK) { - return NULL; - } + TclInitSockets(); tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); @@ -2160,7 +2079,7 @@ Tcl_MakeTcpClientChannel( statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; SendSelectMessage(tsdPtr, SELECT, statePtr); - sprintf(channelName, SOCK_TEMPLATE, statePtr); + TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, (TCL_READABLE | TCL_WRITABLE)); Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf"); @@ -2190,10 +2109,12 @@ Tcl_OpenTcpServerEx( const char *service, /* Port number to open. */ const char *myHost, /* Name of local host. */ unsigned int flags, /* Flags. */ + int backlog, /* Length of OS listen backlog queue, or -1 + * for default. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ - ClientData acceptProcData) /* Data for the callback. */ + void *acceptProcData) /* Data for the callback. */ { SOCKET sock = INVALID_SOCKET; unsigned short chosenport = 0; @@ -2205,19 +2126,7 @@ Tcl_OpenTcpServerEx( const char *errorMsg = NULL; int optvalue, port; - if (TclpHasSockets(interp) != TCL_OK) { - return NULL; - } - - /* - * 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; - } + TclInitSockets(); /* * Construct the addresses for each end of the socket. @@ -2229,7 +2138,7 @@ Tcl_OpenTcpServerEx( } if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, - &errorMsg)) { + &errorMsg)) { goto error; } @@ -2287,7 +2196,7 @@ Tcl_OpenTcpServerEx( */ if (bind(sock, addrPtr->ai_addr, - addrPtr->ai_addrlen) == SOCKET_ERROR) { + addrPtr->ai_addrlen) == SOCKET_ERROR) { Tcl_WinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; @@ -2312,7 +2221,10 @@ Tcl_OpenTcpServerEx( * different, and there may be differences between TCP/IP stacks). */ - if (listen(sock, SOMAXCONN) == SOCKET_ERROR) { + if (backlog < 0) { + backlog = SOMAXCONN; + } + if (listen(sock, backlog) == SOCKET_ERROR) { Tcl_WinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; @@ -2339,7 +2251,7 @@ Tcl_OpenTcpServerEx( statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; - sprintf(channelName, SOCK_TEMPLATE, statePtr); + TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, 0); /* @@ -2357,7 +2269,7 @@ Tcl_OpenTcpServerEx( SendSelectMessage(tsdPtr, SELECT, statePtr); if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close(NULL, statePtr->channel); + Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } return statePtr->channel; @@ -2393,9 +2305,9 @@ Tcl_OpenTcpServerEx( static void TcpAccept( - TcpFdList *fds, /* Server socket that accepted newSocket. */ - SOCKET newSocket, /* Newly accepted socket. */ - address addr) /* Address of new socket. */ + TcpFdList *fds, /* Server socket that accepted newSocket. */ + SOCKET newSocket, /* Newly accepted socket. */ + address addr) /* Address of new socket. */ { TcpState *newInfoPtr; TcpState *statePtr = fds->statePtr; @@ -2424,17 +2336,17 @@ TcpAccept( newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); SendSelectMessage(tsdPtr, SELECT, newInfoPtr); - sprintf(channelName, SOCK_TEMPLATE, newInfoPtr); + TclWinGenerateChannelName(channelName, "sock", newInfoPtr); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close(NULL, newInfoPtr->channel); + Tcl_CloseEx(NULL, newInfoPtr->channel, 0); return; } if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close(NULL, newInfoPtr->channel); + Tcl_CloseEx(NULL, newInfoPtr->channel, 0); return; } @@ -2453,28 +2365,27 @@ TcpAccept( /* *---------------------------------------------------------------------- * - * InitSockets -- + * InitSocketWindowClass -- * - * Registers the event window for the socket notifier code. - * - * Assumes socketMutex is held. + * Registers the event window class for the socket notifier code. + * Caller must not hold socket mutex lock. * * Results: * None. * * Side effects: - * Register a new window class and creates a - * window for use in asynchronous socket notification. + * Register a new window class. * *---------------------------------------------------------------------- */ static void -InitSockets(void) +InitSocketWindowClass(void) { - DWORD id; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); - + if (initialized) { + return; + } + Tcl_MutexLock(&socketMutex); if (!initialized) { initialized = 1; TclCreateLateExitHandler(SocketExitHandler, NULL); @@ -2489,7 +2400,7 @@ InitSockets(void) windowClass.style = 0; windowClass.cbClsExtra = 0; windowClass.cbWndExtra = 0; - windowClass.hInstance = TclWinGetTclInstance(); + windowClass.hInstance = (HINSTANCE)TclWinGetTclInstance(); windowClass.hbrBackground = NULL; windowClass.lpszMenuName = NULL; windowClass.lpszClassName = className; @@ -2502,98 +2413,17 @@ InitSockets(void) goto initFailure; } } - - /* - * Check for per-thread initialization. - */ - - if (tsdPtr != NULL) { - return; - } - - /* - * OK, this thread has never done anything with sockets before. Construct - * a worker thread to handle asynchronous events related to sockets - * assigned to _this_ thread. - */ - - tsdPtr = TCL_TSD_INIT(&dataKey); - tsdPtr->pendingTcpState = NULL; - tsdPtr->socketList = NULL; - tsdPtr->hwnd = NULL; - tsdPtr->threadId = Tcl_GetCurrentThread(); - tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); - if (tsdPtr->readyEvent == NULL) { - goto initFailure; - } - tsdPtr->socketListLock = CreateEventW(NULL, FALSE, TRUE, NULL); - if (tsdPtr->socketListLock == NULL) { - goto initFailure; - } - tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0, - &id); - if (tsdPtr->socketThread == NULL) { - goto initFailure; - } - - SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); - - /* - * Wait for the thread to signal when the window has been created and if - * it is ready to go. - */ - - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - - if (tsdPtr->hwnd == NULL) { - goto initFailure; /* Trouble creating the window. */ - } - - Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); + Tcl_MutexUnlock(&socketMutex); return; initFailure: - TclpFinalizeSockets(); - initialized = -1; - return; + Tcl_MutexUnlock(&socketMutex); /* Probably pointless before panicing */ + Tcl_Panic("InitSockets failed"); } /* *---------------------------------------------------------------------- * - * SocketsEnabled -- - * - * Check that the WinSock was successfully initialized. - * - * Warning: - * This check was useful in times of Windows98 where WinSock may - * not be available. This is not the case any more. - * This function may be removed with TCL 9.0 - * - * Results: - * 1 if it is. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -SocketsEnabled(void) -{ - int enabled; - - Tcl_MutexLock(&socketMutex); - enabled = (initialized == 1); - Tcl_MutexUnlock(&socketMutex); - return enabled; -} - - -/* - *---------------------------------------------------------------------- - * * SocketExitHandler -- * * Callback invoked during exit clean up to delete the socket @@ -2610,7 +2440,7 @@ SocketsEnabled(void) static void SocketExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_MutexLock(&socketMutex); @@ -2620,7 +2450,7 @@ SocketExitHandler( */ TclpFinalizeSockets(); - UnregisterClassW(className, TclWinGetTclInstance()); + UnregisterClassW(className, (HINSTANCE)TclWinGetTclInstance()); initialized = 0; Tcl_MutexUnlock(&socketMutex); } @@ -2644,7 +2474,7 @@ SocketExitHandler( void SocketSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { TcpState *statePtr; @@ -2662,7 +2492,7 @@ SocketSetupProc( for (statePtr = tsdPtr->socketList; statePtr != NULL; statePtr = statePtr->nextPtr) { if (GOT_BITS(statePtr->readyEvents, - statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)) { + statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)) { Tcl_SetMaxBlockTime(&blockTime); break; } @@ -2689,7 +2519,7 @@ SocketSetupProc( static void SocketCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { TcpState *statePtr; @@ -2713,7 +2543,7 @@ SocketCheckProc( statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { SET_BITS(statePtr->flags, SOCKET_PENDING); - evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent)); + evPtr = (SocketEvent *)Tcl_Alloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; evPtr->socket = statePtr->sockets->fd; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -2819,19 +2649,19 @@ SocketEventProc( if (GOT_BITS(statePtr->readyEvents, FD_ACCEPT)) { for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { /* - * Accept the incoming connection request. - */ + * Accept the incoming connection request. + */ len = sizeof(address); newSocket = accept(fds->fd, &(addr.sa), &len); /* - * On Tcl server sockets with multiple OS fds we loop over the fds + * On Tcl server sockets with multiple OS fds we loop over the fds * trying an accept() on each, so we expect INVALID_SOCKET. There * are also other network stack conditions that can result in * FD_ACCEPT but a subsequent failure on accept() by the time we * get around to it. - * + * * Access to sockets (acceptEventCount, readyEvents) in socketList * is still protected by the lock (prevents reintroduction of * SF Tcl Bug 3056775. @@ -2857,7 +2687,7 @@ SocketEventProc( SetEvent(tsdPtr->socketListLock); /* - * Caution: TcpAccept() has the side-effect of evaluating the + * Caution: TcpAccept() has the side-effect of evaluating the * server accept script (via AcceptCallbackProc() in tclIOCmd.c), * which can close the server socket and invalidate statePtr and * fds. If TcpAccept() accepts a socket we must return immediately @@ -2869,7 +2699,7 @@ SocketEventProc( } /* - * Loop terminated with no sockets accepted; clear the ready mask so + * Loop terminated with no sockets accepted; clear the ready mask so * we can detect the next connection request. Note that connection * requests are level triggered, so if there is a request already * pending, a new event will be generated. @@ -2985,21 +2815,21 @@ AddSocketInfoFd( if (fds == NULL) { /* - * Add the first FD. - */ + * Add the first FD. + */ - statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList)); + statePtr->sockets = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); fds = statePtr->sockets; } else { /* - * Find end of list and append FD. - */ + * Find end of list and append FD. + */ while (fds->next != NULL) { fds = fds->next; } - fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList)); + fds->next = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); fds = fds->next; } @@ -3032,7 +2862,7 @@ AddSocketInfoFd( static TcpState * NewSocketInfo(SOCKET socket) { - TcpState *statePtr = (TcpState *)ckalloc(sizeof(TcpState)); + TcpState *statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); @@ -3094,34 +2924,34 @@ WaitForSocketEvent( int event_found; /* - * Get statePtr lock. - */ + * Get statePtr lock. + */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* - * Check if event occured. - */ + * Check if event occurred. + */ event_found = GOT_BITS(statePtr->readyEvents, events); /* - * Free list lock. - */ + * Free list lock. + */ SetEvent(tsdPtr->socketListLock); /* - * Exit loop if event occured. - */ + * Exit loop if event occurred. + */ if (event_found) { break; } /* - * Exit loop if event did not occur but this is a non-blocking channel - */ + * Exit loop if event did not occur but this is a non-blocking channel + */ if (statePtr->flags & TCP_NONBLOCKING) { *errorCodePtr = EWOULDBLOCK; @@ -3217,7 +3047,7 @@ SocketThread( * * Side effects: * The flags for the given socket are updated to reflect the event that - * occured. + * occurred. * *---------------------------------------------------------------------- */ @@ -3367,7 +3197,7 @@ SocketProc( * * FindFDInList -- * - * Return true, if the given file descriptior is contained in the + * Return true, if the given file descriptor is contained in the * file descriptor list. * * Results: @@ -3395,68 +3225,6 @@ FindFDInList( /* *---------------------------------------------------------------------- * - * TclWinGetSockOpt, et al. -- - * - * Those functions are historically exported by the stubs table and - * just use the original system calls now. - * - * Warning: - * Those functions are depreciated and will be removed with TCL 9.0. - * - * Results: - * As defined for each function. - * - * Side effects: - * As defined for each function. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef TclWinGetSockOpt -int -TclWinGetSockOpt( - SOCKET s, - int level, - int optname, - char *optval, - int *optlen) -{ - - return getsockopt(s, level, optname, optval, optlen); -} -#undef TclWinSetSockOpt -int -TclWinSetSockOpt( - SOCKET s, - int level, - int optname, - const char *optval, - int optlen) -{ - return setsockopt(s, level, optname, optval, optlen); -} - -#undef TclpInetNtoa -char * -TclpInetNtoa( - struct in_addr addr) -{ - return inet_ntoa(addr); -} -#undef TclWinGetServByName -struct servent * -TclWinGetServByName( - const char *name, - const char *proto) -{ - return getservbyname(name, proto); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * TcpThreadActionProc -- * * Insert or remove any thread local refs to this channel. @@ -3472,7 +3240,7 @@ TclWinGetServByName( static void TcpThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { ThreadSpecificData *tsdPtr; @@ -3485,9 +3253,7 @@ TcpThreadActionProc( * sockets will not work. */ - Tcl_MutexLock(&socketMutex); - InitSockets(); - Tcl_MutexUnlock(&socketMutex); + TclInitSockets(); tsdPtr = TCL_TSD_INIT(&dataKey); diff --git a/win/tclWinTest.c b/win/tclWinTest.c index c910bc5..1b679a9 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -9,6 +9,8 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#undef BUILD_tcl +#undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif @@ -22,9 +24,8 @@ /* * For TestplatformChmod on Windows */ -#ifdef _WIN32 #include <aclapi.h> -#endif +#include <sddl.h> /* * MinGW 3.4.2 does not define this. @@ -41,7 +42,6 @@ static Tcl_ObjCmdProc TesteventloopCmd; static Tcl_ObjCmdProc TestvolumetypeCmd; static Tcl_ObjCmdProc TestwinclockCmd; static Tcl_ObjCmdProc TestwinsleepCmd; -static Tcl_ObjCmdProc TestSizeCmd; static Tcl_ObjCmdProc TestExceptionCmd; static int TestplatformChmod(const char *nativePath, int pmode); static Tcl_ObjCmdProc TestchmodCmd; @@ -78,7 +78,6 @@ TclplatformtestInit( Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL); return TCL_OK; } @@ -102,7 +101,7 @@ TclplatformtestInit( static int TesteventloopCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -153,7 +152,7 @@ TesteventloopCmd( framePtr = oldFramePtr; } else { Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), - "\": must be done or wait", NULL); + "\": must be done or wait", (void *)NULL); return TCL_ERROR; } return TCL_OK; @@ -178,7 +177,7 @@ TesteventloopCmd( static int TestvolumetypeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -207,11 +206,11 @@ TestvolumetypeCmd( if (found == 0) { Tcl_AppendResult(interp, "could not get volume type for \"", - (path?path:""), "\"", NULL); + (path?path:""), "\"", (void *)NULL); Tcl_WinConvertError(GetLastError()); return TCL_ERROR; } - Tcl_AppendResult(interp, volType, NULL); + Tcl_AppendResult(interp, volType, (void *)NULL); return TCL_OK; #undef VOL_BUF_SIZE } @@ -244,7 +243,7 @@ TestvolumetypeCmd( static int TestwinclockCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ @@ -293,7 +292,7 @@ TestwinclockCmd( static int TestwinsleepCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ @@ -311,28 +310,6 @@ TestwinsleepCmd( return TCL_OK; } -static int -TestSizeCmd( - TCL_UNUSED(ClientData), - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const * objv) /* Parameter vector */ -{ - - if (objc != 2) { - goto syntax; - } - if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) { - Tcl_StatBuf *statPtr; - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime))); - return TCL_OK; - } - -syntax: - Tcl_WrongNumArgs(interp, 1, objv, "st_mtime"); - return TCL_ERROR; -} - /* *---------------------------------------------------------------------- * @@ -358,7 +335,7 @@ syntax: static int TestExceptionCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ @@ -414,176 +391,189 @@ TestExceptionCmd( return TCL_OK; } +/* + * This "chmod" works sufficiently for test script purposes. Do not expect + * it to be exact emulation of Unix chmod (not sure if that's even possible) + */ static int TestplatformChmod( const char *nativePath, int pmode) { - static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION - | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION; - /* don't reset change permissions mask (WRITE_DAC, allow test-cases restore it to cleanup) */ - static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE - | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA - | FILE_WRITE_DATA - | DELETE; - /* - * References to security functions (only available on NT and later). + * Note FILE_DELETE_CHILD missing from dirWriteMask because we do + * not want overriding of child's delete setting when testing */ - - const BOOL set_readOnly = !(pmode & 0222); - BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted; - SID_IDENTIFIER_AUTHORITY userSidAuthority = { - SECURITY_WORLD_SID_AUTHORITY - }; - BYTE *secDesc = 0; - DWORD secDescLen, attr, newAclSize; - ACL_SIZE_INFORMATION ACLSize; - PACL curAcl, newAcl = 0; - WORD j; - SID *userSid = 0; - char *userDomain = 0; + static const DWORD dirWriteMask = + FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA | + FILE_ADD_FILE | FILE_ADD_SUBDIRECTORY | STANDARD_RIGHTS_WRITE | DELETE | + SYNCHRONIZE; + static const DWORD dirReadMask = + FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_LIST_DIRECTORY | + STANDARD_RIGHTS_READ | SYNCHRONIZE; + /* Note - default user privileges allow ignoring TRAVERSE setting */ + static const DWORD dirExecuteMask = + FILE_TRAVERSE | STANDARD_RIGHTS_READ | SYNCHRONIZE; + + static const DWORD fileWriteMask = + FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA | FILE_WRITE_DATA | + FILE_APPEND_DATA | STANDARD_RIGHTS_WRITE | DELETE | SYNCHRONIZE; + static const DWORD fileReadMask = + FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_READ_DATA | + STANDARD_RIGHTS_READ | SYNCHRONIZE; + static const DWORD fileExecuteMask = + FILE_EXECUTE | STANDARD_RIGHTS_READ | SYNCHRONIZE; + + DWORD attr, newAclSize; + PACL newAcl = NULL; int res = 0; - /* - * Process the chmod request. - */ - - attr = GetFileAttributesA(nativePath); + HANDLE hToken = NULL; + int i; + int nSids = 0; + struct { + PSID pSid; + DWORD mask; + DWORD sidLen; + } aceEntry[3]; + DWORD dw; + int isDir; + TOKEN_USER *pTokenUser = NULL; - /* - * nativePath not found - */ + res = -1; /* Assume failure */ + attr = GetFileAttributesA(nativePath); if (attr == 0xFFFFFFFF) { - res = -1; - goto done; + goto done; /* Not found */ } - /* - * If nativePath is not a directory, there is no special handling. - */ + isDir = (attr & FILE_ATTRIBUTE_DIRECTORY) != 0; - if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) { + if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hToken)) { goto done; } - /* - * Set the result to error, if the ACL change is successful it will be - * reset to 0. - */ - - res = -1; - - /* - * Read the security descriptor for the directory. Note the first call - * obtains the size of the security descriptor. - */ - - if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) { - DWORD secDescLen2 = 0; - - if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) { - goto done; - } - - secDesc = (BYTE *)ckalloc(secDescLen); - if (!GetFileSecurityA(nativePath, infoBits, - (PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2) - || (secDescLen < secDescLen2)) { - goto done; - } - } - - /* - * Get the World SID. - */ - - userSid = (SID *)ckalloc(GetSidLengthRequired((UCHAR) 1)); - InitializeSid(userSid, &userSidAuthority, (BYTE) 1); - *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID; - - /* - * If curAclPresent == false then curAcl and curAclDefaulted not valid. - */ - - if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc, - &curAclPresent, &curAcl, &curAclDefaulted)) { + /* Get process SID */ + if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &dw) && + GetLastError() != ERROR_INSUFFICIENT_BUFFER) { goto done; } - if (!curAclPresent || !curAcl) { - ACLSize.AclBytesInUse = 0; - ACLSize.AceCount = 0; - } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize), - AclSizeInformation)) { + pTokenUser = (TOKEN_USER *)Tcl_Alloc(dw); + if (!GetTokenInformation(hToken, TokenUser, pTokenUser, dw, &dw)) { goto done; } - - /* - * Allocate memory for the new ACL. - */ - - newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE) - + GetLengthSid(userSid) - sizeof(DWORD); - newAcl = (PACL) ckalloc(newAclSize); - - /* - * Initialize the new ACL. - */ - - if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) { + aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid); + aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen); + if (!CopySid(aceEntry[nSids].sidLen, + aceEntry[nSids].pSid, + pTokenUser->User.Sid)) { + Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ goto done; } - /* - * Add denied to make readonly, this will be known as a "read-only tag". + * Always include DACL modify rights so we don't get locked out */ - - if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION, - readOnlyMask, userSid)) { - goto done; + aceEntry[nSids].mask = READ_CONTROL | WRITE_DAC | WRITE_OWNER | SYNCHRONIZE | + FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES; + if (pmode & 0700) { + /* Owner permissions. Assumes current process is owner */ + if (pmode & 0400) { + aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask; + } + if (pmode & 0200) { + aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask; + } + if (pmode & 0100) { + aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask; + } } + ++nSids; + + if (pmode & 0070) { + /* Group permissions. */ - acl_readOnly_found = FALSE; - for (j = 0; j < ACLSize.AceCount; j++) { - LPVOID pACE2; - ACE_HEADER *phACE2; + TOKEN_PRIMARY_GROUP *pTokenGroup; - if (!GetAce(curAcl, j, &pACE2)) { + /* Get primary group SID */ + if (!GetTokenInformation( + hToken, TokenPrimaryGroup, NULL, 0, &dw) && + GetLastError() != ERROR_INSUFFICIENT_BUFFER) { goto done; } + pTokenGroup = (TOKEN_PRIMARY_GROUP *)Tcl_Alloc(dw); + if (!GetTokenInformation(hToken, TokenPrimaryGroup, pTokenGroup, dw, &dw)) { + Tcl_Free(pTokenGroup); + goto done; + } + aceEntry[nSids].sidLen = GetLengthSid(pTokenGroup->PrimaryGroup); + aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen); + if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenGroup->PrimaryGroup)) { + Tcl_Free(pTokenGroup); + Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ + goto done; + } + Tcl_Free(pTokenGroup); - phACE2 = (ACE_HEADER *) pACE2; - - /* - * Do NOT propagate inherited ACEs. - */ + /* Generate mask for group ACL */ - if (phACE2->AceFlags & INHERITED_ACE) { - continue; + aceEntry[nSids].mask = 0; + if (pmode & 0040) { + aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask; + } + if (pmode & 0020) { + aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask; + } + if (pmode & 0010) { + aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask; } + ++nSids; + } - /* - * Skip the "read-only tag" restriction (either added above, or it is - * being removed). - */ + if (pmode & 0007) { + /* World permissions */ + PSID pWorldSid; + if (!ConvertStringSidToSidA("S-1-1-0", &pWorldSid)) { + goto done; + } + aceEntry[nSids].sidLen = GetLengthSid(pWorldSid); + aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen); + if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pWorldSid)) { + LocalFree(pWorldSid); + Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ + goto done; + } + LocalFree(pWorldSid); - if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) { - ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2; + /* Generate mask for world ACL */ - if (pACEd->Mask == readOnlyMask - && EqualSid(userSid, (PSID) &pACEd->SidStart)) { - acl_readOnly_found = TRUE; - continue; - } + aceEntry[nSids].mask = 0; + if (pmode & 0004) { + aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask; + } + if (pmode & 0002) { + aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask; + } + if (pmode & 0001) { + aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask; } + ++nSids; + } - /* - * Copy the current ACE from the old to the new ACL. - */ + /* Allocate memory and initialize the new ACL. */ - if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2, - ((PACE_HEADER) pACE2)->AceSize)) { + newAclSize = sizeof(ACL); + /* Add in size required for each ACE entry in the ACL */ + for (i = 0; i < nSids; ++i) { + newAclSize += + offsetof(ACCESS_ALLOWED_ACE, SidStart) + aceEntry[i].sidLen; + } + newAcl = (PACL)Tcl_Alloc(newAclSize); + if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) { + goto done; + } + + for (i = 0; i < nSids; ++i) { + if (!AddAccessAllowedAce(newAcl, ACL_REVISION, aceEntry[i].mask, aceEntry[i].pSid)) { goto done; } } @@ -593,36 +583,39 @@ TestplatformChmod( * to remove inherited ACL (we need to overwrite the default ACL's in this case) */ - if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA( - (LPSTR) nativePath, SE_FILE_OBJECT, - DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/, - NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { + if (SetNamedSecurityInfoA((LPSTR)nativePath, + SE_FILE_OBJECT, + DACL_SECURITY_INFORMATION | + PROTECTED_DACL_SECURITY_INFORMATION, + NULL, + NULL, + newAcl, + NULL) == ERROR_SUCCESS) { res = 0; } done: - if (secDesc) { - ckfree(secDesc); + if (pTokenUser) { + Tcl_Free(pTokenUser); } - if (newAcl) { - ckfree(newAcl); + if (hToken) { + CloseHandle(hToken); } - if (userSid) { - ckfree(userSid); + if (newAcl) { + Tcl_Free(newAcl); } - if (userDomain) { - ckfree(userDomain); + for (i = 0; i < nSids; ++i) { + Tcl_Free(aceEntry[i].pSid); } if (res != 0) { return res; } - /* - * Run normal chmod command. - */ - + /* Run normal chmod command */ return chmod(nativePath, pmode); + + } /* @@ -646,7 +639,7 @@ TestplatformChmod( static int TestchmodCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ @@ -672,7 +665,7 @@ TestchmodCmd( } if (TestplatformChmod(translated, mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), - NULL); + (void *)NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index b69fbfc..37e0841 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -178,7 +178,7 @@ TclWinThreadStart( lpOrigStartAddress = winThreadPtr->lpStartAddress; lpOrigParameter = winThreadPtr->lpParameter; - ckfree(winThreadPtr); + Tcl_Free(winThreadPtr); return lpOrigStartAddress(lpOrigParameter); } @@ -203,15 +203,15 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */ - ClientData clientData, /* The one argument to Main(). */ - int stackSize, /* Size of stack for the new thread. */ + void *clientData, /* The one argument to Main(). */ + size_t stackSize, /* Size of stack for the new thread. */ int flags) /* Flags controlling behaviour of the new * thread. */ { WinThread *winThreadPtr; /* Per-thread startup info */ HANDLE tHandle; - winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread)); + winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread)); winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc; winThreadPtr->lpParameter = clientData; winThreadPtr->fpControl = _controlfp(0, 0); @@ -223,11 +223,11 @@ TclpThreadCreate( */ #if defined(_MSC_VER) || defined(__MSVCRT__) - tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, + tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize, (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr, 0, (unsigned *)idPtr); #else - tHandle = CreateThread(NULL, (DWORD) stackSize, + tHandle = CreateThread(NULL, (DWORD)stackSize, TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr); #endif @@ -535,7 +535,7 @@ TclFinalizeLock(void) #if TCL_THREADS /* locally used prototype */ -static void FinalizeConditionEvent(ClientData data); +static void FinalizeConditionEvent(void *data); /* *---------------------------------------------------------------------- @@ -568,7 +568,7 @@ Tcl_MutexLock( */ if (*mutexPtr == NULL) { - csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); @@ -629,7 +629,7 @@ TclpFinalizeMutex( if (csPtr != NULL) { DeleteCriticalSection(csPtr); - ckfree(csPtr); + Tcl_Free(csPtr); *mutexPtr = NULL; } } @@ -711,7 +711,7 @@ Tcl_ConditionWait( */ if (*condPtr == NULL) { - winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition)); + winCondPtr = (WinCondition *)Tcl_Alloc(sizeof(WinCondition)); InitializeCriticalSection(&winCondPtr->condLock); winCondPtr->firstPtr = NULL; winCondPtr->lastPtr = NULL; @@ -725,7 +725,7 @@ Tcl_ConditionWait( if (timePtr == NULL) { wtime = INFINITE; } else { - wtime = timePtr->sec * 1000 + timePtr->usec / 1000; + wtime = (DWORD)timePtr->sec * 1000 + (DWORD)timePtr->usec / 1000; } /* @@ -777,9 +777,9 @@ Tcl_ConditionWait( timeout = 0; } else { /* - * When dequeuing, we can leave the tsdPtr->nextPtr and + * When dequeueing, we can leave the tsdPtr->nextPtr and * tsdPtr->prevPtr with dangling pointers because they are - * reinitialilzed w/out reading them when the thread is enqueued + * reinitialized w/out reading them when the thread is enqueued * later. */ @@ -880,7 +880,7 @@ Tcl_ConditionNotify( static void FinalizeConditionEvent( - ClientData data) + void *data) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data; @@ -922,7 +922,7 @@ TclpFinalizeCondition( if (winCondPtr != NULL) { DeleteCriticalSection(&winCondPtr->condLock); - ckfree(winCondPtr); + Tcl_Free(winCondPtr); *condPtr = NULL; } } @@ -1037,7 +1037,7 @@ TclpThreadCreateKey(void) { DWORD *key; - key = (DWORD *)TclpSysAlloc(sizeof *key, 0); + key = (DWORD *)TclpSysAlloc(sizeof *key); if (key == NULL) { Tcl_Panic("unable to allocate thread key!"); } diff --git a/win/tclWinTime.c b/win/tclWinTime.c index a7e8474..a0c7833 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -12,10 +12,6 @@ #include "tclInt.h" -#define SECSPERDAY (60L * 60L * 24L) -#define SECSPERYEAR (SECSPERDAY * 365L) -#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) - /* * Number of samples over which to estimate the performance counter. */ @@ -23,27 +19,6 @@ #define SAMPLES 64 /* - * The following arrays contain the day of year for the last day of each - * month, where index 1 is January. - */ - -#ifndef TCL_NO_DEPRECATED -static const int normalDays[] = { - -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 -}; - -static const int leapDays[] = { - -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 -}; - -typedef struct { - char tzName[64]; /* Time zone name */ - struct tm tm; /* time information */ -} ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; -#endif /* TCL_NO_DEPRECATED */ - -/* * Data for managing high-resolution timers. */ @@ -133,10 +108,7 @@ static struct { * Declarations for functions defined later in this file. */ -#ifndef TCL_NO_DEPRECATED -static struct tm * ComputeGMT(const time_t *tp); -#endif /* TCL_NO_DEPRECATED */ -static void StopCalibration(ClientData clientData); +static void StopCalibration(void *clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); static void ResetCounterSamples(unsigned long long fileTime, @@ -144,10 +116,10 @@ static void ResetCounterSamples(unsigned long long fileTime, static long long AccumulateSample(long long perfCounter, unsigned long long fileTime); static void NativeScaleTime(Tcl_Time* timebuf, - ClientData clientData); + void *clientData); static long long NativeGetMicroseconds(void); static void NativeGetTime(Tcl_Time* timebuf, - ClientData clientData); + void *clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. @@ -155,7 +127,7 @@ static void NativeGetTime(Tcl_Time* timebuf, Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; -ClientData tclTimeClientData = NULL; +void *tclTimeClientData = NULL; /* * Inlined version of Tcl_GetTime. @@ -191,7 +163,7 @@ IsTimeNative(void) *---------------------------------------------------------------------- */ -unsigned long +unsigned long long TclpGetSeconds(void) { long long usecSincePosixEpoch; @@ -206,7 +178,7 @@ TclpGetSeconds(void) Tcl_Time t; GetTime(&t); - return t.sec; + return (unsigned long long)t.sec; } } @@ -229,7 +201,7 @@ TclpGetSeconds(void) *---------------------------------------------------------------------- */ -unsigned long +unsigned long long TclpGetClicks(void) { long long usecSincePosixEpoch; @@ -239,7 +211,7 @@ TclpGetClicks(void) */ if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { - return (unsigned long) usecSincePosixEpoch; + return (Tcl_WideUInt) usecSincePosixEpoch; } else { /* * Use the Tcl_GetTime abstraction to get the time in microseconds, as @@ -249,7 +221,8 @@ TclpGetClicks(void) Tcl_Time now; /* Current Tcl time */ GetTime(&now); - return ((unsigned long)(now.sec)*1000000UL) + (unsigned long)(now.usec); + return ((unsigned long long)(now.sec)*1000000ULL) + + (unsigned long long)(now.usec); } } @@ -374,7 +347,7 @@ TclpGetMicroseconds(void) Tcl_Time now; GetTime(&now); - return (((long long) now.sec) * 1000000) + now.usec; + return now.sec * 1000000 + now.usec; } } @@ -411,8 +384,8 @@ Tcl_GetTime( */ if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { - timePtr->sec = (long) (usecSincePosixEpoch / 1000000); - timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); + timePtr->sec = usecSincePosixEpoch / 1000000; + timePtr->usec = usecSincePosixEpoch % 1000000; } else { GetTime(timePtr); } @@ -438,7 +411,7 @@ Tcl_GetTime( static void NativeScaleTime( TCL_UNUSED(Tcl_Time *), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { /* * Native scale is 1:1. Nothing is done. @@ -626,7 +599,6 @@ NativeGetMicroseconds(void) LONGLONG perfCounterLastCall, curCounterFreq; /* Copy with current data of calibration * cycle. */ - LARGE_INTEGER curCounter; /* Current performance counter. */ @@ -650,7 +622,7 @@ NativeGetMicroseconds(void) if (curCounter.QuadPart <= perfCounterLastCall) { /* - * Calibrated file-time is saved from posix in 100-ns ticks + * Calibrated file-time is saved from Posix in 100-ns ticks */ return fileTimeLastCall / 10; @@ -669,7 +641,7 @@ NativeGetMicroseconds(void) if (curCounter.QuadPart - perfCounterLastCall < 11 * curCounterFreq * timeInfo.calibrationInterv / 10) { /* - * Calibrated file-time is saved from posix in 100-ns ticks. + * Calibrated file-time is saved from Posix in 100-ns ticks. */ return NativeCalc100NsTicks(fileTimeLastCall, @@ -681,6 +653,7 @@ NativeGetMicroseconds(void) /* * High resolution timer is not available. */ + return 0; } @@ -704,7 +677,7 @@ NativeGetMicroseconds(void) static void NativeGetTime( Tcl_Time *timePtr, - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { long long usecSincePosixEpoch; @@ -714,8 +687,8 @@ NativeGetTime( usecSincePosixEpoch = NativeGetMicroseconds(); if (usecSincePosixEpoch) { - timePtr->sec = (long) (usecSincePosixEpoch / 1000000); - timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); + timePtr->sec = usecSincePosixEpoch / 1000000; + timePtr->usec = usecSincePosixEpoch % 1000000; } else { /* * High resolution timer is not available. Just use ftime. @@ -724,7 +697,7 @@ NativeGetTime( struct _timeb t; _ftime(&t); - timePtr->sec = (long) t.time; + timePtr->sec = t.time; timePtr->usec = t.millitm * 1000; } } @@ -751,7 +724,7 @@ void TclWinResetTimerResolution(void); static void StopCalibration( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { SetEvent(timeInfo.exitEvent); @@ -768,226 +741,6 @@ StopCalibration( /* *---------------------------------------------------------------------- * - * TclpGetDate -- - * - * This function converts between seconds and struct tm. If useGMT is - * true, then the returned date will be in Greenwich Mean Time (GMT). - * Otherwise, it will be in the local time zone. - * - * Results: - * Returns a static tm structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -struct tm * -TclpGetDate( - const time_t *t, - int useGMT) -{ - struct tm *tmPtr; - time_t time; -#if defined(_WIN64) || (defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)) -# define t2 *t /* no need to cripple time to 32-bit */ -#else - time_t t2 = *(__time32_t *) t; -#endif - - if (!useGMT) { -#if defined(_MSC_VER) && (_MSC_VER >= 1900) -# undef timezone /* prevent conflict with timezone() function */ - long timezone = 0; -#endif - - tzset(); - - /* - * If we are in the valid range, let the C run-time library handle it. - * Otherwise we need to fake it. Note that this algorithm ignores - * daylight savings time before the epoch. - */ - - if (t2 >= 0) { - return TclpLocaltime(&t2); - } - -#if defined(_MSC_VER) && (_MSC_VER >= 1900) - _get_timezone(&timezone); -#endif - - time = t2 - timezone; - - /* - * If we aren't near to overflowing the long, just add the bias and - * use the normal calculation. Otherwise we will need to adjust the - * result at the end. - */ - - if (t2 < (LONG_MAX - 2*SECSPERDAY) && t2 > (LONG_MIN + 2*SECSPERDAY)) { - tmPtr = ComputeGMT(&time); - } else { - tmPtr = ComputeGMT(&t2); - - tzset(); - - /* - * Add the bias directly to the tm structure to avoid overflow. - * Propagate seconds overflow into minutes, hours and days. - */ - - time = tmPtr->tm_sec - timezone; - tmPtr->tm_sec = (int)(time % 60); - if (tmPtr->tm_sec < 0) { - tmPtr->tm_sec += 60; - time -= 60; - } - - time = tmPtr->tm_min + time / 60; - tmPtr->tm_min = (int)(time % 60); - if (tmPtr->tm_min < 0) { - tmPtr->tm_min += 60; - time -= 60; - } - - time = tmPtr->tm_hour + time / 60; - tmPtr->tm_hour = (int)(time % 24); - if (tmPtr->tm_hour < 0) { - tmPtr->tm_hour += 24; - time -= 24; - } - - time /= 24; - tmPtr->tm_mday += (int) time; - tmPtr->tm_yday += (int) time; - tmPtr->tm_wday = (tmPtr->tm_wday + (int) time) % 7; - } - } else { - tmPtr = ComputeGMT(&t2); - } - return tmPtr; -} - -/* - *---------------------------------------------------------------------- - * - * ComputeGMT -- - * - * This function computes GMT given the number of seconds since the epoch - * (midnight Jan 1 1970). - * - * Results: - * Returns a (per thread) statically allocated struct tm. - * - * Side effects: - * Updates the values of the static struct tm. - * - *---------------------------------------------------------------------- - */ - -static struct tm * -ComputeGMT( - const time_t *tp) -{ - struct tm *tmPtr; - long tmp, rem; - int isLeap; - const int *days; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - tmPtr = &tsdPtr->tm; - - /* - * Compute the 4 year span containing the specified time. - */ - - tmp = (long) (*tp / SECSPER4YEAR); - rem = (long) (*tp % SECSPER4YEAR); - - /* - * Correct for weird mod semantics so the remainder is always positive. - */ - - if (rem < 0) { - tmp--; - rem += SECSPER4YEAR; - } - - /* - * Compute the year after 1900 by taking the 4 year span and adjusting for - * the remainder. This works because 2000 is a leap year, and 1900/2100 - * are out of the range. - */ - - tmp = (tmp * 4) + 70; - isLeap = 0; - if (rem >= SECSPERYEAR) { /* 1971, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR) { /* 1972, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */ - tmp++; - rem -= SECSPERYEAR + SECSPERDAY; - } else { - isLeap = 1; - } - } - } - tmPtr->tm_year = tmp; - - /* - * Compute the day of year and leave the seconds in the current day in the - * remainder. - */ - - tmPtr->tm_yday = rem / SECSPERDAY; - rem %= SECSPERDAY; - - /* - * Compute the time of day. - */ - - tmPtr->tm_hour = rem / 3600; - rem %= 3600; - tmPtr->tm_min = rem / 60; - tmPtr->tm_sec = rem % 60; - - /* - * Compute the month and day of month. - */ - - days = (isLeap) ? leapDays : normalDays; - for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { - /* empty body */ - } - tmPtr->tm_mon = --tmp; - tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; - - /* - * Compute day of week. Epoch started on a Thursday. - */ - - tmPtr->tm_wday = (long) (*tp / SECSPERDAY) + 4; - if ((*tp % SECSPERDAY) < 0) { - tmPtr->tm_wday--; - } - tmPtr->tm_wday %= 7; - if (tmPtr->tm_wday < 0) { - tmPtr->tm_wday += 7; - } - - return tmPtr; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * CalibrationThread -- * * Thread that manages calibration of the hi-resolution time derived from @@ -1029,7 +782,7 @@ CalibrationThread( timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime; /* - * Calibrated file-time will be saved from posix in 100-ns ticks. + * Calibrated file-time will be saved from Posix in 100-ns ticks. */ timeInfo.fileTimeLastCall.QuadPart -= timeInfo.posixEpoch.QuadPart; @@ -1104,7 +857,7 @@ UpdateTimeEachSecond(void) * step over 1 second. */ /* - * Sample performance counter and system time (from posix epoch). + * Sample performance counter and system time (from Posix epoch). */ GetSystemTimeAsFileTime(&curSysTime); @@ -1129,7 +882,7 @@ UpdateTimeEachSecond(void) lastFileTime.QuadPart = curFileTime.QuadPart; /* - * We devide by timeInfo.curCounterFreq.QuadPart in several places. That + * We divide by timeInfo.curCounterFreq.QuadPart in several places. That * value should always be positive on a correctly functioning system. But * it is good to be defensive about such matters. So if something goes * wrong and the value does goes to zero, we clear the @@ -1253,6 +1006,7 @@ UpdateTimeEachSecond(void) * First adjust with a micro jump (short frozen time is * acceptable). */ + vt0 += nt0 - nt1; /* @@ -1426,77 +1180,6 @@ AccumulateSample( /* *---------------------------------------------------------------------- * - * TclpGmtime -- - * - * Wrapper around the 'gmtime' library function to make it thread safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes gmtime or gmtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -struct tm * -TclpGmtime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * The MS implementation of gmtime is thread safe because it returns the - * time in a block of thread-local storage, and Windows does not provide a - * Posix gmtime_r function. - */ - -#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) - return gmtime(timePtr); -#else - return _gmtime32((const __time32_t *) timePtr); -#endif /* _WIN64 || _USE_64BIT_TIME_T || _MSC_VER < 1400 */ -} - -/* - *---------------------------------------------------------------------- - * - * TclpLocaltime -- - * - * Wrapper around the 'localtime' library function to make it thread - * safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes localtime or localtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpLocaltime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * The MS implementation of localtime is thread safe because it returns - * the time in a block of thread-local storage, and Windows does not - * provide a Posix localtime_r function. - */ - -#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) - return localtime(timePtr); -#else - return _localtime32((const __time32_t *) timePtr); -#endif /* _WIN64 || _USE_64BIT_TIME_T || _MSC_VER < 1400 */ -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the @@ -1515,7 +1198,7 @@ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; @@ -1542,7 +1225,7 @@ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh index 4c2068c..a400b5b 100644 --- a/win/tclooConfig.sh +++ b/win/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS="" -TCLOO_VERSION=1.2.0 +TCLOO_VERSION=1.3 diff --git a/win/tclsh.rc b/win/tclsh.rc index bd1a4da..f439d08 100644 --- a/win/tclsh.rc +++ b/win/tclsh.rc @@ -44,9 +44,8 @@ BEGIN BEGIN VALUE "FileDescription", "Tclsh Application\0" VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0" - VALUE "CompanyName", "ActiveState Corporation\0" VALUE "FileVersion", TCL_PATCH_LEVEL - VALUE "LegalCopyright", "Copyright \251 2000 by ActiveState Corporation, et al\0" + VALUE "LegalCopyright", "Copyright \251 1987-2022 Regents of the University of California and other parties\0" VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" VALUE "ProductVersion", TCL_PATCH_LEVEL END diff --git a/win/tcltest.rc b/win/tcltest.rc new file mode 100644 index 0000000..847a250 --- /dev/null +++ b/win/tcltest.rc @@ -0,0 +1,75 @@ +// +// Version Resource Script +// + +#include <winver.h> +#include <tcl.h> + +// +// build-up the name suffix that defines the type of build this is. +// +#if STATIC_BUILD +#define SUFFIX_STATIC "s" +#else +#define SUFFIX_STATIC "" +#endif + +#if DEBUG && !UNCHECKED +#define SUFFIX_DEBUG "g" +#else +#define SUFFIX_DEBUG "" +#endif + +#define SUFFIX SUFFIX_STATIC SUFFIX_DEBUG + + +LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ + +VS_VERSION_INFO VERSIONINFO + FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL + PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL + FILEFLAGSMASK 0x3fL +#ifdef DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_APP + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904b0" + BEGIN + VALUE "FileDescription", "Tcltest Application\0" + VALUE "OriginalFilename", "tcltest" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0" + VALUE "FileVersion", TCL_PATCH_LEVEL + VALUE "LegalCopyright", "Copyright \251 1987-2022 Regents of the University of California and other parties\0" + VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" + VALUE "ProductVersion", TCL_PATCH_LEVEL + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 1200 + END +END + +// +// Icon +// + +tclsh ICON DISCARDABLE "tclsh.ico" + +// +// This is needed for Windows 8.1 onwards. +// + +#ifndef RT_MANIFEST +#define RT_MANIFEST 24 +#endif +#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID +#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 +#endif +CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclsh.exe.manifest" |