summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in62
-rw-r--r--win/README8
-rwxr-xr-xwin/configure63
-rw-r--r--win/configure.ac34
-rw-r--r--win/makefile.vc60
-rw-r--r--win/tcl.dsp24
-rw-r--r--win/tcl.m48
-rw-r--r--win/tclAppInit.c11
-rw-r--r--win/tclConfig.sh.in14
-rw-r--r--win/tclWin32Dll.c84
-rw-r--r--win/tclWinChan.c99
-rw-r--r--win/tclWinConsole.c26
-rw-r--r--win/tclWinError.c12
-rw-r--r--win/tclWinFCmd.c24
-rw-r--r--win/tclWinFile.c39
-rw-r--r--win/tclWinInit.c39
-rw-r--r--win/tclWinInt.h2
-rw-r--r--win/tclWinLoad.c8
-rw-r--r--win/tclWinNotify.c15
-rw-r--r--win/tclWinPanic.c4
-rw-r--r--win/tclWinPipe.c112
-rw-r--r--win/tclWinPort.h13
-rw-r--r--win/tclWinSerial.c32
-rw-r--r--win/tclWinSock.c102
-rw-r--r--win/tclWinTest.c56
-rw-r--r--win/tclWinThrd.c18
-rw-r--r--win/tclWinTime.c345
27 files changed, 974 insertions, 340 deletions
diff --git a/win/Makefile.in b/win/Makefile.in
index e542cfb..856a21c 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)/../tcl9
+MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8
# Directory in which to install the include file tcl.h:
INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir)
@@ -145,11 +145,9 @@ 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 = tcl9dde$(DDEVER)${DLLSUFFIX}
-DDE_DLL_FILE8 = tcldde$(DDEVER)${DLLSUFFIX}
+DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
-REG_DLL_FILE = tcl9registry$(REGVER)${DLLSUFFIX}
-REG_DLL_FILE8 = tclregistry$(REGVER)${DLLSUFFIX}
+REG_DLL_FILE = tclregistry$(REGVER)${DLLSUFFIX}
REG_LIB_FILE = @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE = tcltest${EXESUFFIX}
@@ -273,7 +271,6 @@ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}
TCLTEST_OBJS = \
tclTest.$(OBJEXT) \
- tclTestABSList.$(OBJEXT) \
tclTestObj.$(OBJEXT) \
tclTestProcBodyObj.$(OBJEXT) \
tclThreadTest.$(OBJEXT) \
@@ -389,9 +386,9 @@ TOMMATH_OBJS = \
bn_mp_div_d.${OBJEXT} \
bn_mp_div_2.${OBJEXT} \
bn_mp_div_2d.${OBJEXT} \
- bn_mp_div_3.${OBJEXT} \
+ bn_s_mp_div_3.${OBJEXT} \
bn_mp_exch.${OBJEXT} \
- bn_mp_expt_u32.${OBJEXT} \
+ bn_mp_expt_n.${OBJEXT} \
bn_mp_get_mag_u64.${OBJEXT} \
bn_mp_grow.${OBJEXT} \
bn_mp_init.${OBJEXT} \
@@ -466,8 +463,6 @@ REG_OBJS = tclWinReg.$(OBJEXT)
STUB_OBJS = \
tclStubLib.$(OBJEXT) \
- tclStubCall.$(OBJEXT) \
- tclStubLibTbl.$(OBJEXT) \
tclTomMathStubLib.$(OBJEXT) \
tclOOStubLib.$(OBJEXT) \
tclWinPanic.$(OBJEXT)
@@ -526,7 +521,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} ${DDE_DLL_FILE8} ${REG_DLL_FILE8}
+winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}
libraries:
@@ -600,14 +595,6 @@ ${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)
@@ -664,15 +651,9 @@ 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)
@@ -732,15 +713,6 @@ 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)
@@ -871,10 +843,6 @@ 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}"; \
@@ -885,10 +853,6 @@ 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}"; \
@@ -912,7 +876,7 @@ install-libraries: libraries install-tzdata install-msgs
else true; \
fi; \
done;
- @for i in 9.0 9.0/platform; \
+ @for i in 8.4 8.4/platform 8.5 8.6 8.7; \
do \
if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \
echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \
@@ -930,19 +894,19 @@ install-libraries: libraries install-tzdata install-msgs
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
done;
@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";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/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)/9.0/msgcat-1.7.1.tm";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm";
@echo "Installing package tcltest 2.5.8 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.8.tm";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.8.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";
+ @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/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)/9.0/platform/shell-1.1.4.tm";
+ @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm";
@echo "Installing encodings";
@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
@@ -1148,7 +1112,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 tcl9.* &
+# workspace. It depends on the Tcl & Tk being in directories called tcl8.* &
# tk8.* up two directories from the TOOL_DIR.
#
diff --git a/win/README b/win/README
index 9b001ba..3cfcc15 100644
--- a/win/README
+++ b/win/README
@@ -1,4 +1,4 @@
-Tcl 9.0 for Windows
+Tcl 8.7 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 9.0 Source Distribution (plus any patches)
+ Tcl 8.7 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 tclsh90.exe, you must ensure that tcl90.dll,
+Note that in order to run tclsh87.exe, you must ensure that tcl87.dll,
libtommath.dll and zlib1.dll are on your path, in the system
-directory, or in the directory containing tclsh90.exe.
+directory, or in the directory containing tclsh87.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 103e114..94e04f5 100755
--- a/win/configure
+++ b/win/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.72 for tcl 9.0.
+# Generated by GNU Autoconf 2.72 for tcl 8.7.
#
#
# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation,
@@ -601,8 +601,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='tcl'
PACKAGE_TARNAME='tcl'
-PACKAGE_VERSION='9.0'
-PACKAGE_STRING='tcl 9.0'
+PACKAGE_VERSION='8.7'
+PACKAGE_STRING='tcl 8.7'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''
@@ -654,6 +654,10 @@ TCL_DDE_MINOR_VERSION
TCL_DDE_MAJOR_VERSION
TCL_DDE_VERSION
TCL_PACKAGE_PATH
+TCL_EXP_FILE
+TCL_BUILD_EXP_FILE
+TCL_LD_SEARCH_FLAGS
+TCL_CC_SEARCH_FLAGS
TCL_BUILD_LIB_SPEC
MAKE_EXE
MAKE_DLL
@@ -795,6 +799,7 @@ ac_user_opts='
enable_option_checking
with_encoding
enable_shared
+enable_time64bit
enable_64bit
enable_zipfs
enable_symbols
@@ -1357,7 +1362,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 9.0 to adapt to many kinds of systems.
+'configure' configures tcl 8.7 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1419,7 +1424,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of tcl 9.0:";;
+ short | recursive ) echo "Configuration of tcl 8.7:";;
esac
cat <<\_ACEOF
@@ -1428,6 +1433,7 @@ 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)
@@ -1516,7 +1522,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-tcl configure 9.0
+tcl configure 8.7
generated by GNU Autoconf 2.72
Copyright (C) 2023 Free Software Foundation, Inc.
@@ -1726,7 +1732,7 @@ 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 9.0, which was
+It was created by tcl $as_me 8.7, which was
generated by GNU Autoconf 2.72. Invocation command line was
$ $0$ac_configure_args_raw
@@ -2408,10 +2414,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=9.0
-TCL_MAJOR_VERSION=9
-TCL_MINOR_VERSION=0
-TCL_PATCH_LEVEL="b2"
+TCL_VERSION=8.7
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=7
+TCL_PATCH_LEVEL="b1"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
@@ -3939,6 +3945,27 @@ 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 case e in #(
+ e) tcl_ok=no ;;
+esac
+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.
@@ -5858,8 +5885,8 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""
eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
-eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${LIBSUFFIX}\""
-eval "TCL_STUB_LIB_FLAG=\"-ltclstub${LIBFLAGSUFFIX}\""
+eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
+eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${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}\""
@@ -5987,6 +6014,12 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d
+# empty on win, but needs sub'ing
+
+
+
+
+
@@ -6544,7 +6577,7 @@ 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 9.0, which was
+This file was extended by tcl $as_me 8.7, which was
generated by GNU Autoconf 2.72. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -6599,7 +6632,7 @@ 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 9.0
+tcl config.status 8.7
configured by $0, generated by GNU Autoconf 2.72,
with options \\"\$ac_cs_config\\"
diff --git a/win/configure.ac b/win/configure.ac
index 9f6e21a..25fa29f 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],[9.0])
+AC_INIT([tcl],[8.7])
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=9.0
-TCL_MAJOR_VERSION=9
-TCL_MINOR_VERSION=0
-TCL_PATCH_LEVEL="b2"
+TCL_VERSION=8.7
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=7
+TCL_PATCH_LEVEL="b1"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
@@ -92,6 +92,20 @@ 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.
@@ -320,8 +334,8 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""
eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
-eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${LIBSUFFIX}\""
-eval "TCL_STUB_LIB_FLAG=\"-ltclstub${LIBFLAGSUFFIX}\""
+eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
+eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${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}\""
@@ -449,7 +463,13 @@ 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_BUILD_EXP_FILE)
+AC_SUBST(TCL_EXP_FILE)
+AC_SUBST(DL_LIBS)
AC_SUBST(TCL_PACKAGE_PATH)
# win only
diff --git a/win/makefile.vc b/win/makefile.vc
index 0867bb0..8720b66 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -52,7 +52,7 @@
# 64-bit compiler, if your SDK has it.
#
# Basic macros and options usable on the commandline (see rules.vc for more info):
-# OPTS=nomsvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,unchecked,none
+# OPTS=msvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,time64bit,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,6 +75,8 @@
# 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).
@@ -215,10 +217,10 @@ DDEVERSION = $(DDEDOTVERSION:.=)
REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)
-TCLREGLIBNAME = $(PROJECT)9registry$(REGVERSION)$(SUFX:t=).$(EXT)
+TCLREGLIBNAME = $(PROJECT)registry$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
-TCLDDELIBNAME = $(PROJECT)9dde$(DDEVERSION)$(SUFX:t=).$(EXT)
+TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
TCLTEST = $(OUT_DIR)\$(PROJECT)test$(VERSION)$(SUFX:t=).exe
@@ -234,7 +236,6 @@ 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
@@ -246,8 +247,8 @@ COREOBJS = \
$(TMP_DIR)\regerror.obj \
$(TMP_DIR)\regexec.obj \
$(TMP_DIR)\regfree.obj \
- $(TMP_DIR)\tclArithSeries.obj \
$(TMP_DIR)\tclAlloc.obj \
+ $(TMP_DIR)\tclArithSeries.obj \
$(TMP_DIR)\tclAssembly.obj \
$(TMP_DIR)\tclAsync.obj \
$(TMP_DIR)\tclBasic.obj \
@@ -369,9 +370,9 @@ TOMMATHOBJS = \
$(TMP_DIR)\bn_mp_div_d.obj \
$(TMP_DIR)\bn_mp_div_2.obj \
$(TMP_DIR)\bn_mp_div_2d.obj \
- $(TMP_DIR)\bn_mp_div_3.obj \
+ $(TMP_DIR)\bn_s_mp_div_3.obj \
$(TMP_DIR)\bn_mp_exch.obj \
- $(TMP_DIR)\bn_mp_expt_u32.obj \
+ $(TMP_DIR)\bn_mp_expt_n.obj \
$(TMP_DIR)\bn_mp_get_mag_u64.obj \
$(TMP_DIR)\bn_mp_grow.obj \
$(TMP_DIR)\bn_mp_init.obj \
@@ -453,8 +454,6 @@ 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
@@ -813,7 +812,10 @@ $(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@ $(PROJECT)$(VERSION)$(SUFX).lib
@@ -883,9 +885,6 @@ $(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) $?
@@ -932,11 +931,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_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?
+ $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
- $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?
+ $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
### The following objects are part of the stub library and should not
@@ -946,15 +945,6 @@ $(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$@ $?
@@ -1100,24 +1090,30 @@ 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)\9.0" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0"
+ @if not exist "$(MODULE_INSTALL_DIR)\8.6" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\8.6"
@$(COPY) "$(ROOT)\library\http\http.tcl" \
- "$(MODULE_INSTALL_DIR)\9.0\http-$(PKG_HTTP_VER).tm"
+ "$(MODULE_INSTALL_DIR)\8.6\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)\9.0\msgcat-$(PKG_MSGCAT_VER).tm"
+ "$(MODULE_INSTALL_DIR)\8.7\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)\9.0\tcltest-$(PKG_TCLTEST_VER).tm"
+ "$(MODULE_INSTALL_DIR)\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
@echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\9.0\platform" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0\platform"
+ @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"
@$(COPY) "$(ROOT)\library\platform\platform.tcl" \
- "$(MODULE_INSTALL_DIR)\9.0\platform-$(PKG_PLATFORM_VER).tm"
+ "$(MODULE_INSTALL_DIR)\8.4\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)\9.0\platform\shell-$(PKG_SHELL_VER).tm"
+ "$(MODULE_INSTALL_DIR)\8.4\platform\shell-$(PKG_SHELL_VER).tm"
!endif
@echo Installing $(TCLDDELIBNAME)
!if !$(STATIC_BUILD)
diff --git a/win/tcl.dsp b/win/tcl.dsp
index a5e4a63..d033560 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\tclsh90.exe"
+# PROP BASE Target_File "Release\tclsh87.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\tclsh90t.exe"
+# PROP Target_File "Release\tclsh87t.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\tclsh90g.exe"
+# PROP BASE Target_File "Debug\tclsh87g.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\tclsh90tg.exe"
+# PROP Target_File "Debug\tclsh87tg.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\tclsh90sg.exe"
+# PROP BASE Target_File "Debug\tclsh87sg.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\tclsh90sg.exe"
+# PROP Target_File "Debug\tclsh87sg.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\tclsh90s.exe"
+# PROP BASE Target_File "Release\tclsh87s.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\tclsh90s.exe"
+# PROP Target_File "Release\tclsh87s.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -1240,14 +1240,6 @@ 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 4bac910..fff706b 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -985,13 +985,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
#------------------------------------------------------------------------
AC_DEFUN([SC_WITH_TCL], [
- if test -d ../../tcl9.0$1/win; then
- TCL_BIN_DEFAULT=../../tcl9.0$1/win
+ if test -d ../../tcl8.7$1/win; then
+ TCL_BIN_DEFAULT=../../tcl8.7$1/win
else
- TCL_BIN_DEFAULT=../../tcl9.0/win
+ TCL_BIN_DEFAULT=../../tcl8.7/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 9.0 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.7 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)
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index 339d61e..d1b38ee 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -215,10 +215,8 @@ Tcl_AppInit(
* user-specific startup file will be run under any conditions.
*/
- (void)Tcl_EvalEx(interp,
- "set tcl_rcFileName [file tildeexpand ~/tclshrc.tcl]",
- TCL_AUTO_LENGTH, TCL_EVAL_GLOBAL);
-
+ Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", TCL_INDEX_NONE), NULL,
+ Tcl_NewStringObj("~/tclshrc.tcl", TCL_INDEX_NONE), TCL_GLOBAL_ONLY);
return TCL_OK;
}
@@ -279,10 +277,11 @@ setargv(
}
}
- /* Make sure we don't call Tcl_Alloc through the (not yet initialized) stub table */
+ /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
# undef Tcl_Alloc
+# undef Tcl_DbCkalloc
- argSpace = (TCHAR *)Tcl_Alloc(size * sizeof(char *)
+ argSpace = (TCHAR *)ckalloc(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 c980af6..1c33246 100644
--- a/win/tclConfig.sh.in
+++ b/win/tclConfig.sh.in
@@ -23,6 +23,11 @@ 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@'
@@ -43,6 +48,9 @@ TCL_ZIP_FILE='@TCL_ZIP_FILE@'
# Flag to indicate whether shared libraries need export files.
TCL_NEEDS_EXP_FILE=''
+# Deprecated. Same as TCL_UNSHARED_LIB_SUFFIX
+TCL_EXPORT_FILE_SUFFIX='@CFG_TCL_UNSHARED_LIB_SUFFIX@'
+
# Additional libraries to use when linking Tcl.
TCL_LIBS='@LIBS@'
@@ -79,7 +87,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=''
+TCL_DL_LIBS='@DL_LIBS@'
# Flags to pass to the compiler when linking object files into
# an executable tclsh or tcltest binary.
@@ -89,8 +97,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_LD_SEARCH_FLAGS=''
+TCL_CC_SEARCH_FLAGS='@TCL_CC_SEARCH_FLAGS@'
+TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'
# Additional object files linked with Tcl to provide compatibility
# with standard facilities from ANSI C or POSIX.
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 01fa6c3..7c3d8a4 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -144,7 +144,7 @@ DllMain(
*----------------------------------------------------------------------
*/
-void *
+HINSTANCE
TclWinGetTclInstance(void)
{
return hInstance;
@@ -247,8 +247,8 @@ TclWinEncodingsCleanup(void)
dlIter = driveLetterLookup;
while (dlIter != NULL) {
dlIter2 = dlIter->nextPtr;
- Tcl_Free(dlIter->volumeName);
- Tcl_Free(dlIter);
+ ckfree(dlIter->volumeName);
+ ckfree(dlIter);
dlIter = dlIter2;
}
Tcl_MutexUnlock(&mountPointMap);
@@ -341,8 +341,8 @@ TclWinDriveLetterForVolMountPoint(
* Now dlPtr2 points to the structure to free.
*/
- Tcl_Free(dlPtr2->volumeName);
- Tcl_Free(dlPtr2);
+ ckfree(dlPtr2->volumeName);
+ ckfree(dlPtr2);
/*
* Restart the loop - we could try to be clever and continue half
@@ -377,7 +377,7 @@ TclWinDriveLetterForVolMountPoint(
}
}
if (!alreadyStored) {
- dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
+ dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap));
dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target);
dlPtr2->driveLetter = (WCHAR) drive[0];
dlPtr2->nextPtr = driveLetterLookup;
@@ -403,7 +403,7 @@ TclWinDriveLetterForVolMountPoint(
* that fact and store '-1' so we don't have to look it up each time.
*/
- dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
+ dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap));
dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint);
dlPtr2->driveLetter = (WCHAR)-1;
dlPtr2->nextPtr = driveLetterLookup;
@@ -413,6 +413,76 @@ 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 73b61ab..9b018e4 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -88,6 +88,10 @@ static int FileInputProc(void *instanceData, char *buf,
int toRead, int *errorCode);
static int FileOutputProc(void *instanceData,
const char *buf, int toWrite, int *errorCode);
+#ifndef TCL_NO_DEPRECATED
+static int FileSeekProc(void *instanceData, long offset,
+ int mode, int *errorCode);
+#endif
static long long FileWideSeekProc(void *instanceData,
long long offset, int mode, int *errorCode);
static void FileSetupProc(void *clientData, int flags);
@@ -108,10 +112,14 @@ static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName,
static const Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- NULL, /* Close proc. */
+ TCL_CLOSE2PROC, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
+#ifndef TCL_NO_DEPRECATED
+ FileSeekProc, /* Seek proc. */
+#else
NULL,
+#endif
NULL, /* Set option proc. */
FileGetOptionProc, /* Get option proc. */
FileWatchProc, /* Set up the notifier to watch the channel. */
@@ -306,7 +314,7 @@ FileCheckProc(
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) {
SET_FLAG(infoPtr->flags, FILE_PENDING);
- evPtr = (FileEvent *)Tcl_Alloc(sizeof(FileEvent));
+ evPtr = (FileEvent *)ckalloc(sizeof(FileEvent));
evPtr->header.proc = FileEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -478,13 +486,92 @@ FileCloseProc(
break;
}
}
- Tcl_Free(fileInfoPtr);
+ ckfree(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(
+ void *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.
@@ -1468,8 +1555,9 @@ TclpGetDefaultStdChannel(
*/
if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK ||
+ Tcl_SetChannelOption(NULL,channel,"-eofchar","\x1A {}")!=TCL_OK ||
Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) {
- Tcl_CloseEx(NULL, channel, 0);
+ Tcl_Close(NULL, channel);
return (Tcl_Channel) NULL;
}
return channel;
@@ -1520,7 +1608,7 @@ OpenFileChannel(
}
}
- infoPtr = (FileInfo *)Tcl_Alloc(sizeof(FileInfo));
+ infoPtr = (FileInfo *)ckalloc(sizeof(FileInfo));
/*
* TIP #218. Removed the code inserting the new structure into the global
@@ -1544,6 +1632,7 @@ OpenFileChannel(
*/
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}");
return infoPtr->channel;
}
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 4ee8033..c7e12ae 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -301,7 +301,7 @@ static ConsoleChannelInfo *gWatchingChannelList;
static const Tcl_ChannelType consoleChannelType = {
"console", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- NULL, /* Close proc. */
+ TCL_CLOSE2PROC, /* Close proc. */
ConsoleInputProc, /* Input proc. */
ConsoleOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -341,7 +341,7 @@ RingBufferInit(
if (capacity <= 0 || capacity > TCL_SIZE_MAX) {
Tcl_Panic("Internal error: invalid ring buffer capacity requested.");
}
- ringPtr->bufPtr = (char *) Tcl_Alloc(capacity);
+ ringPtr->bufPtr = (char *) ckalloc(capacity);
ringPtr->capacity = capacity;
ringPtr->start = 0;
ringPtr->length = 0;
@@ -367,7 +367,7 @@ RingBufferClear(
RingBuffer *ringPtr)
{
if (ringPtr->bufPtr) {
- Tcl_Free(ringPtr->bufPtr);
+ ckfree(ringPtr->bufPtr);
ringPtr->bufPtr = NULL;
}
ringPtr->capacity = 0;
@@ -900,7 +900,7 @@ ConsoleCheckProc(
ReleaseSRWLockShared(&handleInfoPtr->lock);
if (needEvent) {
- ConsoleEvent *evPtr = (ConsoleEvent *)Tcl_Alloc(sizeof(ConsoleEvent));
+ ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent));
/* See note above loop why this can be accessed without locks */
chanInfoPtr->flags |= CONSOLE_EVENT_QUEUED;
@@ -1067,7 +1067,7 @@ ConsoleCloseProc(
/* There may be references already on the event queue */
chanInfoPtr->numRefs -= 1;
} else {
- Tcl_Free(chanInfoPtr);
+ ckfree(chanInfoPtr);
}
return errorCode;
@@ -1457,7 +1457,7 @@ ConsoleEventProc(
}
if (freeChannel) {
- Tcl_Free(chanInfoPtr);
+ ckfree(chanInfoPtr);
}
return 1;
@@ -1815,7 +1815,7 @@ ConsoleReaderThread(
*/
}
- Tcl_Free(handleInfoPtr);
+ ckfree(handleInfoPtr);
return 0;
}
@@ -1970,7 +1970,7 @@ ConsoleWriterThread(
RingBufferClear(&handleInfoPtr->buffer);
- Tcl_Free(handleInfoPtr);
+ ckfree(handleInfoPtr);
return 0;
}
@@ -2006,7 +2006,8 @@ AllocateConsoleHandleInfo(
ConsoleHandleInfo *handleInfoPtr;
DWORD consoleMode;
- handleInfoPtr = (ConsoleHandleInfo *) Tcl_Alloc(sizeof(*handleInfoPtr));
+ handleInfoPtr = (ConsoleHandleInfo *) ckalloc(sizeof(*handleInfoPtr));
+ memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));
memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));
handleInfoPtr->console = consoleHandle;
InitializeSRWLock(&handleInfoPtr->lock);
@@ -2033,7 +2034,7 @@ AllocateConsoleHandleInfo(
if (handleInfoPtr->consoleThread == NULL) {
/* Note - SRWLock and condition variables do not need finalization */
RingBufferClear(&handleInfoPtr->buffer);
- Tcl_Free(handleInfoPtr);
+ ckfree(handleInfoPtr);
return NULL;
}
@@ -2112,7 +2113,7 @@ TclWinOpenConsoleChannel(
ConsoleInit();
- chanInfoPtr = (ConsoleChannelInfo *)Tcl_Alloc(sizeof(*chanInfoPtr));
+ chanInfoPtr = (ConsoleChannelInfo *)ckalloc(sizeof(*chanInfoPtr));
memset(chanInfoPtr, 0, sizeof(*chanInfoPtr));
chanInfoPtr->permissions = permissions;
@@ -2171,7 +2172,7 @@ TclWinOpenConsoleChannel(
if (permissions == TCL_READABLE) {
SetConsoleMode(handle, chanInfoPtr->initMode);
}
- Tcl_Free(chanInfoPtr);
+ ckfree(chanInfoPtr);
return NULL;
}
@@ -2203,6 +2204,7 @@ TclWinOpenConsoleChannel(
*/
Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-eofchar", "\x1A {}");
Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-encoding", "utf-16");
return chanInfoPtr->channel;
}
diff --git a/win/tclWinError.c b/win/tclWinError.c
index 3e75a85..7e5898b 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -351,9 +351,9 @@ void
Tcl_WinConvertError(
unsigned errCode) /* Win32 error code. */
{
- if ((unsigned)errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
+ if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
errCode -= WSAEWOULDBLOCK;
- if ((unsigned)errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
+ if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
Tcl_SetErrno(errorTable[1]);
} else {
Tcl_SetErrno(wsaErrorTable[errCode]);
@@ -381,7 +381,7 @@ Tcl_WinConvertError(
*----------------------------------------------------------------------
*/
-void
+TCL_NORETURN void
tclWinDebugPanic(
const char *format, ...)
{
@@ -413,6 +413,12 @@ tclWinDebugPanic(
fprintf(stderr, "\n");
fflush(stderr);
}
+# if defined(__GNUC__)
+ __builtin_trap();
+# else
+ DebugBreak();
+# endif
+ abort();
}
#endif
/*
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index e7164df..5d45fe1 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -309,8 +309,7 @@ DoRenameFile(
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
WCHAR *nativeSrcRest, *nativeDstRest;
const char **srcArgv, **dstArgv;
- size_t size;
- Tcl_Size srcArgc, dstArgc;
+ Tcl_Size size, srcArgc, dstArgc;
WCHAR nativeSrcPath[MAX_PATH];
WCHAR nativeDstPath[MAX_PATH];
Tcl_DString srcString, dstString;
@@ -318,7 +317,7 @@ DoRenameFile(
size = GetFullPathNameW(nativeSrc, MAX_PATH,
nativeSrcPath, &nativeSrcRest);
- if ((size == 0) || (size > MAX_PATH)) {
+ if ((size <= 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
size = GetFullPathNameW(nativeDst, MAX_PATH,
@@ -379,8 +378,8 @@ DoRenameFile(
Tcl_SetErrno(EXDEV);
}
- Tcl_Free((void *)srcArgv);
- Tcl_Free((void *)dstArgv);
+ ckfree(srcArgv);
+ ckfree(dstArgv);
}
/*
@@ -1712,8 +1711,19 @@ ConvertFileNameFormat(
Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp);
Tcl_DStringFree(&ds);
- tempPath = Tcl_DStringToObj(&dsTemp);
- Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
+ /*
+ * 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 = Tcl_DStringToObj(&dsTemp);
+ }
+ Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
FindClose(handle);
}
}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 17f4898..b27487f 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -177,7 +177,7 @@ static int WinLink(const WCHAR *LinkSource,
const WCHAR *LinkTarget, int linkAction);
static int WinSymLinkDirectory(const WCHAR *LinkDirectory,
const WCHAR *LinkTarget);
-MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
+MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...);
/*
*--------------------------------------------------------------------
@@ -808,7 +808,7 @@ NativeWriteReparse(
*----------------------------------------------------------------------
*/
-void
+TCL_NORETURN void
tclWinDebugPanic(
const char *format, ...)
{
@@ -838,6 +838,16 @@ tclWinDebugPanic(
MessageBoxW(NULL, msgString, L"Fatal Error",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
}
+#if defined(__GNUC__)
+ __builtin_trap();
+#elif defined(_WIN64)
+ __debugbreak();
+#elif defined(_MSC_VER) && defined (_M_IX86)
+ _asm {int 3}
+#else
+ DebugBreak();
+#endif
+ abort();
}
/*
@@ -864,7 +874,16 @@ TclpFindExecutable(
{
WCHAR wName[MAX_PATH];
char name[MAX_PATH * 3];
- (void)argv0;
+
+ /*
+ * 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);
+ }
GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(WCHAR));
WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
@@ -1535,12 +1554,12 @@ TclpGetUserHome(
result[i] = '/';
}
}
- NetApiBufferFree((void *)uiPtr);
+ NetApiBufferFree((void *) uiPtr);
}
Tcl_DStringFree(&ds);
}
if (wDomain != NULL) {
- NetApiBufferFree((void *)wDomain);
+ NetApiBufferFree((void *) wDomain);
}
return result;
@@ -2957,7 +2976,7 @@ TclpNativeToNormalized(
{
Tcl_DString ds;
Tcl_Obj *objPtr;
- size_t len;
+ Tcl_Size len;
char *copy, *p;
Tcl_DStringInit(&ds);
@@ -3088,7 +3107,7 @@ TclNativeCreateNativeRep(
* Overallocate 6 chars, making some room for extended paths
*/
- wp = nativePathPtr = (WCHAR *)Tcl_Alloc((len + 6) * sizeof(WCHAR));
+ wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR));
if (nativePathPtr==0) {
goto done;
}
@@ -3187,7 +3206,7 @@ TclNativeDupInternalRep(
len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1);
- copy = (char *)Tcl_Alloc(len);
+ copy = (char *)ckalloc(len);
memcpy(copy, clientData, len);
return copy;
}
@@ -3303,7 +3322,7 @@ TclWinFileOwned(
bufsz = 0;
GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
if (bufsz) {
- buf = (LPBYTE)Tcl_Alloc(bufsz);
+ buf = (LPBYTE)ckalloc(bufsz);
if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) {
owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid);
}
@@ -3319,7 +3338,7 @@ TclWinFileOwned(
LocalFree(secd); /* Also frees ownerSid */
}
if (buf) {
- Tcl_Free(buf);
+ ckfree(buf);
}
return (owned != 0); /* Convert non-0 to 1 */
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 4234ceb..3764a79 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -124,7 +124,7 @@ TclpInitPlatform(void)
void
TclpInitLibraryPath(
char **valuePtr,
- size_t *lengthPtr,
+ TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 64
@@ -169,7 +169,7 @@ TclpInitLibraryPath(
*encodingPtr = NULL;
bytes = TclGetStringFromObj(pathPtr, &length);
*lengthPtr = length++;
- *valuePtr = (char *)Tcl_Alloc(length);
+ *valuePtr = (char *)ckalloc(length);
memcpy(*valuePtr, bytes, length);
Tcl_DecrRefCount(pathPtr);
}
@@ -260,7 +260,7 @@ AppendEnvironment(
objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE);
}
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- Tcl_Free((void *)pathv);
+ ckfree(pathv);
}
}
@@ -284,7 +284,7 @@ AppendEnvironment(
static void
InitializeDefaultLibraryDir(
char **valuePtr,
- size_t *lengthPtr,
+ TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr)
{
HMODULE hModule = (HMODULE)TclWinGetTclInstance();
@@ -306,7 +306,7 @@ InitializeDefaultLibraryDir(
TclWinNoBackslash(name);
snprintf(end + 1, LIBRARY_SIZE, "lib/tcl%s", TCL_VERSION);
*lengthPtr = strlen(name);
- *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
+ *valuePtr = (char *)ckalloc(*lengthPtr + 1);
*encodingPtr = NULL;
memcpy(*valuePtr, name, *lengthPtr + 1);
}
@@ -332,7 +332,7 @@ InitializeDefaultLibraryDir(
static void
InitializeSourceLibraryDir(
char **valuePtr,
- size_t *lengthPtr,
+ TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr)
{
HMODULE hModule = (HMODULE)TclWinGetTclInstance();
@@ -354,7 +354,7 @@ InitializeSourceLibraryDir(
TclWinNoBackslash(name);
snprintf(end + 1, LIBRARY_SIZE, "../library");
*lengthPtr = strlen(name);
- *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
+ *valuePtr = (char *)ckalloc(*lengthPtr + 1);
*encodingPtr = NULL;
memcpy(*valuePtr, name, *lengthPtr + 1);
}
@@ -496,6 +496,20 @@ 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.
@@ -555,10 +569,9 @@ 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.
@@ -586,7 +599,7 @@ TclpFindVariable(
*/
length = strlen(name);
- nameUpper = (char *)Tcl_Alloc(length + 1);
+ nameUpper = (char *)ckalloc(length + 1);
memcpy(nameUpper, name, length+1);
Tcl_UtfToUpper(nameUpper);
@@ -626,7 +639,7 @@ TclpFindVariable(
done:
Tcl_DStringFree(&envString);
- Tcl_Free(nameUpper);
+ ckfree(nameUpper);
return result;
}
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 6de1432..dfe4d10 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -80,7 +80,7 @@ typedef struct TclPipeThreadInfo {
} TclPipeThreadInfo;
-/* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without
+/* If pipe-workers will use some tcl subsystem, we can use ckalloc 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 1cc7ae1..8d2e5b3 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -174,8 +174,8 @@ TclpDlopen(
* Succeded; package everything up for Tcl.
*/
- handlePtr = (Tcl_LoadHandle)Tcl_Alloc(sizeof(struct Tcl_LoadHandle_));
- handlePtr->clientData = (void *)hInstance;
+ handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_));
+ handlePtr->clientData = (void *) hInstance;
handlePtr->findSymbolProcPtr = &FindSymbol;
handlePtr->unloadFileProcPtr = &UnloadFile;
*loadHandle = handlePtr;
@@ -259,7 +259,7 @@ UnloadFile(
HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
FreeLibrary(hInstance);
- Tcl_Free(loadHandle);
+ ckfree(loadHandle);
}
/*
@@ -390,7 +390,7 @@ InitDLLDirectoryName(void)
*/
copyToGlobalBuffer:
- dllDirectoryName = (WCHAR *)Tcl_Alloc((nameLen+1) * sizeof(WCHAR));
+ dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR));
wcscpy(dllDirectoryName, name);
return TCL_OK;
}
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 2c93a41..795db74 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -100,7 +100,7 @@ TclpInitNotifier(void)
clazz.style = 0;
clazz.cbClsExtra = 0;
clazz.cbWndExtra = 0;
- clazz.hInstance = (HINSTANCE) TclWinGetTclInstance();
+ clazz.hInstance = TclWinGetTclInstance();
clazz.hbrBackground = NULL;
clazz.lpszMenuName = NULL;
clazz.lpszClassName = className;
@@ -188,7 +188,7 @@ TclpFinalizeNotifier(
if (notifierCount) {
notifierCount--;
if (notifierCount == 0) {
- UnregisterClassW(className, (HINSTANCE) TclWinGetTclInstance());
+ UnregisterClassW(className, TclWinGetTclInstance());
}
}
LeaveCriticalSection(&notifierMutex);
@@ -287,7 +287,7 @@ TclpSetTimer(
* Windows seems to get confused by zero length timers.
*/
- timeout = (UINT)timePtr->sec * 1000 + (unsigned long)timePtr->usec / 1000;
+ timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
if (timeout == 0) {
timeout = 1;
}
@@ -337,8 +337,7 @@ TclpServiceModeHook(
if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED,
- 0, 0, 0, 0, NULL, NULL, (HINSTANCE) TclWinGetTclInstance(),
- NULL);
+ 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
/*
* Send an initial message to the window to ensure that we wake up the
@@ -490,7 +489,7 @@ TclpWaitForEvent(
TclScaleTime(&myTime);
}
- timeout = (DWORD)myTime.sec * 1000 + (unsigned long)myTime.usec / 1000;
+ timeout = myTime.sec * 1000 + myTime.usec / 1000;
} else {
timeout = INFINITE;
}
@@ -610,7 +609,7 @@ Tcl_Sleep(
*/
TclScaleTime(&vdelay);
- sleepTime = (DWORD)vdelay.sec * 1000 + (unsigned long)vdelay.usec / 1000;
+ sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
for (;;) {
SleepEx(sleepTime, TRUE);
@@ -625,7 +624,7 @@ Tcl_Sleep(
vdelay.usec = desired.usec - now.usec;
TclScaleTime(&vdelay);
- sleepTime = (DWORD)vdelay.sec * 1000 + (unsigned long)vdelay.usec / 1000;
+ sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
}
}
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
index 7928dcd..3131286 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 @@
*----------------------------------------------------------------------
*/
-TCL_NORETURN1 void
+void
Tcl_ConsolePanic(
const char *format, ...)
{
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index d587dda..bb4983e 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -61,7 +61,7 @@ typedef struct {
typedef struct ProcInfo {
HANDLE hProcess;
- int dwProcessId;
+ TCL_HASH_TYPE 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. */
- size_t numPids; /* Number of processes attached to pipe. */
+ TCL_HASH_TYPE 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,7 +171,7 @@ typedef struct {
static int ApplicationType(Tcl_Interp *interp,
const char *fileName, char *fullName);
-static void BuildCommandLine(const char *executable, size_t argc,
+static void BuildCommandLine(const char *executable, Tcl_Size argc,
const char **argv, Tcl_DString *linePtr);
static BOOL HasConsole(void);
static int PipeBlockModeProc(void *instanceData, int mode);
@@ -203,7 +203,7 @@ static void PipeThreadActionProc(void *instanceData,
static const Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- NULL, /* Close proc. */
+ TCL_CLOSE2PROC, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -402,7 +402,7 @@ PipeCheckProc(
if (needEvent) {
infoPtr->flags |= PIPE_PENDING;
- evPtr = (PipeEvent *)Tcl_Alloc(sizeof(PipeEvent));
+ evPtr = (PipeEvent *)ckalloc(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 *)Tcl_Alloc(sizeof(WinFile));
+ filePtr = (WinFile *)ckalloc(sizeof(WinFile));
filePtr->type = WIN_FILE;
filePtr->handle = handle;
@@ -651,7 +651,7 @@ TclpCreateTempFile(
const char *contents) /* String to write into temp file, or NULL. */
{
WCHAR name[MAX_PATH];
- const char *native = NULL;
+ const char *native;
Tcl_DString dstring;
HANDLE handle;
@@ -679,10 +679,7 @@ TclpCreateTempFile(
* Convert the contents from UTF to native encoding
*/
- if (Tcl_UtfToExternalDStringEx(NULL, NULL, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) {
- goto error;
- }
- native = Tcl_DStringValue(&dstring);
+ native = Tcl_UtfToExternalDString(NULL, contents, TCL_INDEX_NONE, &dstring);
toCopy = Tcl_DStringLength(&dstring);
for (p = native; toCopy > 0; p++, toCopy--) {
@@ -722,9 +719,7 @@ TclpCreateTempFile(
Tcl_DStringFree(&dstring);
}
- if (native != NULL) {
- Tcl_WinConvertError(GetLastError());
- }
+ Tcl_WinConvertError(GetLastError());
CloseHandle(handle);
DeleteFileW(name);
return NULL;
@@ -831,7 +826,7 @@ TclpCloseFile(
if (filePtr->handle != NULL &&
CloseHandle(filePtr->handle) == FALSE) {
Tcl_WinConvertError(GetLastError());
- Tcl_Free(filePtr);
+ ckfree(filePtr);
return -1;
}
}
@@ -841,7 +836,7 @@ TclpCloseFile(
Tcl_Panic("TclpCloseFile: unexpected file type");
}
- Tcl_Free(filePtr);
+ ckfree(filePtr);
return 0;
}
@@ -874,13 +869,13 @@ TclpGetPid(
Tcl_MutexLock(&pipeMutex);
for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
- if (infoPtr->dwProcessId == (Tcl_Size)pid) {
+ if (infoPtr->dwProcessId == PTR2UINT(pid)) {
Tcl_MutexUnlock(&pipeMutex);
return infoPtr->dwProcessId;
}
}
Tcl_MutexUnlock(&pipeMutex);
- return -1;
+ return TCL_INDEX_NONE;
}
/*
@@ -916,7 +911,7 @@ TclpCreateProcess(
* occurred when creating the child process.
* Error messages from the child process
* itself are sent to errorFile. */
- size_t argc, /* Number of arguments in following array. */
+ Tcl_Size 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
@@ -1334,7 +1329,7 @@ ApplicationType(
}
header.e_magic = 0;
- ReadFile(hFile, (void *)&header, sizeof(header), &read, NULL);
+ ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL);
if (header.e_magic != IMAGE_DOS_SIGNATURE) {
/*
* Doesn't have the magic number for relocatable executables. If
@@ -1369,7 +1364,7 @@ ApplicationType(
buf[0] = '\0';
SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN);
- ReadFile(hFile, (void *)buf, 2, &read, NULL);
+ ReadFile(hFile, (void *) buf, 2, &read, NULL);
CloseHandle(hFile);
if ((buf[0] == 'N') && (buf[1] == 'E')) {
@@ -1541,14 +1536,14 @@ static void
BuildCommandLine(
const char *executable, /* Full path of executable (including
* extension). Replacement for argv[0]. */
- size_t argc, /* Number of arguments. */
+ Tcl_Size 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;
- size_t i;
+ Tcl_Size i;
Tcl_DString ds;
#ifdef TCL_WIN_PIPE_FULLESC
/* full escape inclusive %-subst avoidance */
@@ -1774,11 +1769,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. */
- size_t numPids, /* The number of pids in the pid array. */
+ Tcl_Size 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 *)Tcl_Alloc(sizeof(PipeInfo));
+ PipeInfo *infoPtr = (PipeInfo *)ckalloc(sizeof(PipeInfo));
PipeInit();
@@ -1841,7 +1836,14 @@ TclpCreateCommandChannel(
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", "\x1A {}");
return infoPtr->channel;
}
@@ -1880,10 +1882,10 @@ Tcl_CreatePipe(
return TCL_ERROR;
}
- *rchan = Tcl_MakeFileChannel((void *)readHandle, TCL_READABLE);
+ *rchan = Tcl_MakeFileChannel((void *) readHandle, TCL_READABLE);
Tcl_RegisterChannel(interp, *rchan);
- *wchan = Tcl_MakeFileChannel((void *)writeHandle, TCL_WRITABLE);
+ *wchan = Tcl_MakeFileChannel((void *) writeHandle, TCL_WRITABLE);
Tcl_RegisterChannel(interp, *wchan);
return TCL_OK;
@@ -1913,8 +1915,8 @@ TclGetAndDetachPids(
{
PipeInfo *pipePtr;
const Tcl_ChannelType *chanTypePtr;
- Tcl_Obj *pidsObj;
- size_t i;
+ Tcl_Obj *pidsObj, *elemPtr;
+ TCL_HASH_TYPE i;
/*
* Punt if the channel is not a command channel.
@@ -1928,14 +1930,13 @@ TclGetAndDetachPids(
pipePtr = (PipeInfo *)Tcl_GetChannelInstanceData(chan);
TclNewObj(pidsObj);
for (i = 0; i < pipePtr->numPids; i++) {
- Tcl_ListObjAppendElement(NULL, pidsObj,
- Tcl_NewWideIntObj(
- TclpGetPid(pipePtr->pidPtr[i])));
+ TclNewIntObj(elemPtr, TclpGetPid(pipePtr->pidPtr[i]));
+ Tcl_ListObjAppendElement(NULL, pidsObj, elemPtr);
Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
}
Tcl_SetObjResult(interp, pidsObj);
if (pipePtr->numPids > 0) {
- Tcl_Free(pipePtr->pidPtr);
+ ckfree(pipePtr->pidPtr);
pipePtr->numPids = 0;
}
}
@@ -2122,8 +2123,7 @@ PipeClose2Proc(
errChan = Tcl_MakeFileChannel((void *)filePtr->handle,
TCL_READABLE);
- Tcl_Free(filePtr);
- Tcl_SetChannelOption(NULL, errChan, "-profile", "replace");
+ ckfree(filePtr);
} else {
errChan = NULL;
}
@@ -2133,14 +2133,14 @@ PipeClose2Proc(
}
if (pipePtr->numPids > 0) {
- Tcl_Free(pipePtr->pidPtr);
+ ckfree(pipePtr->pidPtr);
}
if (pipePtr->writeBuf != NULL) {
- Tcl_Free(pipePtr->writeBuf);
+ ckfree(pipePtr->writeBuf);
}
- Tcl_Free(pipePtr);
+ ckfree(pipePtr);
if (errorCode == 0) {
return result;
@@ -2309,10 +2309,10 @@ PipeOutputProc(
*/
if (infoPtr->writeBuf) {
- Tcl_Free(infoPtr->writeBuf);
+ ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite);
+ infoPtr->writeBuf = (char *)ckalloc(toWrite);
}
memcpy(infoPtr->writeBuf, buf, toWrite);
infoPtr->toWrite = toWrite;
@@ -2515,12 +2515,12 @@ PipeGetHandleProc(
if (direction == TCL_READABLE && infoPtr->readFile) {
filePtr = (WinFile*) infoPtr->readFile;
- *handlePtr = (void *)filePtr->handle;
+ *handlePtr = (void *) filePtr->handle;
return TCL_OK;
}
if (direction == TCL_WRITABLE && infoPtr->writeFile) {
filePtr = (WinFile*) infoPtr->writeFile;
- *handlePtr = (void *)filePtr->handle;
+ *handlePtr = (void *) filePtr->handle;
return TCL_OK;
}
return TCL_ERROR;
@@ -2574,7 +2574,7 @@ Tcl_WaitPid(
prevPtrPtr = &procList;
for (infoPtr = procList; infoPtr != NULL;
prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
- if (infoPtr->dwProcessId == (Tcl_Size)pid) {
+ if (infoPtr->dwProcessId == PTR2UINT(pid)) {
*prevPtrPtr = infoPtr->nextPtr;
break;
}
@@ -2684,7 +2684,7 @@ Tcl_WaitPid(
} else {
errno = ECHILD;
*statPtr = 0xC0000000 | ECHILD;
- result = (Tcl_Pid)-1;
+ result = (Tcl_Pid) -1;
}
/*
@@ -2692,7 +2692,7 @@ Tcl_WaitPid(
*/
CloseHandle(infoPtr->hProcess);
- Tcl_Free(infoPtr);
+ ckfree(infoPtr);
return result;
}
@@ -2720,7 +2720,7 @@ TclWinAddProcess(
void *hProcess, /* Handle to process */
Tcl_Size id) /* Global process identifier */
{
- ProcInfo *procPtr = (ProcInfo *)Tcl_Alloc(sizeof(ProcInfo));
+ ProcInfo *procPtr = (ProcInfo *)ckalloc(sizeof(ProcInfo));
PipeInit();
@@ -2759,15 +2759,16 @@ Tcl_PidObjCmd(
Tcl_Channel chan;
const Tcl_ChannelType *chanTypePtr;
PipeInfo *pipePtr;
- size_t i;
- Tcl_Obj *resultPtr;
+ TCL_HASH_TYPE i;
+ Tcl_Obj *resultPtr, *elemPtr;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
return TCL_ERROR;
}
if (objc == 1) {
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(getpid()));
+ TclNewIntObj(elemPtr, getpid());
+ Tcl_SetObjResult(interp, elemPtr);
} else {
chan = Tcl_GetChannel(interp, TclGetString(objv[1]),
NULL);
@@ -2782,9 +2783,8 @@ Tcl_PidObjCmd(
pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
TclNewObj(resultPtr);
for (i = 0; i < pipePtr->numPids; i++) {
- Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
- Tcl_NewWideIntObj(
- TclpGetPid(pipePtr->pidPtr[i])));
+ TclNewIntObj(elemPtr, TclpGetPid(pipePtr->pidPtr[i]));
+ Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, elemPtr);
}
Tcl_SetObjResult(interp, resultPtr);
}
@@ -3266,7 +3266,7 @@ TclpOpenTemporaryFile(
TclDecrRefCount(tmpObj);
}
- return Tcl_MakeFileChannel((void *)handle,
+ return Tcl_MakeFileChannel((void *) handle,
TCL_READABLE|TCL_WRITABLE);
gotError:
@@ -3297,7 +3297,7 @@ TclPipeThreadCreateTI(
#ifndef _PTI_USE_CKALLOC
pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo));
#else
- pipeTI = (TclPipeThreadInfo *)Tcl_Alloc(sizeof(TclPipeThreadInfo));
+ pipeTI = (TclPipeThreadInfo *)ckalloc(sizeof(TclPipeThreadInfo));
#endif /* !_PTI_USE_CKALLOC */
pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL);
pipeTI->state = PTI_STATE_IDLE;
@@ -3658,7 +3658,7 @@ TclPipeThreadStop(
#ifndef _PTI_USE_CKALLOC
free(pipeTI);
#else
- Tcl_Free(pipeTI);
+ ckfree(pipeTI);
#endif /* !_PTI_USE_CKALLOC */
}
}
@@ -3708,7 +3708,7 @@ TclPipeThreadExit(
#ifndef _PTI_USE_CKALLOC
free(pipeTI);
#else
- Tcl_Free(pipeTI);
+ ckfree(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 f549420..9eb949b 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -511,12 +511,12 @@ typedef DWORD_PTR * PDWORD_PTR;
* use by tclAlloc.c.
*/
-#define TclpSysAlloc(size) ((void*)HeapAlloc(GetProcessHeap(), \
- 0, size))
+#define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \
+ (DWORD)0, (DWORD)size))
#define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \
- 0, (HGLOBAL)ptr))
+ (DWORD)0, (HGLOBAL)ptr))
#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \
- 0, (LPVOID)ptr, size))
+ (DWORD)0, (LPVOID)ptr, (DWORD)size))
/* This type is not defined in the Windows headers */
#define socklen_t int
@@ -527,7 +527,7 @@ typedef DWORD_PTR * PDWORD_PTR;
* address platform-specific issues.
*/
-#define TclpReleaseFile(file) Tcl_Free(file)
+#define TclpReleaseFile(file) ckfree(file)
/*
* The following macros and declarations wrap the C runtime library
@@ -544,4 +544,7 @@ typedef DWORD_PTR * PDWORD_PTR;
# define LABEL_SECURITY_INFORMATION (0x00000010L)
#endif
+#define Tcl_DirEntry void
+#define TclDIR void
+
#endif /* _TCLWINPORT */
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index d8193b4..635e978 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -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 */
- NULL, /* Close proc. */
+ TCL_CLOSE2PROC, /* Close proc. */
SerialInputProc, /* Input proc. */
SerialOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -535,7 +535,7 @@ SerialCheckProc(
if (needEvent) {
infoPtr->flags |= SERIAL_PENDING;
- evPtr = (SerialEvent *)Tcl_Alloc(sizeof(SerialEvent));
+ evPtr = (SerialEvent *)ckalloc(sizeof(SerialEvent));
evPtr->header.proc = SerialEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -670,10 +670,10 @@ SerialCloseProc(
*/
if (serialPtr->writeBuf != NULL) {
- Tcl_Free(serialPtr->writeBuf);
+ ckfree(serialPtr->writeBuf);
serialPtr->writeBuf = NULL;
}
- Tcl_Free(serialPtr);
+ ckfree(serialPtr);
if (errorCode == 0) {
return result;
@@ -796,7 +796,7 @@ SerialBlockingWrite(
LeaveCriticalSection(&infoPtr->csWrite);
if (result == FALSE) {
- DWORD err = GetLastError();
+ int err = GetLastError();
switch (err) {
case ERROR_IO_PENDING:
@@ -1035,10 +1035,10 @@ SerialOutputProc(
*/
if (infoPtr->writeBuf) {
- Tcl_Free(infoPtr->writeBuf);
+ ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite);
+ infoPtr->writeBuf = (char *)ckalloc(toWrite);
}
memcpy(infoPtr->writeBuf, buf, toWrite);
infoPtr->toWrite = toWrite;
@@ -1455,7 +1455,7 @@ TclWinOpenSerialChannel(
SerialInit();
- infoPtr = (SerialInfo *)Tcl_Alloc(sizeof(SerialInfo));
+ infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo));
memset(infoPtr, 0, sizeof(SerialInfo));
infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE);
@@ -1507,7 +1507,13 @@ 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", "\x1A {}");
return infoPtr->channel;
}
@@ -1775,7 +1781,7 @@ SerialSetOptionProc(
" two elements with each a single 8-bit character", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", (char *)NULL);
}
- Tcl_Free((void *)argv);
+ ckfree(argv);
return TCL_ERROR;
}
@@ -1806,7 +1812,7 @@ SerialSetOptionProc(
}
dcb.XoffChar = (char) character;
}
- Tcl_Free((void *)argv);
+ ckfree(argv);
if (!SetCommState(infoPtr->handle, &dcb)) {
goto setStateFailed;
@@ -1832,7 +1838,7 @@ SerialSetOptionProc(
"a list of signal,value pairs", value));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", (char *)NULL);
}
- Tcl_Free((void *)argv);
+ ckfree(argv);
return TCL_ERROR;
}
@@ -1890,7 +1896,7 @@ SerialSetOptionProc(
}
}
- Tcl_Free((void *)argv);
+ ckfree(argv);
return res;
}
@@ -1916,7 +1922,7 @@ SerialSetOptionProc(
inSize = atoi(argv[0]);
outSize = atoi(argv[1]);
}
- Tcl_Free((void *)argv);
+ ckfree(argv);
if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
if (interp != NULL) {
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index c51d69d..0dd7871 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -242,12 +242,12 @@ static int FindFDInList(TcpState *statePtr, SOCKET socket);
static DWORD WINAPI SocketThread(LPVOID arg);
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;
@@ -264,7 +264,11 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc;
static const Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- NULL, /* Close proc. */
+#ifndef TCL_NO_DEPRECATED
+ TcpCloseProc, /* Close proc. */
+#else
+ TCL_CLOSE2PROC, /* Close proc. */
+#endif
TcpInputProc, /* Input proc. */
TcpOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -344,7 +348,7 @@ printaddrinfolist(
void
InitializeHostName(
char **valuePtr,
- size_t *lengthPtr,
+ TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr)
{
WCHAR wbuf[256];
@@ -372,15 +376,15 @@ InitializeHostName(
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_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs),
+ TCL_INDEX_NONE, &ds);
}
Tcl_DStringFree(&inDs);
}
*encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
*lengthPtr = Tcl_DStringLength(&ds);
- *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
+ *valuePtr = (char *)ckalloc(*lengthPtr + 1);
memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
Tcl_DStringFree(&ds);
}
@@ -1052,7 +1056,7 @@ TcpCloseProc(
Tcl_WinConvertError((DWORD) WSAGetLastError());
errorCode = Tcl_GetErrno();
}
- Tcl_Free(thisfd);
+ ckfree(thisfd);
}
if (statePtr->addrlist != NULL) {
@@ -1093,7 +1097,7 @@ TcpCloseProc(
* fear of damaging the list.
*/
- Tcl_Free(statePtr);
+ ckfree(statePtr);
return errorCode;
}
@@ -1730,7 +1734,7 @@ TcpConnect(
* Set kernel space buffering
*/
- TclSockMinimumBuffers((void *)statePtr->sockets->fd,
+ TclSockMinimumBuffers((void *) statePtr->sockets->fd,
TCP_BUFFER_SIZE);
/*
@@ -2026,11 +2030,11 @@ Tcl_OpenTcpClient(
statePtr, (TCL_READABLE | TCL_WRITABLE));
if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
"-translation", "auto crlf")) {
- Tcl_CloseEx(NULL, statePtr->channel, 0);
+ Tcl_Close(NULL, statePtr->channel);
return NULL;
} else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
"-eofchar", "")) {
- Tcl_CloseEx(NULL, statePtr->channel, 0);
+ Tcl_Close(NULL, statePtr->channel);
return NULL;
}
return statePtr->channel;
@@ -2269,7 +2273,7 @@ Tcl_OpenTcpServerEx(
SendSelectMessage(tsdPtr, SELECT, statePtr);
if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_CloseEx(NULL, statePtr->channel, 0);
+ Tcl_Close(NULL, statePtr->channel);
return NULL;
}
return statePtr->channel;
@@ -2341,12 +2345,12 @@ TcpAccept(
newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_CloseEx(NULL, newInfoPtr->channel, 0);
+ Tcl_Close(NULL, newInfoPtr->channel);
return;
}
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_CloseEx(NULL, newInfoPtr->channel, 0);
+ Tcl_Close(NULL, newInfoPtr->channel);
return;
}
@@ -2543,7 +2547,7 @@ SocketCheckProc(
statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
&& !GOT_BITS(statePtr->flags, SOCKET_PENDING)) {
SET_BITS(statePtr->flags, SOCKET_PENDING);
- evPtr = (SocketEvent *)Tcl_Alloc(sizeof(SocketEvent));
+ evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent));
evPtr->header.proc = SocketEventProc;
evPtr->socket = statePtr->sockets->fd;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -2818,7 +2822,7 @@ AddSocketInfoFd(
* Add the first FD.
*/
- statePtr->sockets = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
+ statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList));
fds = statePtr->sockets;
} else {
/*
@@ -2829,7 +2833,7 @@ AddSocketInfoFd(
fds = fds->next;
}
- fds->next = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
+ fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList));
fds = fds->next;
}
@@ -2862,7 +2866,7 @@ AddSocketInfoFd(
static TcpState *
NewSocketInfo(SOCKET socket)
{
- TcpState *statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
+ TcpState *statePtr = (TcpState *)ckalloc(sizeof(TcpState));
memset(statePtr, 0, sizeof(TcpState));
@@ -3225,6 +3229,68 @@ 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.
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 753fe12..ec12f67 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -9,8 +9,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#undef BUILD_tcl
-#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
# define USE_TCL_STUBS
#endif
@@ -42,6 +40,7 @@ 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,6 +77,7 @@ 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;
}
@@ -310,6 +310,28 @@ TestwinsleepCmd(
return TCL_OK;
}
+static int
+TestSizeCmd(
+ TCL_UNUSED(void *),
+ 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;
+}
+
/*
*----------------------------------------------------------------------
*
@@ -458,15 +480,15 @@ TestplatformChmod(
&& GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
goto done;
}
- pTokenUser = (TOKEN_USER *)Tcl_Alloc(dw);
+ pTokenUser = (TOKEN_USER *)ckalloc(dw);
if (!GetTokenInformation(hToken, TokenUser, pTokenUser, dw, &dw)) {
goto done;
}
aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid);
- aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
+ aceEntry[nSids].pSid = ckalloc(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 */
+ ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
goto done;
}
/*
@@ -499,19 +521,19 @@ TestplatformChmod(
GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
goto done;
}
- pTokenGroup = (TOKEN_PRIMARY_GROUP *)Tcl_Alloc(dw);
+ pTokenGroup = (TOKEN_PRIMARY_GROUP *)ckalloc(dw);
if (!GetTokenInformation(hToken, TokenPrimaryGroup, pTokenGroup, dw, &dw)) {
- Tcl_Free(pTokenGroup);
+ ckfree(pTokenGroup);
goto done;
}
aceEntry[nSids].sidLen = GetLengthSid(pTokenGroup->PrimaryGroup);
- aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
+ aceEntry[nSids].pSid = ckalloc(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 */
+ ckfree(pTokenGroup);
+ ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
goto done;
}
- Tcl_Free(pTokenGroup);
+ ckfree(pTokenGroup);
/* Generate mask for group ACL */
@@ -535,10 +557,10 @@ TestplatformChmod(
goto done;
}
aceEntry[nSids].sidLen = GetLengthSid(pWorldSid);
- aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
+ aceEntry[nSids].pSid = ckalloc(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 */
+ ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
goto done;
}
LocalFree(pWorldSid);
@@ -566,7 +588,7 @@ TestplatformChmod(
newAclSize +=
offsetof(ACCESS_ALLOWED_ACE, SidStart) + aceEntry[i].sidLen;
}
- newAcl = (PACL)Tcl_Alloc(newAclSize);
+ newAcl = (PACL)ckalloc(newAclSize);
if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
goto done;
}
@@ -590,16 +612,16 @@ TestplatformChmod(
done:
if (pTokenUser) {
- Tcl_Free(pTokenUser);
+ ckfree(pTokenUser);
}
if (hToken) {
CloseHandle(hToken);
}
if (newAcl) {
- Tcl_Free(newAcl);
+ ckfree(newAcl);
}
for (i = 0; i < nSids; ++i) {
- Tcl_Free(aceEntry[i].pSid);
+ ckfree(aceEntry[i].pSid);
}
if (res != 0) {
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 01db9f3..e8d4d4d 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -178,7 +178,7 @@ TclWinThreadStart(
lpOrigStartAddress = winThreadPtr->lpStartAddress;
lpOrigParameter = winThreadPtr->lpParameter;
- Tcl_Free(winThreadPtr);
+ ckfree(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. */
- void *clientData, /* The one argument to Main(). */
- size_t stackSize, /* Size of stack for the new thread. */
+ void *clientData, /* The one argument to Main(). */
+ TCL_HASH_TYPE 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 *)Tcl_Alloc(sizeof(WinThread));
+ winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread));
winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
winThreadPtr->lpParameter = clientData;
winThreadPtr->fpControl = _controlfp(0, 0);
@@ -567,7 +567,7 @@ Tcl_MutexLock(
*/
if (*mutexPtr == NULL) {
- csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION));
+ csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION));
InitializeCriticalSection(csPtr);
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
@@ -628,7 +628,7 @@ TclpFinalizeMutex(
if (csPtr != NULL) {
DeleteCriticalSection(csPtr);
- Tcl_Free(csPtr);
+ ckfree(csPtr);
*mutexPtr = NULL;
}
}
@@ -710,7 +710,7 @@ Tcl_ConditionWait(
*/
if (*condPtr == NULL) {
- winCondPtr = (WinCondition *)Tcl_Alloc(sizeof(WinCondition));
+ winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition));
InitializeCriticalSection(&winCondPtr->condLock);
winCondPtr->firstPtr = NULL;
winCondPtr->lastPtr = NULL;
@@ -921,7 +921,7 @@ TclpFinalizeCondition(
if (winCondPtr != NULL) {
DeleteCriticalSection(&winCondPtr->condLock);
- Tcl_Free(winCondPtr);
+ ckfree(winCondPtr);
*condPtr = NULL;
}
}
@@ -1036,7 +1036,7 @@ TclpThreadCreateKey(void)
{
DWORD *key;
- key = (DWORD *)TclpSysAlloc(sizeof *key);
+ key = (DWORD *)TclpSysAlloc(sizeof *key, 0);
if (key == NULL) {
Tcl_Panic("unable to allocate thread key!");
}
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index a0c7833..438a8ec 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -12,6 +12,10 @@
#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.
*/
@@ -19,6 +23,27 @@
#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.
*/
@@ -108,6 +133,9 @@ 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(void *clientData);
static DWORD WINAPI CalibrationThread(LPVOID arg);
static void UpdateTimeEachSecond(void);
@@ -163,7 +191,7 @@ IsTimeNative(void)
*----------------------------------------------------------------------
*/
-unsigned long long
+unsigned long
TclpGetSeconds(void)
{
long long usecSincePosixEpoch;
@@ -178,7 +206,7 @@ TclpGetSeconds(void)
Tcl_Time t;
GetTime(&t);
- return (unsigned long long)t.sec;
+ return t.sec;
}
}
@@ -201,7 +229,7 @@ TclpGetSeconds(void)
*----------------------------------------------------------------------
*/
-unsigned long long
+unsigned long
TclpGetClicks(void)
{
long long usecSincePosixEpoch;
@@ -211,7 +239,7 @@ TclpGetClicks(void)
*/
if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
- return (Tcl_WideUInt) usecSincePosixEpoch;
+ return (unsigned long) usecSincePosixEpoch;
} else {
/*
* Use the Tcl_GetTime abstraction to get the time in microseconds, as
@@ -221,8 +249,7 @@ TclpGetClicks(void)
Tcl_Time now; /* Current Tcl time */
GetTime(&now);
- return ((unsigned long long)(now.sec)*1000000ULL) +
- (unsigned long long)(now.usec);
+ return ((unsigned long)(now.sec)*1000000UL) + (unsigned long)(now.usec);
}
}
@@ -347,7 +374,7 @@ TclpGetMicroseconds(void)
Tcl_Time now;
GetTime(&now);
- return now.sec * 1000000 + now.usec;
+ return (((long long) now.sec) * 1000000) + now.usec;
}
}
@@ -384,8 +411,8 @@ Tcl_GetTime(
*/
if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
- timePtr->sec = usecSincePosixEpoch / 1000000;
- timePtr->usec = usecSincePosixEpoch % 1000000;
+ timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
+ timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
} else {
GetTime(timePtr);
}
@@ -599,6 +626,7 @@ NativeGetMicroseconds(void)
LONGLONG perfCounterLastCall, curCounterFreq;
/* Copy with current data of calibration
* cycle. */
+
LARGE_INTEGER curCounter;
/* Current performance counter. */
@@ -653,7 +681,6 @@ NativeGetMicroseconds(void)
/*
* High resolution timer is not available.
*/
-
return 0;
}
@@ -687,8 +714,8 @@ NativeGetTime(
usecSincePosixEpoch = NativeGetMicroseconds();
if (usecSincePosixEpoch) {
- timePtr->sec = usecSincePosixEpoch / 1000000;
- timePtr->usec = usecSincePosixEpoch % 1000000;
+ timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
+ timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
} else {
/*
* High resolution timer is not available. Just use ftime.
@@ -697,7 +724,7 @@ NativeGetTime(
struct _timeb t;
_ftime(&t);
- timePtr->sec = t.time;
+ timePtr->sec = (long) t.time;
timePtr->usec = t.millitm * 1000;
}
}
@@ -741,6 +768,226 @@ 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)
+# 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)
+# 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)
+ _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
@@ -1006,7 +1253,6 @@ UpdateTimeEachSecond(void)
* First adjust with a micro jump (short frozen time is
* acceptable).
*/
-
vt0 += nt0 - nt1;
/*
@@ -1180,6 +1426,77 @@ 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)
+ return gmtime(timePtr);
+#else
+ return _gmtime32((const __time32_t *) timePtr);
+#endif /* _WIN64 || _USE_64BIT_TIME_T */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+ return localtime(timePtr);
+#else
+ return _localtime32((const __time32_t *) timePtr);
+#endif /* _WIN64 || _USE_64BIT_TIME_T */
+}
+#endif /* TCL_NO_DEPRECATED */
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_SetTimeProc --
*
* TIP #233 (Virtualized Time): Registers two handlers for the
generated by cgit v0.12 at 2024-11-16 19:49:41 (GMT)