summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in107
-rw-r--r--win/README8
-rwxr-xr-xwin/configure1184
-rw-r--r--win/configure.ac54
-rw-r--r--win/makefile.vc204
-rw-r--r--win/nmakehlp.c51
-rw-r--r--win/rules.vc68
-rw-r--r--win/tcl.dsp74
-rw-r--r--win/tcl.m436
-rw-r--r--win/tcl.rc3
-rw-r--r--win/tclAppInit.c39
-rw-r--r--win/tclConfig.sh.in27
-rw-r--r--win/tclWin32Dll.c88
-rw-r--r--win/tclWinChan.c419
-rw-r--r--win/tclWinConsole.c2393
-rw-r--r--win/tclWinDde.c172
-rw-r--r--win/tclWinError.c12
-rw-r--r--win/tclWinFCmd.c87
-rw-r--r--win/tclWinFile.c216
-rw-r--r--win/tclWinInit.c98
-rw-r--r--win/tclWinInt.h7
-rw-r--r--win/tclWinLoad.c45
-rw-r--r--win/tclWinNotify.c25
-rw-r--r--win/tclWinPanic.c8
-rw-r--r--win/tclWinPipe.c199
-rw-r--r--win/tclWinPort.h22
-rw-r--r--win/tclWinReg.c168
-rw-r--r--win/tclWinSerial.c174
-rw-r--r--win/tclWinSock.c794
-rw-r--r--win/tclWinTest.c357
-rw-r--r--win/tclWinThrd.c32
-rw-r--r--win/tclWinTime.c373
-rw-r--r--win/tclooConfig.sh2
-rw-r--r--win/tclsh.rc3
-rw-r--r--win/tcltest.rc75
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.
#
diff --git a/win/README b/win/README
index 3cfcc15..9b001ba 100644
--- a/win/README
+++ b/win/README
@@ -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
diff --git a/win/tcl.m4 b/win/tcl.m4
index 8774b94..4bac910 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -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
#------------------------------------------------------------------------
diff --git a/win/tcl.rc b/win/tcl.rc
index 477512d..3d125f2 100644
--- a/win/tcl.rc
+++ b/win/tcl.rc
@@ -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(&notifierMutex);
@@ -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"
generated by cgit v0.12 at 2024-08-21 15:58:47 (GMT)