summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in58
-rw-r--r--win/README8
-rwxr-xr-xwin/configure65
-rw-r--r--win/configure.ac34
-rw-r--r--win/makefile.vc56
-rw-r--r--win/tcl.dsp28
-rw-r--r--win/tcl.m410
-rw-r--r--win/tclAppInit.c12
-rw-r--r--win/tclConfig.sh.in14
-rw-r--r--win/tclWin32Dll.c84
-rw-r--r--win/tclWinChan.c155
-rw-r--r--win/tclWinConsole.c84
-rw-r--r--win/tclWinDde.c68
-rw-r--r--win/tclWinError.c12
-rw-r--r--win/tclWinFCmd.c34
-rw-r--r--win/tclWinFile.c69
-rw-r--r--win/tclWinInit.c41
-rw-r--r--win/tclWinInt.h2
-rw-r--r--win/tclWinLoad.c10
-rw-r--r--win/tclWinNotify.c23
-rw-r--r--win/tclWinPanic.c4
-rw-r--r--win/tclWinPipe.c114
-rw-r--r--win/tclWinPort.h13
-rw-r--r--win/tclWinReg.c70
-rw-r--r--win/tclWinSerial.c90
-rw-r--r--win/tclWinSock.c100
-rw-r--r--win/tclWinTest.c69
-rw-r--r--win/tclWinThrd.c22
-rw-r--r--win/tclWinTime.c363
29 files changed, 545 insertions, 1167 deletions
diff --git a/win/Makefile.in b/win/Makefile.in
index 0250911..877c4f3 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -50,7 +50,7 @@ LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir)
SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
# Path name to use when installing Tcl modules.
-MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8
+MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl9
# Directory in which to install the include file tcl.h:
INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir)
@@ -145,9 +145,11 @@ TCL_VFS_ROOT = libtcl.vfs
TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
TCL_DLL_FILE = @TCL_DLL_FILE@
TCL_LIB_FILE = @TCL_LIB_FILE@
-DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX}
+DDE_DLL_FILE = tcl9dde$(DDEVER)${DLLSUFFIX}
+DDE_DLL_FILE8 = tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
-REG_DLL_FILE = tclregistry$(REGVER)${DLLSUFFIX}
+REG_DLL_FILE = tcl9registry$(REGVER)${DLLSUFFIX}
+REG_DLL_FILE8 = tclregistry$(REGVER)${DLLSUFFIX}
REG_LIB_FILE = @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE = tcltest${EXESUFFIX}
@@ -271,6 +273,7 @@ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}
TCLTEST_OBJS = \
tclTest.$(OBJEXT) \
+ tclTestABSList.$(OBJEXT) \
tclTestObj.$(OBJEXT) \
tclTestProcBodyObj.$(OBJEXT) \
tclThreadTest.$(OBJEXT) \
@@ -461,6 +464,8 @@ REG_OBJS = tclWinReg.$(OBJEXT)
STUB_OBJS = \
tclStubLib.$(OBJEXT) \
+ tclStubCall.$(OBJEXT) \
+ tclStubLibTbl.$(OBJEXT) \
tclTomMathStubLib.$(OBJEXT) \
tclOOStubLib.$(OBJEXT) \
tclWinPanic.$(OBJEXT)
@@ -519,7 +524,7 @@ tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd
binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH)
-winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}
+winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} ${DDE_DLL_FILE8} ${REG_DLL_FILE8}
libraries:
@@ -593,6 +598,14 @@ ${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest
+${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinDde.$(OBJEXT)
+ @MAKE_DLL@ tcl8WinDde.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
+ $(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest
+
+${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinReg.$(OBJEXT)
+ @MAKE_DLL@ -DTCL_MAJOR_VERSION=8 tcl8WinReg.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
+ $(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest
+
${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
@@ -649,9 +662,15 @@ tclWinPipe.${OBJEXT}: tclWinPipe.c
tclWinReg.${OBJEXT}: tclWinReg.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+tcl8WinReg.${OBJEXT}: tclWinReg.c
+ $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+
tclWinDde.${OBJEXT}: tclWinDde.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+tcl8WinDde.${OBJEXT}: tclWinDde.c
+ $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+
tclAppInit.${OBJEXT}: tclAppInit.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
@@ -711,6 +730,15 @@ tclUuid.h: $(TOP_DIR)/manifest.uuid
tclStubLib.${OBJEXT}: tclStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME)
+tclStubCall.${OBJEXT}: tclStubCall.c
+ $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD \
+ -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
+ -DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \
+ @DEPARG@ $(CC_OBJNAME)
+
+tclStubLibTbl.${OBJEXT}: tclStubLibTbl.c
+ $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+
tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
$(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME)
@@ -841,6 +869,10 @@ install-binaries: binaries
$(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
"$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
fi
+ @if [ -f $(DDE_DLL_FILE8) ]; then \
+ echo Installing $(DDE_DLL_FILE8); \
+ $(COPY) $(DDE_DLL_FILE8) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
+ fi
@if [ -f $(DDE_LIB_FILE) ]; then \
echo Installing $(DDE_LIB_FILE); \
$(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
@@ -851,6 +883,10 @@ install-binaries: binaries
$(COPY) $(ROOT_DIR)/library/registry/pkgIndex.tcl \
"$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
fi
+ @if [ -f $(REG_DLL_FILE8) ]; then \
+ echo Installing $(REG_DLL_FILE8); \
+ $(COPY) $(REG_DLL_FILE8) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
+ fi
@if [ -f $(REG_LIB_FILE) ]; then \
echo Installing $(REG_LIB_FILE); \
$(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
@@ -874,7 +910,7 @@ install-libraries: libraries install-tzdata install-msgs
else true; \
fi; \
done;
- @for i in 8.4 8.4/platform 8.5 8.6 8.7; \
+ @for i in 9.0 9.0/platform; \
do \
if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \
echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \
@@ -892,19 +928,19 @@ install-libraries: libraries install-tzdata install-msgs
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
done;
@echo "Installing package http 2.10b1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10b1.tm";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10b1.tm";
@echo "Installing package opt 0.4.7";
@for j in $(ROOT_DIR)/library/opt/*.tcl; do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
@echo "Installing package msgcat 1.7.1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm";
@echo "Installing package tcltest 2.5.6 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.6.tm";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.6.tm";
@echo "Installing package platform 1.0.19 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm";
+ @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.tm";
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm";
+ @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/9.0/platform/shell-1.1.4.tm";
@echo "Installing encodings";
@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
@@ -1110,7 +1146,7 @@ genstubs:
#
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
-# workspace. It depends on the Tcl & Tk being in directories called tcl8.* &
+# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
# tk8.* up two directories from the TOOL_DIR.
#
diff --git a/win/README b/win/README
index 3cfcc15..9b001ba 100644
--- a/win/README
+++ b/win/README
@@ -1,4 +1,4 @@
-Tcl 8.7 for Windows
+Tcl 9.0 for Windows
1. Introduction
---------------
@@ -16,7 +16,7 @@ The information in this file is maintained on the web at:
In order to compile Tcl for Windows, you need the following:
- Tcl 8.7 Source Distribution (plus any patches)
+ Tcl 9.0 Source Distribution (plus any patches)
and
@@ -80,9 +80,9 @@ Use the Makefile "install" target to install Tcl. It will install it
according to the prefix options you provided in the correct directory
structure.
-Note that in order to run tclsh87.exe, you must ensure that tcl87.dll,
+Note that in order to run tclsh90.exe, you must ensure that tcl90.dll,
libtommath.dll and zlib1.dll are on your path, in the system
-directory, or in the directory containing tclsh87.exe.
+directory, or in the directory containing tclsh90.exe.
Note: Tcl no longer provides support for systems earlier than Windows 7.
You will also need the Windows Universal C runtime (UCRT):
diff --git a/win/configure b/win/configure
index f154f32..80d42d4 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.71 for tcl 8.7.
+# Generated by GNU Autoconf 2.71 for tcl 9.0.
#
#
# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation,
@@ -608,8 +608,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='tcl'
PACKAGE_TARNAME='tcl'
-PACKAGE_VERSION='8.7'
-PACKAGE_STRING='tcl 8.7'
+PACKAGE_VERSION='9.0'
+PACKAGE_STRING='tcl 9.0'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''
@@ -661,10 +661,6 @@ 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
@@ -748,7 +744,6 @@ CFLAGS_NOLTO
CFLAGS_WARNING
CFLAGS_OPTIMIZE
CFLAGS_DEBUG
-DL_LIBS
WINE
CYGPATH
SHARED_BUILD
@@ -808,7 +803,6 @@ ac_user_opts='
enable_option_checking
with_encoding
enable_shared
-enable_time64bit
enable_64bit
enable_zipfs
enable_symbols
@@ -1371,7 +1365,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures tcl 8.7 to adapt to many kinds of systems.
+\`configure' configures tcl 9.0 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1433,7 +1427,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of tcl 8.7:";;
+ short | recursive ) echo "Configuration of tcl 9.0:";;
esac
cat <<\_ACEOF
@@ -1442,7 +1436,6 @@ Optional Features:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--enable-shared build and link with shared libraries (default: on)
- --enable-time64bit force 64-bit time_t for 32-bit build (default: off)
--enable-64bit enable 64bit support (where applicable)
--enable-zipfs build with Zipfs support (default: on)
--enable-symbols build with debugging symbols (default: off)
@@ -1531,7 +1524,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-tcl configure 8.7
+tcl configure 9.0
generated by GNU Autoconf 2.71
Copyright (C) 2021 Free Software Foundation, Inc.
@@ -1735,7 +1728,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 8.7, which was
+It was created by tcl $as_me 9.0, which was
generated by GNU Autoconf 2.71. Invocation command line was
$ $0$ac_configure_args_raw
@@ -2400,10 +2393,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TCL_VERSION=8.7
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=7
-TCL_PATCH_LEVEL="a6"
+TCL_VERSION=9.0
+TCL_MAJOR_VERSION=9
+TCL_MINOR_VERSION=0
+TCL_PATCH_LEVEL="a4"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
@@ -3892,26 +3885,6 @@ printf "%s\n" "#define STATIC_BUILD 1" >>confdefs.h
#--------------------------------------------------------------------
-# Check whether --enable-time64bit was given.
-#--------------------------------------------------------------------
-
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking force of 64-bit time_t" >&5
-printf %s "checking force of 64-bit time_t... " >&6; }
-# Check whether --enable-time64bit was given.
-if test ${enable_time64bit+y}
-then :
- enableval=$enable_time64bit; tcl_ok=$enableval
-else $as_nop
- tcl_ok=no
-fi
-
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: \"$tcl_ok\"" >&5
-printf "%s\n" "\"$tcl_ok\"" >&6; }
-if test "$tcl_ok" = "yes"; then
- CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T"
-fi
-
-#--------------------------------------------------------------------
# The statements below define a collection of compile flags. This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
@@ -4851,8 +4824,6 @@ printf "%s\n" "#define HAVE_CAST_TO_UNION 1" >>confdefs.h
fi
fi
- # DL_LIBS is empty, but then we match the Unix version
-
@@ -5787,8 +5758,8 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""
eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
-eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
-eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\""
+eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${LIBSUFFIX}\""
+eval "TCL_STUB_LIB_FLAG=\"-ltclstub${LIBFLAGSUFFIX}\""
eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\""
eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\""
@@ -5916,12 +5887,6 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d
-# empty on win, but needs sub'ing
-
-
-
-
-
@@ -6478,7 +6443,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 8.7, which was
+This file was extended by tcl $as_me 9.0, which was
generated by GNU Autoconf 2.71. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -6533,7 +6498,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 8.7
+tcl config.status 9.0
configured by $0, generated by GNU Autoconf 2.71,
with options \\"\$ac_cs_config\\"
diff --git a/win/configure.ac b/win/configure.ac
index 8391161..d9a9421 100644
--- a/win/configure.ac
+++ b/win/configure.ac
@@ -3,7 +3,7 @@
# generate the file "configure", which is run during Tcl installation
# to configure the system for the local environment.
-AC_INIT([tcl],[8.7])
+AC_INIT([tcl],[9.0])
AC_CONFIG_SRCDIR([../generic/tcl.h])
AC_PREREQ([2.69])
@@ -12,10 +12,10 @@ AC_PREREQ([2.69])
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TCL_VERSION=8.7
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=7
-TCL_PATCH_LEVEL="a6"
+TCL_VERSION=9.0
+TCL_MAJOR_VERSION=9
+TCL_MINOR_VERSION=0
+TCL_PATCH_LEVEL="a4"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
@@ -92,20 +92,6 @@ SC_TCL_CFG_ENCODING
SC_ENABLE_SHARED
#--------------------------------------------------------------------
-# Check whether --enable-time64bit was given.
-#--------------------------------------------------------------------
-
-AC_MSG_CHECKING([force of 64-bit time_t])
-AC_ARG_ENABLE(time64bit,
- AS_HELP_STRING([--enable-time64bit],
- [force 64-bit time_t for 32-bit build (default: off)]),
- [tcl_ok=$enableval], [tcl_ok=no])
-AC_MSG_RESULT("$tcl_ok")
-if test "$tcl_ok" = "yes"; then
- CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T"
-fi
-
-#--------------------------------------------------------------------
# The statements below define a collection of compile flags. This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
@@ -334,8 +320,8 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""
eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
-eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
-eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\""
+eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${LIBSUFFIX}\""
+eval "TCL_STUB_LIB_FLAG=\"-ltclstub${LIBFLAGSUFFIX}\""
eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\""
eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\""
@@ -463,13 +449,7 @@ AC_SUBST(POST_MAKE_LIB)
AC_SUBST(MAKE_DLL)
AC_SUBST(MAKE_EXE)
-# empty on win, but needs sub'ing
AC_SUBST(TCL_BUILD_LIB_SPEC)
-AC_SUBST(TCL_CC_SEARCH_FLAGS)
-AC_SUBST(TCL_LD_SEARCH_FLAGS)
-AC_SUBST(TCL_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 72f4957..3883999 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -52,7 +52,7 @@
# turn on the 64-bit compiler, if your SDK has it.
#
# Basic macros and options usable on the commandline (see rules.vc for more info):
-# OPTS=msvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,time64bit,unchecked,none
+# OPTS=nomsvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,unchecked,none
# Sets special options for the core. The default is for none.
# Any combination of the above may be used (comma separated).
# 'none' will over-ride everything to nothing.
@@ -75,8 +75,6 @@
# 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).
@@ -217,10 +215,10 @@ DDEVERSION = $(DDEDOTVERSION:.=)
REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)
-TCLREGLIBNAME = $(PROJECT)registry$(REGVERSION)$(SUFX:t=).$(EXT)
+TCLREGLIBNAME = $(PROJECT)9registry$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
-TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
+TCLDDELIBNAME = $(PROJECT)9dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
@@ -236,6 +234,7 @@ 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 +245,8 @@ COREOBJS = \
$(TMP_DIR)\regerror.obj \
$(TMP_DIR)\regexec.obj \
$(TMP_DIR)\regfree.obj \
- $(TMP_DIR)\tclAlloc.obj \
$(TMP_DIR)\tclArithSeries.obj \
+ $(TMP_DIR)\tclAlloc.obj \
$(TMP_DIR)\tclAssembly.obj \
$(TMP_DIR)\tclAsync.obj \
$(TMP_DIR)\tclBasic.obj \
@@ -451,6 +450,8 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
TCLSTUBOBJS = \
$(TMP_DIR)\tclStubLib.obj \
+ $(TMP_DIR)\tclStubCall.obj \
+ $(TMP_DIR)\tclStubLibTbl.obj \
$(TMP_DIR)\tclTomMathStubLib.obj \
$(TMP_DIR)\tclOOStubLib.obj \
$(TMP_DIR)\tclWinPanic.obj
@@ -807,10 +808,7 @@ $(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
@@ -880,6 +878,9 @@ $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h
$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
$(cc32) $(appcflags) -Fo$@ $?
+$(TMP_DIR)\tclTestABSList.obj: $(GENERICDIR)\tclTestABSList.c
+ $(cc32) $(appcflags) -Fo$@ $?
+
$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
$(CCAPPCMD) $?
@@ -926,11 +927,11 @@ $(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c
### The following objects should be built using the stub interfaces
$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c
- $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?
$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
- $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?
### The following objects are part of the stub library and should not
@@ -940,6 +941,15 @@ $(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
$(cc32) $(stubscflags) -Fo$@ $?
+$(TMP_DIR)\tclStubCall.obj: $(GENERICDIR)\tclStubCall.c
+ $(cc32) $(stubscflags) \
+ /DCFG_RUNTIME_DLLFILE="\"$(TCLLIBNAME)\"" \
+ /DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ $(TCL_INCLUDES) -Fo$@ $?
+
+$(TMP_DIR)\tclStubLibTbl.obj: $(GENERICDIR)\tclStubLibTbl.c
+ $(cc32) $(stubscflags) $(TCL_INCLUDES) -Fo$@ $?
+
$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
$(cc32) $(stubscflags) -Fo$@ $?
@@ -1084,30 +1094,24 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
@if not exist "$(MODULE_INSTALL_DIR)" \
$(MKDIR) "$(MODULE_INSTALL_DIR)"
@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.6" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.6"
+ @if not exist "$(MODULE_INSTALL_DIR)\9.0" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0"
@$(COPY) "$(ROOT)\library\http\http.tcl" \
- "$(MODULE_INSTALL_DIR)\8.6\http-$(PKG_HTTP_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\http-$(PKG_HTTP_VER).tm"
@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.7" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.7"
@$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
- "$(MODULE_INSTALL_DIR)\8.7\msgcat-$(PKG_MSGCAT_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\msgcat-$(PKG_MSGCAT_VER).tm"
@echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.5" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.5"
@$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
- "$(MODULE_INSTALL_DIR)\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\tcltest-$(PKG_TCLTEST_VER).tm"
@echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.4" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4"
- @if not exist "$(MODULE_INSTALL_DIR)\8.4\platform" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4\platform"
+ @if not exist "$(MODULE_INSTALL_DIR)\9.0\platform" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0\platform"
@$(COPY) "$(ROOT)\library\platform\platform.tcl" \
- "$(MODULE_INSTALL_DIR)\8.4\platform-$(PKG_PLATFORM_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\platform-$(PKG_PLATFORM_VER).tm"
@echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\platform\shell.tcl" \
- "$(MODULE_INSTALL_DIR)\8.4\platform\shell-$(PKG_SHELL_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\platform\shell-$(PKG_SHELL_VER).tm"
!endif
@echo Installing $(TCLDDELIBNAME)
!if !$(STATIC_BUILD)
diff --git a/win/tcl.dsp b/win/tcl.dsp
index 93e093c..a5e4a63 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -36,7 +36,7 @@ CFG=tcl - Win32 Debug Static
# PROP BASE Intermediate_Dir "Release\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh87.exe"
+# PROP BASE Target_File "Release\tclsh90.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -45,7 +45,7 @@ CFG=tcl - Win32 Debug Static
# PROP Intermediate_Dir "Release\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Release\tclsh87t.exe"
+# PROP Target_File "Release\tclsh90t.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -57,7 +57,7 @@ CFG=tcl - Win32 Debug Static
# PROP BASE Intermediate_Dir "Debug\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh87g.exe"
+# PROP BASE Target_File "Debug\tclsh90g.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -66,7 +66,7 @@ CFG=tcl - Win32 Debug Static
# PROP Intermediate_Dir "Debug\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Debug\tclsh87tg.exe"
+# PROP Target_File "Debug\tclsh90tg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -78,7 +78,7 @@ CFG=tcl - Win32 Debug Static
# PROP BASE Intermediate_Dir "Debug\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh87sg.exe"
+# PROP BASE Target_File "Debug\tclsh90sg.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -87,7 +87,7 @@ CFG=tcl - Win32 Debug Static
# PROP Intermediate_Dir "Debug\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Debug\tclsh87sg.exe"
+# PROP Target_File "Debug\tclsh90sg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -99,7 +99,7 @@ CFG=tcl - Win32 Debug Static
# PROP BASE Intermediate_Dir "Release\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh87s.exe"
+# PROP BASE Target_File "Release\tclsh90s.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -108,7 +108,7 @@ CFG=tcl - Win32 Debug Static
# PROP Intermediate_Dir "Release\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Release\tclsh87s.exe"
+# PROP Target_File "Release\tclsh90s.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -232,10 +232,6 @@ SOURCE=..\doc\CallDel.3
# End Source File
# Begin Source File
-SOURCE=..\doc\case.n
-# End Source File
-# Begin Source File
-
SOURCE=..\doc\catch.n
# End Source File
# Begin Source File
@@ -1244,6 +1240,14 @@ SOURCE=..\generic\tclStubLib.c
# End Source File
# Begin Source File
+SOURCE=..\generic\tclStubCall.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclStubLibTbl.c
+# End Source File
+# Begin Source File
+
SOURCE=..\generic\tclOOStubLib.c
# End Source File
# Begin Source File
diff --git a/win/tcl.m4 b/win/tcl.m4
index fff706b..5daeb74 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -959,8 +959,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
fi
- # DL_LIBS is empty, but then we match the Unix version
- AC_SUBST(DL_LIBS)
AC_SUBST(CFLAGS_DEBUG)
AC_SUBST(CFLAGS_OPTIMIZE)
AC_SUBST(CFLAGS_WARNING)
@@ -985,13 +983,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
#------------------------------------------------------------------------
AC_DEFUN([SC_WITH_TCL], [
- if test -d ../../tcl8.7$1/win; then
- TCL_BIN_DEFAULT=../../tcl8.7$1/win
+ if test -d ../../tcl9.0$1/win; then
+ TCL_BIN_DEFAULT=../../tcl9.0$1/win
else
- TCL_BIN_DEFAULT=../../tcl8.7/win
+ TCL_BIN_DEFAULT=../../tcl9.0/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.7 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 9.0 binaries from DIR],
TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index d1b38ee..8fad88a 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -215,8 +215,11 @@ Tcl_AppInit(
* user-specific startup file will be run under any conditions.
*/
- Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", TCL_INDEX_NONE), NULL,
- Tcl_NewStringObj("~/tclshrc.tcl", TCL_INDEX_NONE), TCL_GLOBAL_ONLY);
+ (void)Tcl_EvalEx(interp,
+ "set tcl_rcFileName [file tildeexpand ~/tclshrc.tcl]",
+ -1,
+ TCL_EVAL_GLOBAL);
+
return TCL_OK;
}
@@ -277,11 +280,10 @@ setargv(
}
}
- /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
+ /* Make sure we don't call Tcl_Alloc through the (not yet initialized) stub table */
# undef Tcl_Alloc
-# undef Tcl_DbCkalloc
- argSpace = (TCHAR *)ckalloc(size * sizeof(char *)
+ argSpace = (TCHAR *)Tcl_Alloc(size * sizeof(char *)
+ (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
argv = (TCHAR **) argSpace;
argSpace += size * (sizeof(char *)/sizeof(TCHAR));
diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in
index 1c33246..c980af6 100644
--- a/win/tclConfig.sh.in
+++ b/win/tclConfig.sh.in
@@ -23,11 +23,6 @@ TCL_CC='@CC@'
# -D flags for use with the C compiler.
TCL_DEFS='@DEFS@'
-# TCL_DBGX used to be used to distinguish debug vs. non-debug builds.
-# This was a righteous pain so the core doesn't do that any more.
-# DEPRECATED, will be removed in Tcl 9!
-TCL_DBGX=''
-
# Default flags used in an optimized and debuggable build, respectively.
TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@'
TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@'
@@ -48,9 +43,6 @@ 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@'
@@ -87,7 +79,7 @@ TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@'
# Library file(s) to include in tclsh and other base applications
# in order to provide facilities needed by DLOBJ above.
-TCL_DL_LIBS='@DL_LIBS@'
+TCL_DL_LIBS=''
# Flags to pass to the compiler when linking object files into
# an executable tclsh or tcltest binary.
@@ -97,8 +89,8 @@ TCL_LD_FLAGS='@LDFLAGS@'
# run-time dynamic linker where to look for shared libraries such as
# libtcl.so. Used when linking applications. Only works if there
# is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
-TCL_CC_SEARCH_FLAGS='@TCL_CC_SEARCH_FLAGS@'
-TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'
+TCL_CC_SEARCH_FLAGS=''
+TCL_LD_SEARCH_FLAGS=''
# Additional object files linked with Tcl to provide compatibility
# with standard facilities from ANSI C or POSIX.
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 7c3d8a4..01fa6c3 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -144,7 +144,7 @@ DllMain(
*----------------------------------------------------------------------
*/
-HINSTANCE
+void *
TclWinGetTclInstance(void)
{
return hInstance;
@@ -247,8 +247,8 @@ TclWinEncodingsCleanup(void)
dlIter = driveLetterLookup;
while (dlIter != NULL) {
dlIter2 = dlIter->nextPtr;
- ckfree(dlIter->volumeName);
- ckfree(dlIter);
+ Tcl_Free(dlIter->volumeName);
+ Tcl_Free(dlIter);
dlIter = dlIter2;
}
Tcl_MutexUnlock(&mountPointMap);
@@ -341,8 +341,8 @@ TclWinDriveLetterForVolMountPoint(
* Now dlPtr2 points to the structure to free.
*/
- ckfree(dlPtr2->volumeName);
- ckfree(dlPtr2);
+ Tcl_Free(dlPtr2->volumeName);
+ Tcl_Free(dlPtr2);
/*
* Restart the loop - we could try to be clever and continue half
@@ -377,7 +377,7 @@ TclWinDriveLetterForVolMountPoint(
}
}
if (!alreadyStored) {
- dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap));
+ dlPtr2 = (MountPointMap *)Tcl_Alloc(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 *)ckalloc(sizeof(MountPointMap));
+ dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint);
dlPtr2->driveLetter = (WCHAR)-1;
dlPtr2->nextPtr = driveLetterLookup;
@@ -413,76 +413,6 @@ TclWinDriveLetterForVolMountPoint(
}
/*
- *---------------------------------------------------------------------------
- *
- * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
- *
- * Convert between UTF-8 and Unicode when running Windows.
- *
- * On Mac and Unix, all strings exchanged between Tcl and the OS are
- * "char" oriented. We need only one Tcl_Encoding to convert between
- * UTF-8 and the system's native encoding. We use NULL to represent
- * that encoding.
- *
- * On Windows, some strings exchanged between Tcl and the OS are "char"
- * oriented, while others are in Unicode. We need two Tcl_Encoding APIs
- * depending on whether we are targeting a "char" or Unicode interface.
- *
- * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding
- * of NULL should always used to convert between UTF-8 and the system's
- * "char" oriented encoding. The following two functions are used in
- * Windows-specific code to convert between UTF-8 and Unicode strings.
- * This saves you the trouble of writing the
- * following type of fragment over and over:
- *
- * encoding <- Tcl_GetEncoding("unicode");
- * nativeBuffer <- UtfToExternal(encoding, utfBuffer);
- * Tcl_FreeEncoding(encoding);
- *
- * By convention, in Windows a WCHAR is a Unicode character. If you plan
- * on targeting a Unicode interface when running on Windows, these
- * functions should be used. If you plan on targetting a "char" oriented
- * function on Windows, use Tcl_UtfToExternal() with an encoding of NULL.
- *
- * Results:
- * The result is a pointer to the string in the desired target encoding.
- * Storage for the result string is allocated in dsPtr; the caller must
- * call Tcl_DStringFree() when the result is no longer needed.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
-#undef Tcl_WinUtfToTChar
-TCHAR *
-Tcl_WinUtfToTChar(
- const char *string, /* Source string in UTF-8. */
- int len, /* Source string length in bytes, or -1 for
- * strlen(). */
- Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
- * converted string is stored. */
-{
- Tcl_DStringInit(dsPtr);
- return (TCHAR *)Tcl_UtfToWCharDString(string, len, dsPtr);
-}
-#undef Tcl_WinTCharToUtf
-char *
-Tcl_WinTCharToUtf(
- const TCHAR *string, /* Source string in Unicode. */
- int len, /* Source string length in bytes, or -1 for
- * platform-specific string length. */
- Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
- * converted string is stored. */
-{
- Tcl_DStringInit(dsPtr);
- return Tcl_WCharToUtfDString((WCHAR *)string, len >> 1, dsPtr);
-}
-#endif /* !defined(TCL_NO_DEPRECATED) */
-
-/*
*------------------------------------------------------------------------
*
* TclWinCPUID --
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 9285dcc..7b4caf0 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -72,33 +72,29 @@ typedef struct {
* Static routines for this file:
*/
-static int FileBlockProc(ClientData instanceData, int mode);
-static void FileChannelExitHandler(ClientData clientData);
-static void FileCheckProc(ClientData clientData, int flags);
-static int FileCloseProc(ClientData instanceData,
+static int FileBlockProc(void *instanceData, int mode);
+static void FileChannelExitHandler(void *clientData);
+static void FileCheckProc(void *clientData, int flags);
+static int FileCloseProc(void *instanceData,
Tcl_Interp *interp, int flags);
static int FileEventProc(Tcl_Event *evPtr, int flags);
-static int FileGetHandleProc(ClientData instanceData,
- int direction, ClientData *handlePtr);
+static int FileGetHandleProc(void *instanceData,
+ int direction, void **handlePtr);
static int FileGetOptionProc(ClientData instanceData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
static ThreadSpecificData *FileInit(void);
-static int FileInputProc(ClientData instanceData, char *buf,
+static int FileInputProc(void *instanceData, char *buf,
int toRead, int *errorCode);
-static int FileOutputProc(ClientData instanceData,
+static int FileOutputProc(void *instanceData,
const char *buf, int toWrite, int *errorCode);
-#ifndef TCL_NO_DEPRECATED
-static int FileSeekProc(ClientData instanceData, long offset,
- int mode, int *errorCode);
-#endif
-static long long FileWideSeekProc(ClientData instanceData,
+static long long FileWideSeekProc(void *instanceData,
long long offset, int mode, int *errorCode);
-static void FileSetupProc(ClientData clientData, int flags);
-static void FileWatchProc(ClientData instanceData, int mask);
-static void FileThreadActionProc(ClientData instanceData,
+static void FileSetupProc(void *clientData, int flags);
+static void FileWatchProc(void *instanceData, int mask);
+static void FileThreadActionProc(void *instanceData,
int action);
-static int FileTruncateProc(ClientData instanceData,
+static int FileTruncateProc(void *instanceData,
long long length);
static DWORD FileGetType(HANDLE handle);
static int NativeIsComPort(const WCHAR *nativeName);
@@ -112,14 +108,10 @@ static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName,
static const Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- TCL_CLOSE2PROC, /* Close proc. */
+ NULL, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
-#ifndef TCL_NO_DEPRECATED
- FileSeekProc, /* Seek proc. */
-#else
NULL,
-#endif
NULL, /* Set option proc. */
FileGetOptionProc, /* Get option proc. */
FileWatchProc, /* Set up the notifier to watch the channel. */
@@ -200,7 +192,7 @@ FileInit(void)
static void
FileChannelExitHandler(
- TCL_UNUSED(ClientData))
+ TCL_UNUSED(void *))
{
Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
}
@@ -224,7 +216,7 @@ FileChannelExitHandler(
void
FileSetupProc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
FileInfo *infoPtr;
@@ -267,7 +259,7 @@ FileSetupProc(
static void
FileCheckProc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
FileEvent *evPtr;
@@ -287,7 +279,7 @@ FileCheckProc(
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) {
SET_FLAG(infoPtr->flags, FILE_PENDING);
- evPtr = (FileEvent *)ckalloc(sizeof(FileEvent));
+ evPtr = (FileEvent *)Tcl_Alloc(sizeof(FileEvent));
evPtr->header.proc = FileEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -366,7 +358,7 @@ FileEventProc(
static int
FileBlockProc(
- ClientData instanceData, /* Instance data for channel. */
+ void *instanceData, /* Instance data for channel. */
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
@@ -405,7 +397,7 @@ FileBlockProc(
static int
FileCloseProc(
- ClientData instanceData, /* Pointer to FileInfo structure. */
+ void *instanceData, /* Pointer to FileInfo structure. */
TCL_UNUSED(Tcl_Interp *),
int flags)
{
@@ -459,92 +451,13 @@ FileCloseProc(
break;
}
}
- ckfree(fileInfoPtr);
+ Tcl_Free(fileInfoPtr);
return errorCode;
}
/*
*----------------------------------------------------------------------
*
- * FileSeekProc --
- *
- * Seeks on a file-based channel. Returns the new position.
- *
- * Results:
- * -1 if failed, the new position if successful. If failed, it also sets
- * *errorCodePtr to the error code.
- *
- * Side effects:
- * Moves the location at which the channel will be accessed in future
- * operations.
- *
- *----------------------------------------------------------------------
- */
-#ifndef TCL_NO_DEPRECATED
-static int
-FileSeekProc(
- ClientData instanceData, /* File state. */
- long offset, /* Offset to seek to. */
- int mode, /* Relative to where should we seek? */
- int *errorCodePtr) /* To store error code. */
-{
- FileInfo *infoPtr = (FileInfo *)instanceData;
- LONG newPos, newPosHigh, oldPos, oldPosHigh;
- DWORD moveMethod;
-
- *errorCodePtr = 0;
- if (mode == SEEK_SET) {
- moveMethod = FILE_BEGIN;
- } else if (mode == SEEK_CUR) {
- moveMethod = FILE_CURRENT;
- } else {
- moveMethod = FILE_END;
- }
-
- /*
- * Save our current place in case we need to roll-back the seek.
- */
-
- oldPosHigh = 0;
- oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
- if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
- DWORD winError = GetLastError();
-
- if (winError != NO_ERROR) {
- Tcl_WinConvertError(winError);
- *errorCodePtr = errno;
- return -1;
- }
- }
-
- newPosHigh = (offset < 0 ? -1 : 0);
- newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
- if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
- DWORD winError = GetLastError();
-
- if (winError != NO_ERROR) {
- Tcl_WinConvertError(winError);
- *errorCodePtr = errno;
- return -1;
- }
- }
-
- /*
- * Check for expressability in our return type, and roll-back otherwise.
- */
-
- if (newPosHigh != 0) {
- *errorCodePtr = EOVERFLOW;
- SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN);
- return -1;
- }
- return (int) newPos;
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
* FileWideSeekProc --
*
* Seeks on a file-based channel. Returns the new position.
@@ -562,7 +475,7 @@ FileSeekProc(
static long long
FileWideSeekProc(
- ClientData instanceData, /* File state. */
+ void *instanceData, /* File state. */
long long offset, /* Offset to seek to. */
int mode, /* Relative to where should we seek? */
int *errorCodePtr) /* To store error code. */
@@ -614,7 +527,7 @@ FileWideSeekProc(
static int
FileTruncateProc(
- ClientData instanceData, /* File state. */
+ void *instanceData, /* File state. */
long long length) /* Length to truncate at. */
{
FileInfo *infoPtr = (FileInfo *)instanceData;
@@ -690,7 +603,7 @@ FileTruncateProc(
static int
FileInputProc(
- ClientData instanceData, /* File state. */
+ void *instanceData, /* File state. */
char *buf, /* Where to store data read. */
int bufSize, /* Num bytes available in buffer. */
int *errorCode) /* Where to store error code. */
@@ -745,7 +658,7 @@ FileInputProc(
static int
FileOutputProc(
- ClientData instanceData, /* File state. */
+ void *instanceData, /* File state. */
const char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
@@ -792,7 +705,7 @@ FileOutputProc(
static void
FileWatchProc(
- ClientData instanceData, /* File state. */
+ void *instanceData, /* File state. */
int mask) /* What events to watch for; OR-ed combination
* of TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION. */
@@ -831,9 +744,9 @@ FileWatchProc(
static int
FileGetHandleProc(
- ClientData instanceData, /* The file state. */
+ void *instanceData, /* The file state. */
int direction, /* TCL_READABLE or TCL_WRITABLE */
- ClientData *handlePtr) /* Where to store the handle. */
+ void **handlePtr) /* Where to store the handle. */
{
FileInfo *infoPtr = (FileInfo *)instanceData;
@@ -841,7 +754,7 @@ FileGetHandleProc(
return TCL_ERROR;
}
- *handlePtr = (ClientData) infoPtr->handle;
+ *handlePtr = (void *) infoPtr->handle;
return TCL_OK;
}
@@ -1279,7 +1192,7 @@ TclpOpenFileChannel(
Tcl_Channel
Tcl_MakeFileChannel(
- ClientData rawHandle, /* OS level handle */
+ void *rawHandle, /* OS level handle */
int mode) /* OR'ed combination of TCL_READABLE and
* TCL_WRITABLE to indicate file mode. */
{
@@ -1528,9 +1441,8 @@ 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_Close(NULL, channel);
+ Tcl_CloseEx(NULL, channel, 0);
return (Tcl_Channel) NULL;
}
return channel;
@@ -1580,7 +1492,7 @@ OpenFileChannel(
}
}
- infoPtr = (FileInfo *)ckalloc(sizeof(FileInfo));
+ infoPtr = (FileInfo *)Tcl_Alloc(sizeof(FileInfo));
/*
* TIP #218. Removed the code inserting the new structure into the global
@@ -1605,7 +1517,6 @@ OpenFileChannel(
*/
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}");
return infoPtr->channel;
}
@@ -1667,7 +1578,7 @@ TclWinFlushDirtyChannels(void)
static void
FileThreadActionProc(
- ClientData instanceData,
+ void *instanceData,
int action)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index bf5da4d..62a2a36 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -203,29 +203,29 @@ typedef struct {
* Declarations for functions used only in this file.
*/
-static int ConsoleBlockModeProc(ClientData instanceData, int mode);
-static void ConsoleCheckProc(ClientData clientData, int flags);
-static int ConsoleCloseProc(ClientData instanceData,
+static int ConsoleBlockModeProc(void *instanceData, int mode);
+static void ConsoleCheckProc(void *clientData, int flags);
+static int ConsoleCloseProc(void *instanceData,
Tcl_Interp *interp, int flags);
static int ConsoleEventProc(Tcl_Event *evPtr, int flags);
-static void ConsoleExitHandler(ClientData clientData);
-static int ConsoleGetHandleProc(ClientData instanceData,
- int direction, ClientData *handlePtr);
-static int ConsoleGetOptionProc(ClientData instanceData,
+static void ConsoleExitHandler(void *clientData);
+static int ConsoleGetHandleProc(void *instanceData,
+ int direction, void **handlePtr);
+static int ConsoleGetOptionProc(void *instanceData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
static void ConsoleInit(void);
-static int ConsoleInputProc(ClientData instanceData, char *buf,
+static int ConsoleInputProc(void *instanceData, char *buf,
int toRead, int *errorCode);
-static int ConsoleOutputProc(ClientData instanceData,
+static int ConsoleOutputProc(void *instanceData,
const char *buf, int toWrite, int *errorCode);
-static int ConsoleSetOptionProc(ClientData instanceData,
+static int ConsoleSetOptionProc(void *instanceData,
Tcl_Interp *interp, const char *optionName,
const char *value);
-static void ConsoleSetupProc(ClientData clientData, int flags);
-static void ConsoleWatchProc(ClientData instanceData, int mask);
-static void ProcExitHandler(ClientData clientData);
-static void ConsoleThreadActionProc(ClientData instanceData, int action);
+static void ConsoleSetupProc(void *clientData, int flags);
+static void ConsoleWatchProc(void *instanceData, int mask);
+static void ProcExitHandler(void *clientData);
+static void ConsoleThreadActionProc(void *instanceData, int action);
static DWORD ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer,
Tcl_Size nChars, Tcl_Size *nCharsReadPtr);
static DWORD WriteConsoleChars(HANDLE hConsole,
@@ -291,7 +291,7 @@ static ConsoleChannelInfo *gWatchingChannelList;
static const Tcl_ChannelType consoleChannelType = {
"console", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- TCL_CLOSE2PROC, /* Close proc. */
+ NULL, /* Close proc. */
ConsoleInputProc, /* Input proc. */
ConsoleOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -329,7 +329,7 @@ RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity)
if (capacity <= 0 || capacity > TCL_SIZE_MAX) {
Tcl_Panic("Internal error: invalid ring buffer capacity requested.");
}
- ringPtr->bufPtr = (char *)ckalloc(capacity);
+ ringPtr->bufPtr = (char *)Tcl_Alloc(capacity);
ringPtr->capacity = capacity;
ringPtr->start = 0;
ringPtr->length = 0;
@@ -354,7 +354,7 @@ static void
RingBufferClear(RingBuffer *ringPtr)
{
if (ringPtr->bufPtr) {
- ckfree(ringPtr->bufPtr);
+ Tcl_Free(ringPtr->bufPtr);
ringPtr->bufPtr = NULL;
}
ringPtr->capacity = 0;
@@ -663,7 +663,7 @@ ConsoleInit(void)
static void
ConsoleExitHandler(
- TCL_UNUSED(ClientData))
+ TCL_UNUSED(void *))
{
Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
}
@@ -687,7 +687,7 @@ ConsoleExitHandler(
static void
ProcExitHandler(
- TCL_UNUSED(ClientData))
+ TCL_UNUSED(void *))
{
AcquireSRWLockExclusive(&gConsoleLock);
gInitialized = 0;
@@ -752,7 +752,7 @@ void NudgeWatchers (HANDLE consoleHandle)
void
ConsoleSetupProc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
ConsoleChannelInfo *chanInfoPtr;
@@ -817,7 +817,7 @@ ConsoleSetupProc(
static void
ConsoleCheckProc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
ConsoleChannelInfo *chanInfoPtr;
@@ -883,7 +883,7 @@ ConsoleCheckProc(
ReleaseSRWLockShared(&handleInfoPtr->lock);
if (needEvent) {
- ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent));
+ ConsoleEvent *evPtr = (ConsoleEvent *)Tcl_Alloc(sizeof(ConsoleEvent));
/* See note above loop why this can be accessed without locks */
chanInfoPtr->flags |= CONSOLE_EVENT_QUEUED;
@@ -916,7 +916,7 @@ ConsoleCheckProc(
static int
ConsoleBlockModeProc(
- ClientData instanceData, /* Instance data for channel. */
+ void *instanceData, /* Instance data for channel. */
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
@@ -956,7 +956,7 @@ ConsoleBlockModeProc(
static int
ConsoleCloseProc(
- ClientData instanceData, /* Pointer to ConsoleChannelInfo structure. */
+ void *instanceData, /* Pointer to ConsoleChannelInfo structure. */
TCL_UNUSED(Tcl_Interp *),
int flags)
{
@@ -1050,7 +1050,7 @@ ConsoleCloseProc(
/* There may be references already on the event queue */
chanInfoPtr->numRefs -= 1;
} else {
- ckfree(chanInfoPtr);
+ Tcl_Free(chanInfoPtr);
}
return errorCode;
@@ -1075,7 +1075,7 @@ ConsoleCloseProc(
*/
static int
ConsoleInputProc(
- ClientData instanceData, /* Console state. */
+ void *instanceData, /* Console state. */
char *bufPtr, /* Where to store data read. */
int bufSize, /* How much space is available in the
* buffer? */
@@ -1149,7 +1149,7 @@ ConsoleInputProc(
* reader thread which handles these case rather than dealing with
* them here (which is a little trickier than it might sound.)
*/
- if ((1 & (ptrdiff_t)bufPtr) == 0 /* aligned buffer */
+ if ((1 & (size_t)bufPtr) == 0 /* aligned buffer */
&& bufSize > 1 /* Not single byte read */
) {
DWORD lastError;
@@ -1228,7 +1228,7 @@ ConsoleInputProc(
*/
static int
ConsoleOutputProc(
- ClientData instanceData, /* Console state. */
+ void *instanceData, /* Console state. */
const char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
@@ -1444,7 +1444,7 @@ ConsoleEventProc(
}
if (freeChannel) {
- ckfree(chanInfoPtr);
+ Tcl_Free(chanInfoPtr);
}
return 1;
@@ -1468,7 +1468,7 @@ ConsoleEventProc(
static void
ConsoleWatchProc(
- ClientData instanceData, /* Console state. */
+ void *instanceData, /* Console state. */
int newMask) /* What events to watch for, one of
* of TCL_READABLE, TCL_WRITABLE
*/
@@ -1544,9 +1544,9 @@ ConsoleWatchProc(
static int
ConsoleGetHandleProc(
- ClientData instanceData, /* The console state. */
+ void *instanceData, /* The console state. */
TCL_UNUSED(int) /*direction*/,
- ClientData *handlePtr) /* Where to store the handle. */
+ void **handlePtr) /* Where to store the handle. */
{
ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
@@ -1799,7 +1799,7 @@ ConsoleReaderThread(
*/
}
- ckfree(handleInfoPtr);
+ Tcl_Free(handleInfoPtr);
return 0;
}
@@ -1957,7 +1957,7 @@ ConsoleWriterThread(LPVOID arg)
RingBufferClear(&handleInfoPtr->buffer);
- ckfree(handleInfoPtr);
+ Tcl_Free(handleInfoPtr);
return 0;
}
@@ -1994,7 +1994,8 @@ AllocateConsoleHandleInfo(
DWORD consoleMode;
- handleInfoPtr = (ConsoleHandleInfo *)ckalloc(sizeof(*handleInfoPtr));
+ handleInfoPtr = (ConsoleHandleInfo *)Tcl_Alloc(sizeof(*handleInfoPtr));
+ memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));
memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));
handleInfoPtr->console = consoleHandle;
InitializeSRWLock(&handleInfoPtr->lock);
@@ -2021,7 +2022,7 @@ AllocateConsoleHandleInfo(
if (handleInfoPtr->consoleThread == NULL) {
/* Note - SRWLock and condition variables do not need finalization */
RingBufferClear(&handleInfoPtr->buffer);
- ckfree(handleInfoPtr);
+ Tcl_Free(handleInfoPtr);
return NULL;
}
@@ -2100,7 +2101,7 @@ TclWinOpenConsoleChannel(
ConsoleInit();
- chanInfoPtr = (ConsoleChannelInfo *)ckalloc(sizeof(*chanInfoPtr));
+ chanInfoPtr = (ConsoleChannelInfo *)Tcl_Alloc(sizeof(*chanInfoPtr));
memset(chanInfoPtr, 0, sizeof(*chanInfoPtr));
chanInfoPtr->permissions = permissions;
@@ -2159,7 +2160,7 @@ TclWinOpenConsoleChannel(
if (permissions == TCL_READABLE) {
SetConsoleMode(handle, chanInfoPtr->initMode);
}
- ckfree(chanInfoPtr);
+ Tcl_Free(chanInfoPtr);
return NULL;
}
@@ -2191,7 +2192,6 @@ 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;
}
@@ -2214,7 +2214,7 @@ TclWinOpenConsoleChannel(
static void
ConsoleThreadActionProc(
- ClientData instanceData,
+ void *instanceData,
int action)
{
ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
@@ -2247,7 +2247,7 @@ ConsoleThreadActionProc(
*/
static int
ConsoleSetOptionProc(
- ClientData instanceData, /* File state. */
+ void *instanceData, /* File state. */
Tcl_Interp *interp, /* For error reporting - can be NULL. */
const char *optionName, /* Which option to set? */
const char *value) /* New value for option. */
@@ -2336,7 +2336,7 @@ ConsoleSetOptionProc(
static int
ConsoleGetOptionProc(
- ClientData instanceData, /* File state. */
+ void *instanceData, /* File state. */
Tcl_Interp *interp, /* For error reporting - can be NULL. */
const char *optionName, /* Option to get. */
Tcl_DString *dsPtr) /* Where to store value(s). */
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 7db5312..d883bac 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -90,8 +90,24 @@ static int ddeIsServer = 0;
TCL_DECLARE_MUTEX(ddeMutex)
+#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
+# if TCL_UTF_MAX > 3
+# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
+# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
+# else
+# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
+# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
+# endif
+#ifndef Tcl_Size
+# define Tcl_Size int
+#endif
+#ifndef Tcl_CreateObjCommand2
+# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand
+#endif
+#endif
+
/*
- * Forward declarations for functions defined later in this file.
+ * Declarations for functions defined in this file.
*/
static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg,
@@ -114,28 +130,16 @@ static int MakeDdeConnection(Tcl_Interp *interp,
const WCHAR *name, HCONV *ddeConvPtr);
static void SetDdeError(Tcl_Interp *interp);
static int DdeObjCmd(void *clientData,
- Tcl_Interp *interp, int objc,
+ Tcl_Interp *interp, Tcl_Size objc,
Tcl_Obj *const objv[]);
-#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
-# if TCL_UTF_MAX > 3
-# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
-# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
-# else
-# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
-# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
-# endif
-#define Tcl_Size int
-#define TCL_INDEX_NONE -1
-#endif
-
#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int Dde_Init(Tcl_Interp *interp);
DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp);
#if TCL_MAJOR_VERSION < 9
-/* With those additional entries, "load dde14.dll" works without 3th argument */
+/* With those additional entries, "load tcldde14.dll" works without 3th argument */
DLLEXPORT int Tcldde_Init(Tcl_Interp *interp);
DLLEXPORT int Tcldde_SafeInit(Tcl_Interp *interp);
#endif
@@ -167,7 +171,7 @@ Dde_Init(
return TCL_ERROR;
}
- Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd, NULL, NULL);
Tcl_CreateExitHandler(DdeExitProc, NULL);
return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL);
}
@@ -415,7 +419,7 @@ DdeSetServerName(
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
Tcl_DStringInit(&ds);
- Tcl_UtfToWCharDString(Tcl_GetString(namePtr), TCL_INDEX_NONE, &ds);
+ Tcl_UtfToWCharDString(Tcl_GetString(namePtr), -1, &ds);
if (wcscmp(actualName, (WCHAR *)Tcl_DStringValue(&ds)) == 0) {
suffix++;
Tcl_DStringFree(&ds);
@@ -445,7 +449,7 @@ DdeSetServerName(
Tcl_ExposeCommand(interp, "dde", "dde");
}
- Tcl_CreateObjCommand(interp, "dde", DdeObjCmd,
+ Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd,
riPtr, DeleteProc);
if (Tcl_IsSafe(interp)) {
Tcl_HideCommand(interp, "dde", "dde");
@@ -573,7 +577,7 @@ ExecuteRemoteObject(
if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) {
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
"a handler procedure must be defined for use in a safe "
- "interp", TCL_INDEX_NONE));
+ "interp", -1));
Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", (void *)NULL);
result = TCL_ERROR;
}
@@ -855,7 +859,7 @@ DdeServerProc(
Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds2);
utilString = (WCHAR *) Tcl_DStringValue(&ds2);
}
- variableObjPtr = Tcl_NewStringObj((char *)utilString, TCL_INDEX_NONE);
+ variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
variableObjPtr, TCL_GLOBAL_ONLY);
@@ -1153,12 +1157,12 @@ DdeServicesOnAck(
GlobalGetAtomNameW(service, sz, 255);
Tcl_DStringInit(&dString);
Tcl_WCharToUtfDString(sz, wcslen(sz), &dString);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), TCL_INDEX_NONE));
+ Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
Tcl_DStringFree(&dString);
GlobalGetAtomNameW(topic, sz, 255);
Tcl_DStringInit(&dString);
Tcl_WCharToUtfDString(sz, wcslen(sz), &dString);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), TCL_INDEX_NONE));
+ Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
Tcl_DStringFree(&dString);
/*
@@ -1276,7 +1280,7 @@ SetDdeError(
errorCode = "FAILED";
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, TCL_INDEX_NONE));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1));
Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, (void *)NULL);
}
@@ -1301,7 +1305,7 @@ static int
DdeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* The interp we are sending from */
- int objc, /* Number of arguments */
+ Tcl_Size objc, /* Number of arguments */
Tcl_Obj *const *objv) /* The arguments */
{
static const char *const ddeCommands[] = {
@@ -1329,8 +1333,8 @@ DdeObjCmd(
"-binary", NULL
};
- int index, i, argIndex;
- Tcl_Size length;
+ int index, argIndex;
+ Tcl_Size length, i;
int flags = 0, result = TCL_OK, firstArg = 0;
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
@@ -1562,7 +1566,7 @@ DdeObjCmd(
if (dataLength + 1 < 2) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("cannot execute null data", TCL_INDEX_NONE));
+ Tcl_NewStringObj("cannot execute null data", -1));
Tcl_DStringFree(&dsBuf);
Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL);
result = TCL_ERROR;
@@ -1613,7 +1617,7 @@ DdeObjCmd(
if (length == 0) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("cannot request value of null data", TCL_INDEX_NONE));
+ Tcl_NewStringObj("cannot request value of null data", -1));
Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL);
result = TCL_ERROR;
goto cleanup;
@@ -1679,7 +1683,7 @@ DdeObjCmd(
length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR);
if (length == 0) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("cannot have a null item", TCL_INDEX_NONE));
+ Tcl_NewStringObj("cannot have a null item", -1));
Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL);
result = TCL_ERROR;
goto cleanup;
@@ -1733,7 +1737,7 @@ DdeObjCmd(
if (serviceName == NULL) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("invalid service name \"\"", TCL_INDEX_NONE));
+ Tcl_NewStringObj("invalid service name \"\"", -1));
Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (void *)NULL);
result = TCL_ERROR;
goto cleanup;
@@ -1781,7 +1785,7 @@ DdeObjCmd(
if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) {
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
"permission denied: a handler procedure must be"
- " defined for use in a safe interp", TCL_INDEX_NONE));
+ " defined for use in a safe interp", -1));
Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
(void *)NULL);
result = TCL_ERROR;
@@ -1847,7 +1851,7 @@ DdeObjCmd(
if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
invalidServerResponse:
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("invalid data returned from server", TCL_INDEX_NONE));
+ Tcl_NewStringObj("invalid data returned from server", -1));
Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", (void *)NULL);
result = TCL_ERROR;
goto cleanup;
diff --git a/win/tclWinError.c b/win/tclWinError.c
index 7e5898b..3e75a85 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -351,9 +351,9 @@ void
Tcl_WinConvertError(
unsigned errCode) /* Win32 error code. */
{
- if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
+ if ((unsigned)errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
errCode -= WSAEWOULDBLOCK;
- if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
+ if ((unsigned)errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
Tcl_SetErrno(errorTable[1]);
} else {
Tcl_SetErrno(wsaErrorTable[errCode]);
@@ -381,7 +381,7 @@ Tcl_WinConvertError(
*----------------------------------------------------------------------
*/
-TCL_NORETURN void
+void
tclWinDebugPanic(
const char *format, ...)
{
@@ -413,12 +413,6 @@ tclWinDebugPanic(
fprintf(stderr, "\n");
fflush(stderr);
}
-# if defined(__GNUC__)
- __builtin_trap();
-# else
- DebugBreak();
-# endif
- abort();
}
#endif
/*
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index e02f6d6..4cb23ea 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -309,7 +309,8 @@ DoRenameFile(
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
WCHAR *nativeSrcRest, *nativeDstRest;
const char **srcArgv, **dstArgv;
- Tcl_Size size, srcArgc, dstArgc;
+ size_t size;
+ Tcl_Size srcArgc, dstArgc;
WCHAR nativeSrcPath[MAX_PATH];
WCHAR nativeDstPath[MAX_PATH];
Tcl_DString srcString, dstString;
@@ -317,7 +318,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,
@@ -378,8 +379,8 @@ DoRenameFile(
Tcl_SetErrno(EXDEV);
}
- ckfree(srcArgv);
- ckfree(dstArgv);
+ Tcl_Free((void *)srcArgv);
+ Tcl_Free((void *)dstArgv);
}
/*
@@ -1536,7 +1537,7 @@ GetWinFileAttributes(
*/
Tcl_Size len;
- const char *str = TclGetStringFromObj(fileName, &len);
+ const char *str = Tcl_GetStringFromObj(fileName, &len);
if (len < 4) {
if (len == 0) {
@@ -1604,7 +1605,7 @@ ConvertFileNameFormat(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not read \"%s\": no such file or directory",
- Tcl_GetString(fileName)));
+ TclGetString(fileName)));
errno = ENOENT;
Tcl_PosixError(interp);
}
@@ -1624,7 +1625,7 @@ ConvertFileNameFormat(
Tcl_ListObjIndex(NULL, splitPath, i, &elt);
- pathv = TclGetStringFromObj(elt, &length);
+ pathv = Tcl_GetStringFromObj(elt, &length);
if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':'))
|| (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) {
/*
@@ -1660,7 +1661,7 @@ ConvertFileNameFormat(
* likely to lead to infinite loops.
*/
- tempString = TclGetStringFromObj(tempPath, &length);
+ tempString = Tcl_GetStringFromObj(tempPath, &length);
Tcl_DStringInit(&ds);
nativeName = Tcl_UtfToWCharDString(tempString, length, &ds);
Tcl_DecrRefCount(tempPath);
@@ -1714,19 +1715,8 @@ ConvertFileNameFormat(
Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp);
Tcl_DStringFree(&ds);
- /*
- * Deal with issues of tildes being absolute.
- */
-
- if (Tcl_DStringValue(&dsTemp)[0] == '~') {
- TclNewLiteralStringObj(tempPath, "./");
- Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
- Tcl_DStringLength(&dsTemp));
- Tcl_DStringFree(&dsTemp);
- } else {
- tempPath = Tcl_DStringToObj(&dsTemp);
- }
- Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
+ tempPath = Tcl_DStringToObj(&dsTemp);
+ Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
FindClose(handle);
}
}
@@ -1895,7 +1885,7 @@ CannotSetAttribute(
{
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
- tclpFileAttrStrings[objIndex], Tcl_GetString(fileName)));
+ tclpFileAttrStrings[objIndex], TclGetString(fileName)));
errno = EINVAL;
Tcl_PosixError(interp);
return TCL_ERROR;
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 5e47098..c0dd4fd 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -149,8 +149,8 @@ typedef struct {
* Other typedefs required by this code.
*/
-static time_t ToCTime(FILETIME fileTime);
-static void FromCTime(time_t posixTime, FILETIME *fileTime);
+static __time64_t ToCTime(FILETIME fileTime);
+static void FromCTime(__time64_t posixTime, FILETIME *fileTime);
/*
* Declarations for local functions defined in this file:
@@ -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 TCL_NORETURN void tclWinDebugPanic(const char *format, ...);
+MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
/*
*--------------------------------------------------------------------
@@ -808,7 +808,7 @@ NativeWriteReparse(
*----------------------------------------------------------------------
*/
-TCL_NORETURN void
+void
tclWinDebugPanic(
const char *format, ...)
{
@@ -838,16 +838,6 @@ tclWinDebugPanic(
MessageBoxW(NULL, msgString, L"Fatal Error",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
}
-#if defined(__GNUC__)
- __builtin_trap();
-#elif defined(_WIN64)
- __debugbreak();
-#elif defined(_MSC_VER) && defined (_M_IX86)
- _asm {int 3}
-#else
- DebugBreak();
-#endif
- abort();
}
/*
@@ -874,16 +864,7 @@ TclpFindExecutable(
{
WCHAR wName[MAX_PATH];
char name[MAX_PATH * 3];
-
- /*
- * Under Windows we ignore argv0, and return the path for the file used to
- * create this process. Only if it is NULL, install a new panic handler.
- */
-
- if (argv0 == NULL) {
-# undef Tcl_SetPanicProc
- Tcl_SetPanicProc(tclWinDebugPanic);
- }
+ (void)argv0;
GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(WCHAR));
WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
@@ -941,7 +922,7 @@ TclpMatchInDirectory(
DWORD attr;
WIN32_FILE_ATTRIBUTE_DATA data;
Tcl_Size len = 0;
- const char *str = TclGetStringFromObj(norm, &len);
+ const char *str = Tcl_GetStringFromObj(norm, &len);
native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
@@ -1001,7 +982,7 @@ TclpMatchInDirectory(
*/
Tcl_DStringInit(&dsOrig);
- dirName = TclGetStringFromObj(fileNamePtr, &dirLength);
+ dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
Tcl_DStringAppend(&dsOrig, dirName, dirLength);
lastChar = dirName[dirLength -1];
@@ -2288,7 +2269,7 @@ NativeStatMode(
*
* ToCTime --
*
- * Converts a Windows FILETIME to a time_t in UTC.
+ * Converts a Windows FILETIME to a __time64_t in UTC.
*
* Results:
* Returns the count of seconds from the Posix epoch.
@@ -2296,7 +2277,7 @@ NativeStatMode(
*------------------------------------------------------------------------
*/
-static time_t
+static __time64_t
ToCTime(
FILETIME fileTime) /* UTC time */
{
@@ -2305,7 +2286,7 @@ ToCTime(
convertedTime.LowPart = fileTime.dwLowDateTime;
convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;
- return (time_t) ((convertedTime.QuadPart -
+ return (__time64_t) ((convertedTime.QuadPart -
(long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000);
}
@@ -2314,7 +2295,7 @@ ToCTime(
*
* FromCTime --
*
- * Converts a time_t to a Windows FILETIME
+ * Converts a __time64_t to a Windows FILETIME
*
* Results:
* Returns the count of 100-ns ticks seconds from the Windows epoch.
@@ -2324,7 +2305,7 @@ ToCTime(
static void
FromCTime(
- time_t posixTime,
+ __time64_t posixTime,
FILETIME *fileTime) /* UTC Time */
{
LARGE_INTEGER convertedTime;
@@ -2471,7 +2452,7 @@ TclpFilesystemPathType(
if (normPath == NULL) {
return NULL;
}
- path = Tcl_GetString(normPath);
+ path = TclGetString(normPath);
if (path == NULL) {
return NULL;
}
@@ -2551,7 +2532,7 @@ TclpObjNormalizePath(
Tcl_DString ds; /* Some workspace. */
Tcl_DStringInit(&dsNorm);
- path = Tcl_GetString(pathPtr);
+ path = TclGetString(pathPtr);
currentPathEndPosition = path + nextCheckpoint;
if (*currentPathEndPosition == '/') {
@@ -2649,12 +2630,12 @@ TclpObjNormalizePath(
* Convert link to forward slashes.
*/
- for (path = Tcl_GetString(to); *path != 0; path++) {
+ for (path = TclGetString(to); *path != 0; path++) {
if (*path == '\\') {
*path = '/';
}
}
- path = Tcl_GetString(to);
+ path = TclGetString(to);
currentPathEndPosition = path + nextCheckpoint;
if (temp != NULL) {
Tcl_DecrRefCount(temp);
@@ -2820,7 +2801,7 @@ TclpObjNormalizePath(
tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
nextCheckpoint);
Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, TCL_INDEX_NONE);
- path = TclGetStringFromObj(tmpPathPtr, &len);
+ path = Tcl_GetStringFromObj(tmpPathPtr, &len);
Tcl_SetStringObj(pathPtr, path, len);
Tcl_DecrRefCount(tmpPathPtr);
} else {
@@ -2889,7 +2870,7 @@ TclWinVolumeRelativeNormalize(
* current volume.
*/
- const char *drive = Tcl_GetString(useThisCwd);
+ const char *drive = TclGetString(useThisCwd);
absolutePath = Tcl_NewStringObj(drive,2);
Tcl_AppendToObj(absolutePath, path, TCL_INDEX_NONE);
@@ -2905,7 +2886,7 @@ TclWinVolumeRelativeNormalize(
*/
Tcl_Size cwdLen;
- const char *drive = TclGetStringFromObj(useThisCwd, &cwdLen);
+ const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen);
char drive_cur = path[0];
if (drive_cur >= 'a') {
@@ -2978,7 +2959,7 @@ TclpNativeToNormalized(
{
Tcl_DString ds;
Tcl_Obj *objPtr;
- Tcl_Size len;
+ size_t len;
char *copy, *p;
Tcl_DStringInit(&ds);
@@ -3078,7 +3059,7 @@ TclNativeCreateNativeRep(
Tcl_IncrRefCount(validPathPtr);
}
- str = TclGetStringFromObj(validPathPtr, &len);
+ str = Tcl_GetStringFromObj(validPathPtr, &len);
if (strlen(str) != (size_t)len) {
/*
@@ -3109,7 +3090,7 @@ TclNativeCreateNativeRep(
* Overallocate 6 chars, making some room for extended paths
*/
- wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR));
+ wp = nativePathPtr = (WCHAR *)Tcl_Alloc((len + 6) * sizeof(WCHAR));
if (nativePathPtr==0) {
goto done;
}
@@ -3208,7 +3189,7 @@ TclNativeDupInternalRep(
len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1);
- copy = (char *)ckalloc(len);
+ copy = (char *)Tcl_Alloc(len);
memcpy(copy, clientData, len);
return copy;
}
@@ -3324,7 +3305,7 @@ TclWinFileOwned(
bufsz = 0;
GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
if (bufsz) {
- buf = (LPBYTE)ckalloc(bufsz);
+ buf = (LPBYTE)Tcl_Alloc(bufsz);
if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) {
owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid);
}
@@ -3340,7 +3321,7 @@ TclWinFileOwned(
LocalFree(secd); /* Also frees ownerSid */
}
if (buf) {
- ckfree(buf);
+ Tcl_Free(buf);
}
return (owned != 0); /* Convert non-0 to 1 */
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 01714f0..b506111 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -124,7 +124,7 @@ TclpInitPlatform(void)
void
TclpInitLibraryPath(
char **valuePtr,
- TCL_HASH_TYPE *lengthPtr,
+ size_t *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 64
@@ -167,9 +167,9 @@ TclpInitLibraryPath(
TclGetProcessGlobalValue(&sourceLibraryDir));
*encodingPtr = NULL;
- bytes = TclGetStringFromObj(pathPtr, &length);
+ bytes = Tcl_GetStringFromObj(pathPtr, &length);
*lengthPtr = length++;
- *valuePtr = (char *)ckalloc(length);
+ *valuePtr = (char *)Tcl_Alloc(length);
memcpy(*valuePtr, bytes, length);
Tcl_DecrRefCount(pathPtr);
}
@@ -260,7 +260,7 @@ AppendEnvironment(
objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE);
}
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- ckfree(pathv);
+ Tcl_Free((void *)pathv);
}
}
@@ -284,7 +284,7 @@ AppendEnvironment(
static void
InitializeDefaultLibraryDir(
char **valuePtr,
- TCL_HASH_TYPE *lengthPtr,
+ size_t *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 *)ckalloc(*lengthPtr + 1);
+ *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
*encodingPtr = NULL;
memcpy(*valuePtr, name, *lengthPtr + 1);
}
@@ -332,7 +332,7 @@ InitializeDefaultLibraryDir(
static void
InitializeSourceLibraryDir(
char **valuePtr,
- TCL_HASH_TYPE *lengthPtr,
+ size_t *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 *)ckalloc(*lengthPtr + 1);
+ *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
*encodingPtr = NULL;
memcpy(*valuePtr, name, *lengthPtr + 1);
}
@@ -496,20 +496,6 @@ TclpSetVariables(
TCL_GLOBAL_ONLY);
}
-#if !defined(NDEBUG) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
-
- /*
- * The existence of the "debug" element of the tcl_platform array
- * indicates that this particular Tcl shell has been compiled with debug
- * information. Using "info exists tcl_platform(debug)" a Tcl script can
- * direct the interpreter to load debug versions of DLLs with the load
- * command.
- */
-
- Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
- TCL_GLOBAL_ONLY);
-#endif
-
/*
* Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
* environment variables, if necessary.
@@ -569,9 +555,10 @@ TclpSetVariables(
*
* Results:
* The return value is the index in environ of an entry with the name
- * "name", or -1 if there is no such entry. The integer at *lengthPtr is
- * filled in with the length of name (if a matching entry is found) or
- * the length of the environ array (if no matching entry is found).
+ * "name", or -1 if there is no such entry. The integer
+ * at *lengthPtr is filled in with the length of name (if a matching
+ * entry is found) or the length of the environ array (if no
+ * matching entry is found).
*
* Side effects:
* None.
@@ -599,7 +586,7 @@ TclpFindVariable(
*/
length = strlen(name);
- nameUpper = (char *)ckalloc(length + 1);
+ nameUpper = (char *)Tcl_Alloc(length + 1);
memcpy(nameUpper, name, length+1);
Tcl_UtfToUpper(nameUpper);
@@ -641,7 +628,7 @@ TclpFindVariable(
done:
Tcl_DStringFree(&envString);
- ckfree(nameUpper);
+ Tcl_Free(nameUpper);
return result;
}
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index d5cf7b0..1267f3f 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -79,7 +79,7 @@ typedef struct TclPipeThreadInfo {
} TclPipeThreadInfo;
-/* If pipe-workers will use some tcl subsystem, we can use ckalloc without
+/* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without
* more overhead for finalize thread (should be executed anyway)
*
* #define _PTI_USE_CKALLOC 1
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index faf80ee..265c8e7 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -121,7 +121,7 @@ TclpDlopen(
}
errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ",
- Tcl_GetString(pathPtr));
+ TclGetString(pathPtr));
/*
* Check for possible DLL errors. This doesn't work quite right,
@@ -174,8 +174,8 @@ TclpDlopen(
* Succeded; package everything up for Tcl.
*/
- handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_));
- handlePtr->clientData = (ClientData) hInstance;
+ handlePtr = (Tcl_LoadHandle)Tcl_Alloc(sizeof(struct Tcl_LoadHandle_));
+ handlePtr->clientData = (void *)hInstance;
handlePtr->findSymbolProcPtr = &FindSymbol;
handlePtr->unloadFileProcPtr = &UnloadFile;
*loadHandle = handlePtr;
@@ -259,7 +259,7 @@ UnloadFile(
HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
FreeLibrary(hInstance);
- ckfree(loadHandle);
+ Tcl_Free(loadHandle);
}
/*
@@ -390,7 +390,7 @@ InitDLLDirectoryName(void)
*/
copyToGlobalBuffer:
- dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR));
+ dllDirectoryName = (WCHAR *)Tcl_Alloc((nameLen+1) * sizeof(WCHAR));
wcscpy(dllDirectoryName, name);
return TCL_OK;
}
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 7b7ef1e..de4f8f2 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -76,7 +76,7 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message,
*----------------------------------------------------------------------
*/
-ClientData
+void *
TclpInitNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -100,7 +100,7 @@ TclpInitNotifier(void)
clazz.style = 0;
clazz.cbClsExtra = 0;
clazz.cbWndExtra = 0;
- clazz.hInstance = TclWinGetTclInstance();
+ clazz.hInstance = (HINSTANCE) TclWinGetTclInstance();
clazz.hbrBackground = NULL;
clazz.lpszMenuName = NULL;
clazz.lpszClassName = className;
@@ -148,7 +148,7 @@ TclpInitNotifier(void)
void
TclpFinalizeNotifier(
- ClientData clientData) /* Pointer to notifier data. */
+ void *clientData) /* Pointer to notifier data. */
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
@@ -188,7 +188,7 @@ TclpFinalizeNotifier(
if (notifierCount) {
notifierCount--;
if (notifierCount == 0) {
- UnregisterClassW(className, TclWinGetTclInstance());
+ UnregisterClassW(className, (HINSTANCE) TclWinGetTclInstance());
}
}
LeaveCriticalSection(&notifierMutex);
@@ -218,7 +218,7 @@ TclpFinalizeNotifier(
void
TclpAlertNotifier(
- ClientData clientData) /* Pointer to thread data. */
+ void *clientData) /* Pointer to thread data. */
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
@@ -287,7 +287,7 @@ TclpSetTimer(
* Windows seems to get confused by zero length timers.
*/
- timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+ timeout = (UINT)timePtr->sec * 1000 + (unsigned long)timePtr->usec / 1000;
if (timeout == 0) {
timeout = 1;
}
@@ -337,7 +337,8 @@ TclpServiceModeHook(
if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED,
- 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
+ 0, 0, 0, 0, NULL, NULL, (HINSTANCE) TclWinGetTclInstance(),
+ NULL);
/*
* Send an initial message to the window to ensure that we wake up the
@@ -436,7 +437,7 @@ NotifierProc(
*----------------------------------------------------------------------
*/
-ClientData
+void *
TclpNotifierData(void)
{
return NULL;
@@ -489,7 +490,7 @@ TclpWaitForEvent(
TclScaleTime(&myTime);
}
- timeout = myTime.sec * 1000 + myTime.usec / 1000;
+ timeout = (DWORD)myTime.sec * 1000 + (unsigned long)myTime.usec / 1000;
} else {
timeout = INFINITE;
}
@@ -609,7 +610,7 @@ Tcl_Sleep(
*/
TclScaleTime(&vdelay);
- sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
+ sleepTime = (DWORD)vdelay.sec * 1000 + (unsigned long)vdelay.usec / 1000;
for (;;) {
SleepEx(sleepTime, TRUE);
@@ -624,7 +625,7 @@ Tcl_Sleep(
vdelay.usec = desired.usec - now.usec;
TclScaleTime(&vdelay);
- sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
+ sleepTime = (DWORD)vdelay.sec * 1000 + (unsigned long)vdelay.usec / 1000;
}
}
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
index 3131286..7928dcd 100644
--- a/win/tclWinPanic.c
+++ b/win/tclWinPanic.c
@@ -1,4 +1,4 @@
-/*
+ /*
* tclWinPanic.c --
*
* Contains the Windows-specific command-line panic proc.
@@ -28,7 +28,7 @@
*----------------------------------------------------------------------
*/
-void
+TCL_NORETURN1 void
Tcl_ConsolePanic(
const char *format, ...)
{
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index cb6177c..600c146 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -61,7 +61,7 @@ typedef struct {
typedef struct ProcInfo {
HANDLE hProcess;
- TCL_HASH_TYPE dwProcessId;
+ int dwProcessId;
struct ProcInfo *nextPtr;
} ProcInfo;
@@ -104,7 +104,7 @@ typedef struct PipeInfo {
TclFile readFile; /* Output from pipe. */
TclFile writeFile; /* Input from pipe. */
TclFile errorFile; /* Error output from pipe. */
- TCL_HASH_TYPE numPids; /* Number of processes attached to pipe. */
+ size_t numPids; /* Number of processes attached to pipe. */
Tcl_Pid *pidPtr; /* Pids of attached processes. */
Tcl_ThreadId threadId; /* Thread to which events should be reported.
* This value is used by the reader/writer
@@ -171,7 +171,7 @@ typedef struct {
static int ApplicationType(Tcl_Interp *interp,
const char *fileName, char *fullName);
-static void BuildCommandLine(const char *executable, Tcl_Size argc,
+static void BuildCommandLine(const char *executable, size_t 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 */
- TCL_CLOSE2PROC, /* Close proc. */
+ NULL, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -402,7 +402,7 @@ PipeCheckProc(
if (needEvent) {
infoPtr->flags |= PIPE_PENDING;
- evPtr = (PipeEvent *)ckalloc(sizeof(PipeEvent));
+ evPtr = (PipeEvent *)Tcl_Alloc(sizeof(PipeEvent));
evPtr->header.proc = PipeEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -433,7 +433,7 @@ TclWinMakeFile(
{
WinFile *filePtr;
- filePtr = (WinFile *)ckalloc(sizeof(WinFile));
+ filePtr = (WinFile *)Tcl_Alloc(sizeof(WinFile));
filePtr->type = WIN_FILE;
filePtr->handle = handle;
@@ -651,7 +651,7 @@ TclpCreateTempFile(
const char *contents) /* String to write into temp file, or NULL. */
{
WCHAR name[MAX_PATH];
- const char *native;
+ const char *native = NULL;
Tcl_DString dstring;
HANDLE handle;
@@ -679,7 +679,10 @@ TclpCreateTempFile(
* Convert the contents from UTF to native encoding
*/
- native = Tcl_UtfToExternalDString(NULL, contents, TCL_INDEX_NONE, &dstring);
+ if (Tcl_UtfToExternalDStringEx(NULL, NULL, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) {
+ goto error;
+ }
+ native = Tcl_DStringValue(&dstring);
toCopy = Tcl_DStringLength(&dstring);
for (p = native; toCopy > 0; p++, toCopy--) {
@@ -719,7 +722,9 @@ TclpCreateTempFile(
Tcl_DStringFree(&dstring);
}
- Tcl_WinConvertError(GetLastError());
+ if (native != NULL) {
+ Tcl_WinConvertError(GetLastError());
+ }
CloseHandle(handle);
DeleteFileW(name);
return NULL;
@@ -826,7 +831,7 @@ TclpCloseFile(
if (filePtr->handle != NULL &&
CloseHandle(filePtr->handle) == FALSE) {
Tcl_WinConvertError(GetLastError());
- ckfree(filePtr);
+ Tcl_Free(filePtr);
return -1;
}
}
@@ -836,7 +841,7 @@ TclpCloseFile(
Tcl_Panic("TclpCloseFile: unexpected file type");
}
- ckfree(filePtr);
+ Tcl_Free(filePtr);
return 0;
}
@@ -869,13 +874,13 @@ TclpGetPid(
Tcl_MutexLock(&pipeMutex);
for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
- if (infoPtr->dwProcessId == PTR2UINT(pid)) {
+ if (infoPtr->dwProcessId == (Tcl_Size)pid) {
Tcl_MutexUnlock(&pipeMutex);
return infoPtr->dwProcessId;
}
}
Tcl_MutexUnlock(&pipeMutex);
- return TCL_INDEX_NONE;
+ return -1;
}
/*
@@ -911,7 +916,7 @@ TclpCreateProcess(
* occurred when creating the child process.
* Error messages from the child process
* itself are sent to errorFile. */
- Tcl_Size argc, /* Number of arguments in following array. */
+ size_t argc, /* Number of arguments in following array. */
const char **argv, /* Array of argument strings. argv[0] contains
* the name of the executable converted to
* native format (using the
@@ -1536,21 +1541,29 @@ static void
BuildCommandLine(
const char *executable, /* Full path of executable (including
* extension). Replacement for argv[0]. */
- Tcl_Size argc, /* Number of arguments. */
+ size_t argc, /* Number of arguments. */
const char **argv, /* Argument strings in UTF. */
Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the
* command line (WCHAR). */
{
const char *arg, *start, *special, *bspos;
int quote = 0;
- Tcl_Size i;
+ size_t i;
Tcl_DString ds;
+#ifdef TCL_WIN_PIPE_FULLESC
+ /* full escape inclusive %-subst avoidance */
static const char specMetaChars[] = "&|^<>!()%";
/* Characters to enclose in quotes if unpaired
* quote flag set. */
static const char specMetaChars2[] = "%";
/* Character to enclose in quotes in any case
* (regardless of unpaired-flag). */
+#else
+ /* escape considering quotation only (no %-subst avoidance) */
+ static const char specMetaChars[] = "&|^<>!()";
+ /* Characters to enclose in quotes if unpaired
+ * quote flag set. */
+#endif
/*
* Quote flags:
* CL_ESCAPE - escape argument;
@@ -1688,7 +1701,7 @@ BuildCommandLine(
start = !bspos ? special : bspos;
continue;
}
-
+#ifdef TCL_WIN_PIPE_FULLESC
/*
* Special case for % - should be enclosed always (paired
* also)
@@ -1705,6 +1718,7 @@ BuildCommandLine(
start = !bspos ? special : bspos;
continue;
}
+#endif
/*
* Other not special (and not meta) character
@@ -1760,11 +1774,11 @@ TclpCreateCommandChannel(
TclFile writeFile, /* If non-null, gives the file for writing. */
TclFile errorFile, /* If non-null, gives the file where errors
* can be read. */
- Tcl_Size numPids, /* The number of pids in the pid array. */
+ size_t numPids, /* The number of pids in the pid array. */
Tcl_Pid *pidPtr) /* An array of process identifiers. */
{
char channelName[16 + TCL_INTEGER_SPACE];
- PipeInfo *infoPtr = (PipeInfo *)ckalloc(sizeof(PipeInfo));
+ PipeInfo *infoPtr = (PipeInfo *)Tcl_Alloc(sizeof(PipeInfo));
PipeInit();
@@ -1827,14 +1841,7 @@ 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;
}
@@ -1906,8 +1913,8 @@ TclGetAndDetachPids(
{
PipeInfo *pipePtr;
const Tcl_ChannelType *chanTypePtr;
- Tcl_Obj *pidsObj, *elemPtr;
- TCL_HASH_TYPE i;
+ Tcl_Obj *pidsObj;
+ size_t i;
/*
* Punt if the channel is not a command channel.
@@ -1921,13 +1928,14 @@ TclGetAndDetachPids(
pipePtr = (PipeInfo *)Tcl_GetChannelInstanceData(chan);
TclNewObj(pidsObj);
for (i = 0; i < pipePtr->numPids; i++) {
- TclNewIntObj(elemPtr, TclpGetPid(pipePtr->pidPtr[i]));
- Tcl_ListObjAppendElement(NULL, pidsObj, elemPtr);
+ Tcl_ListObjAppendElement(NULL, pidsObj,
+ Tcl_NewWideIntObj(
+ TclpGetPid(pipePtr->pidPtr[i])));
Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
}
Tcl_SetObjResult(interp, pidsObj);
if (pipePtr->numPids > 0) {
- ckfree(pipePtr->pidPtr);
+ Tcl_Free(pipePtr->pidPtr);
pipePtr->numPids = 0;
}
}
@@ -2112,9 +2120,9 @@ PipeClose2Proc(
if (pipePtr->errorFile) {
WinFile *filePtr = (WinFile *) pipePtr->errorFile;
- errChan = Tcl_MakeFileChannel((void *)filePtr->handle,
+ errChan = Tcl_MakeFileChannel((void *) filePtr->handle,
TCL_READABLE);
- ckfree(filePtr);
+ Tcl_Free(filePtr);
} else {
errChan = NULL;
}
@@ -2124,14 +2132,14 @@ PipeClose2Proc(
}
if (pipePtr->numPids > 0) {
- ckfree(pipePtr->pidPtr);
+ Tcl_Free(pipePtr->pidPtr);
}
if (pipePtr->writeBuf != NULL) {
- ckfree(pipePtr->writeBuf);
+ Tcl_Free(pipePtr->writeBuf);
}
- ckfree(pipePtr);
+ Tcl_Free(pipePtr);
if (errorCode == 0) {
return result;
@@ -2300,10 +2308,10 @@ PipeOutputProc(
*/
if (infoPtr->writeBuf) {
- ckfree(infoPtr->writeBuf);
+ Tcl_Free(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = (char *)ckalloc(toWrite);
+ infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite);
}
memcpy(infoPtr->writeBuf, buf, toWrite);
infoPtr->toWrite = toWrite;
@@ -2565,7 +2573,7 @@ Tcl_WaitPid(
prevPtrPtr = &procList;
for (infoPtr = procList; infoPtr != NULL;
prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
- if (infoPtr->dwProcessId == PTR2UINT(pid)) {
+ if (infoPtr->dwProcessId == (Tcl_Size)pid) {
*prevPtrPtr = infoPtr->nextPtr;
break;
}
@@ -2675,7 +2683,7 @@ Tcl_WaitPid(
} else {
errno = ECHILD;
*statPtr = 0xC0000000 | ECHILD;
- result = (Tcl_Pid) -1;
+ result = (Tcl_Pid)-1;
}
/*
@@ -2683,7 +2691,7 @@ Tcl_WaitPid(
*/
CloseHandle(infoPtr->hProcess);
- ckfree(infoPtr);
+ Tcl_Free(infoPtr);
return result;
}
@@ -2711,7 +2719,7 @@ TclWinAddProcess(
void *hProcess, /* Handle to process */
Tcl_Size id) /* Global process identifier */
{
- ProcInfo *procPtr = (ProcInfo *)ckalloc(sizeof(ProcInfo));
+ ProcInfo *procPtr = (ProcInfo *)Tcl_Alloc(sizeof(ProcInfo));
PipeInit();
@@ -2750,18 +2758,17 @@ Tcl_PidObjCmd(
Tcl_Channel chan;
const Tcl_ChannelType *chanTypePtr;
PipeInfo *pipePtr;
- TCL_HASH_TYPE i;
- Tcl_Obj *resultPtr, *elemPtr;
+ size_t i;
+ Tcl_Obj *resultPtr;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
return TCL_ERROR;
}
if (objc == 1) {
- TclNewIntObj(elemPtr, getpid());
- Tcl_SetObjResult(interp, elemPtr);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(getpid()));
} else {
- chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]),
+ chan = Tcl_GetChannel(interp, TclGetString(objv[1]),
NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
@@ -2774,8 +2781,9 @@ Tcl_PidObjCmd(
pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
TclNewObj(resultPtr);
for (i = 0; i < pipePtr->numPids; i++) {
- TclNewIntObj(elemPtr, TclpGetPid(pipePtr->pidPtr[i]));
- Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, elemPtr);
+ Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
+ Tcl_NewWideIntObj(
+ TclpGetPid(pipePtr->pidPtr[i])));
}
Tcl_SetObjResult(interp, resultPtr);
}
@@ -3212,7 +3220,7 @@ TclpOpenTemporaryFile(
}
namePtr += length * sizeof(WCHAR);
if (basenameObj) {
- const char *string = TclGetStringFromObj(basenameObj, &length);
+ const char *string = Tcl_GetStringFromObj(basenameObj, &length);
Tcl_DStringInit(&buf);
Tcl_UtfToWCharDString(string, length, &buf);
@@ -3288,7 +3296,7 @@ TclPipeThreadCreateTI(
#ifndef _PTI_USE_CKALLOC
pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo));
#else
- pipeTI = (TclPipeThreadInfo *)ckalloc(sizeof(TclPipeThreadInfo));
+ pipeTI = (TclPipeThreadInfo *)Tcl_Alloc(sizeof(TclPipeThreadInfo));
#endif /* !_PTI_USE_CKALLOC */
pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL);
pipeTI->state = PTI_STATE_IDLE;
@@ -3649,7 +3657,7 @@ TclPipeThreadStop(
#ifndef _PTI_USE_CKALLOC
free(pipeTI);
#else
- ckfree(pipeTI);
+ Tcl_Free(pipeTI);
#endif /* !_PTI_USE_CKALLOC */
}
}
@@ -3699,7 +3707,7 @@ TclPipeThreadExit(
#ifndef _PTI_USE_CKALLOC
free(pipeTI);
#else
- ckfree(pipeTI);
+ Tcl_Free(pipeTI);
/* be sure all subsystems used are finalized */
Tcl_FinalizeThread();
#endif /* !_PTI_USE_CKALLOC */
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index 9eb949b..f549420 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, isBin) ((void*)HeapAlloc(GetProcessHeap(), \
- (DWORD)0, (DWORD)size))
+#define TclpSysAlloc(size) ((void*)HeapAlloc(GetProcessHeap(), \
+ 0, size))
#define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \
- (DWORD)0, (HGLOBAL)ptr))
+ 0, (HGLOBAL)ptr))
#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \
- (DWORD)0, (LPVOID)ptr, (DWORD)size))
+ 0, (LPVOID)ptr, size))
/* This type is not defined in the Windows headers */
#define socklen_t int
@@ -527,7 +527,7 @@ typedef DWORD_PTR * PDWORD_PTR;
* address platform-specific issues.
*/
-#define TclpReleaseFile(file) ckfree(file)
+#define TclpReleaseFile(file) Tcl_Free(file)
/*
* The following macros and declarations wrap the C runtime library
@@ -544,7 +544,4 @@ typedef DWORD_PTR * PDWORD_PTR;
# define LABEL_SECURITY_INFORMATION (0x00000010L)
#endif
-#define Tcl_DirEntry void
-#define TclDIR void
-
#endif /* _TCLWINPORT */
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 4157380..9ef62c6 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -86,12 +86,28 @@ static const char *const typeNames[] = {
static DWORD lastType = REG_RESOURCE_LIST;
+#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
+# if TCL_UTF_MAX > 3
+# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
+# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
+# else
+# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
+# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
+# endif
+#ifndef Tcl_Size
+# define Tcl_Size int
+#endif
+#ifndef Tcl_CreateObjCommand2
+# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand
+#endif
+#endif
+
/*
* Declarations for functions defined in this file.
*/
static void AppendSystemError(Tcl_Interp *interp, DWORD error);
-static int BroadcastValue(Tcl_Interp *interp, int objc,
+static int BroadcastValue(Tcl_Interp *interp, Tcl_Size objc,
Tcl_Obj *const objv[]);
static DWORD ConvertDWORD(DWORD type, DWORD value);
static void DeleteCmd(void *clientData);
@@ -118,31 +134,19 @@ static int ParseKeyName(Tcl_Interp *interp, char *name,
static DWORD RecursiveDeleteKey(HKEY hStartKey,
const WCHAR * pKeyName, REGSAM mode);
static int RegistryObjCmd(void *clientData,
- Tcl_Interp *interp, int objc,
+ Tcl_Interp *interp, Tcl_Size objc,
Tcl_Obj *const objv[]);
static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
Tcl_Obj *typeObj, REGSAM mode);
-#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
-# if TCL_UTF_MAX > 3
-# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
-# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
-# else
-# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
-# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
-# endif
-#define Tcl_Size int
-#define TCL_INDEX_NONE -1
-#endif
-
#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int Registry_Init(Tcl_Interp *interp);
DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags);
#if TCL_MAJOR_VERSION < 9
-/* With those additional entries, "load registry13.dll" works without 3th argument */
+/* With those additional entries, "load tclregistry13.dll" works without 3th argument */
DLLEXPORT int Tclregistry_Init(Tcl_Interp *interp);
DLLEXPORT int Tclregistry_Unload(Tcl_Interp *interp, int flags);
#endif
@@ -176,7 +180,7 @@ Registry_Init(
return TCL_ERROR;
}
- cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
+ cmd = Tcl_CreateObjCommand2(interp, "registry", RegistryObjCmd,
interp, DeleteCmd);
Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
return Tcl_PkgProvideEx(interp, "registry", "1.3.7", NULL);
@@ -219,9 +223,9 @@ Registry_Unload(
* Unregister the registry package. There is no Tcl_PkgForget()
*/
- objv[0] = Tcl_NewStringObj("package", TCL_INDEX_NONE);
- objv[1] = Tcl_NewStringObj("forget", TCL_INDEX_NONE);
- objv[2] = Tcl_NewStringObj("registry", TCL_INDEX_NONE);
+ objv[0] = Tcl_NewStringObj("package", -1);
+ objv[1] = Tcl_NewStringObj("forget", -1);
+ objv[2] = Tcl_NewStringObj("registry", -1);
Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL);
/*
@@ -291,11 +295,11 @@ static int
RegistryObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
+ Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
- int n = 1;
- int index, argc;
+ Tcl_Size n = 1, argc;
+ int index;
REGSAM mode = 0;
const char *errString = NULL;
@@ -461,7 +465,7 @@ DeleteKey(
if (*keyName == '\0') {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("bad key: cannot delete root keys", TCL_INDEX_NONE));
+ Tcl_NewStringObj("bad key: cannot delete root keys", -1));
Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", (void *)NULL);
Tcl_Free(buffer);
return TCL_ERROR;
@@ -483,7 +487,7 @@ DeleteKey(
return TCL_OK;
}
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("unable to delete key: ", TCL_INDEX_NONE));
+ Tcl_NewStringObj("unable to delete key: ", -1));
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -493,13 +497,13 @@ DeleteKey(
*/
Tcl_DStringInit(&buf);
- nativeTail = Tcl_UtfToWCharDString(tail, TCL_INDEX_NONE, &buf);
+ nativeTail = Tcl_UtfToWCharDString(tail, -1, &buf);
result = RecursiveDeleteKey(subkey, nativeTail, saveMode);
Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("unable to delete key: ", TCL_INDEX_NONE));
+ Tcl_NewStringObj("unable to delete key: ", -1));
AppendSystemError(interp, result);
result = TCL_ERROR;
} else {
@@ -731,7 +735,7 @@ GetType(
if (type > lastType) {
Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type));
} else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], TCL_INDEX_NONE));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1));
}
return TCL_OK;
}
@@ -995,7 +999,7 @@ OpenKey(
result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
if (result != ERROR_SUCCESS) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("unable to open key: ", TCL_INDEX_NONE));
+ Tcl_NewStringObj("unable to open key: ", -1));
AppendSystemError(interp, result);
result = TCL_ERROR;
} else {
@@ -1043,7 +1047,7 @@ OpenSubKey(
if (hostName) {
Tcl_DStringInit(&buf);
- hostName = (char *) Tcl_UtfToWCharDString(hostName, TCL_INDEX_NONE, &buf);
+ hostName = (char *) Tcl_UtfToWCharDString(hostName, -1, &buf);
result = RegConnectRegistryW((WCHAR *)hostName, rootKey,
&rootKey);
Tcl_DStringFree(&buf);
@@ -1059,7 +1063,7 @@ OpenSubKey(
if (keyName) {
Tcl_DStringInit(&buf);
- keyName = (char *) Tcl_UtfToWCharDString(keyName, TCL_INDEX_NONE, &buf);
+ keyName = (char *) Tcl_UtfToWCharDString(keyName, -1, &buf);
}
if (flags & REG_CREATE) {
DWORD create;
@@ -1163,7 +1167,7 @@ ParseKeyName(
* Look for a matching root name.
*/
- rootObj = Tcl_NewStringObj(rootName, TCL_INDEX_NONE);
+ rootObj = Tcl_NewStringObj(rootName, -1);
result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name",
TCL_EXACT, &index);
Tcl_DecrRefCount(rootObj);
@@ -1399,7 +1403,7 @@ SetValue(
if (result != ERROR_SUCCESS) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("unable to set value: ", TCL_INDEX_NONE));
+ Tcl_NewStringObj("unable to set value: ", -1));
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -1426,7 +1430,7 @@ SetValue(
static int
BroadcastValue(
Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
+ Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
LRESULT result;
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index bc6dcc6..650c767 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -165,30 +165,30 @@ static COMMTIMEOUTS no_timeout = {
* Declarations for functions used only in this file.
*/
-static int SerialBlockProc(ClientData instanceData, int mode);
-static void SerialCheckProc(ClientData clientData, int flags);
-static int SerialCloseProc(ClientData instanceData,
+static int SerialBlockProc(void *instanceData, int mode);
+static void SerialCheckProc(void *clientData, int flags);
+static int SerialCloseProc(void *instanceData,
Tcl_Interp *interp, int flags);
static int SerialEventProc(Tcl_Event *evPtr, int flags);
-static void SerialExitHandler(ClientData clientData);
-static int SerialGetHandleProc(ClientData instanceData,
- int direction, ClientData *handlePtr);
+static void SerialExitHandler(void *clientData);
+static int SerialGetHandleProc(void *instanceData,
+ int direction, void **handlePtr);
static ThreadSpecificData *SerialInit(void);
-static int SerialInputProc(ClientData instanceData, char *buf,
+static int SerialInputProc(void *instanceData, char *buf,
int toRead, int *errorCode);
-static int SerialOutputProc(ClientData instanceData,
+static int SerialOutputProc(void *instanceData,
const char *buf, int toWrite, int *errorCode);
-static void SerialSetupProc(ClientData clientData, int flags);
-static void SerialWatchProc(ClientData instanceData, int mask);
-static void ProcExitHandler(ClientData clientData);
-static int SerialGetOptionProc(ClientData instanceData,
+static void SerialSetupProc(void *clientData, int flags);
+static void SerialWatchProc(void *instanceData, int mask);
+static void ProcExitHandler(void *clientData);
+static int SerialGetOptionProc(void *instanceData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
-static int SerialSetOptionProc(ClientData instanceData,
+static int SerialSetOptionProc(void *instanceData,
Tcl_Interp *interp, const char *optionName,
const char *value);
static DWORD WINAPI SerialWriterThread(LPVOID arg);
-static void SerialThreadActionProc(ClientData instanceData,
+static void SerialThreadActionProc(void *instanceData,
int action);
static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf,
DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr);
@@ -204,7 +204,7 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
static const Tcl_ChannelType serialChannelType = {
"serial", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- TCL_CLOSE2PROC, /* Close proc. */
+ NULL, /* Close proc. */
SerialInputProc, /* Input proc. */
SerialOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -285,7 +285,7 @@ SerialInit(void)
static void
SerialExitHandler(
- TCL_UNUSED(ClientData))
+ TCL_UNUSED(void *))
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
SerialInfo *infoPtr;
@@ -323,7 +323,7 @@ SerialExitHandler(
static void
ProcExitHandler(
- TCL_UNUSED(ClientData))
+ TCL_UNUSED(void *))
{
Tcl_MutexLock(&serialMutex);
initialized = 0;
@@ -406,7 +406,7 @@ SerialGetMilliseconds(void)
void
SerialSetupProc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
SerialInfo *infoPtr;
@@ -461,7 +461,7 @@ SerialSetupProc(
static void
SerialCheckProc(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
SerialInfo *infoPtr;
@@ -535,7 +535,7 @@ SerialCheckProc(
if (needEvent) {
infoPtr->flags |= SERIAL_PENDING;
- evPtr = (SerialEvent *)ckalloc(sizeof(SerialEvent));
+ evPtr = (SerialEvent *)Tcl_Alloc(sizeof(SerialEvent));
evPtr->header.proc = SerialEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -561,7 +561,7 @@ SerialCheckProc(
static int
SerialBlockProc(
- ClientData instanceData, /* Instance data for channel. */
+ void *instanceData, /* Instance data for channel. */
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
@@ -600,7 +600,7 @@ SerialBlockProc(
static int
SerialCloseProc(
- ClientData instanceData, /* Pointer to SerialInfo structure. */
+ void *instanceData, /* Pointer to SerialInfo structure. */
TCL_UNUSED(Tcl_Interp *),
int flags)
{
@@ -670,10 +670,10 @@ SerialCloseProc(
*/
if (serialPtr->writeBuf != NULL) {
- ckfree(serialPtr->writeBuf);
+ Tcl_Free(serialPtr->writeBuf);
serialPtr->writeBuf = NULL;
}
- ckfree(serialPtr);
+ Tcl_Free(serialPtr);
if (errorCode == 0) {
return result;
@@ -796,7 +796,7 @@ SerialBlockingWrite(
LeaveCriticalSection(&infoPtr->csWrite);
if (result == FALSE) {
- int err = GetLastError();
+ DWORD err = GetLastError();
switch (err) {
case ERROR_IO_PENDING:
@@ -855,7 +855,7 @@ SerialBlockingWrite(
static int
SerialInputProc(
- ClientData instanceData, /* Serial state. */
+ void *instanceData, /* Serial state. */
char *buf, /* Where to store data read. */
int bufSize, /* How much space is available in the
* buffer? */
@@ -962,7 +962,7 @@ SerialInputProc(
static int
SerialOutputProc(
- ClientData instanceData, /* Serial state. */
+ void *instanceData, /* Serial state. */
const char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
@@ -1035,10 +1035,10 @@ SerialOutputProc(
*/
if (infoPtr->writeBuf) {
- ckfree(infoPtr->writeBuf);
+ Tcl_Free(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = (char *)ckalloc(toWrite);
+ infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite);
}
memcpy(infoPtr->writeBuf, buf, toWrite);
infoPtr->toWrite = toWrite;
@@ -1192,7 +1192,7 @@ SerialEventProc(
static void
SerialWatchProc(
- ClientData instanceData, /* Serial state. */
+ void *instanceData, /* Serial state. */
int mask) /* What events to watch for, OR-ed combination
* of TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION. */
@@ -1249,13 +1249,13 @@ SerialWatchProc(
static int
SerialGetHandleProc(
- ClientData instanceData, /* The serial state. */
+ void *instanceData, /* The serial state. */
TCL_UNUSED(int) /*direction*/,
- ClientData *handlePtr) /* Where to store the handle. */
+ void **handlePtr) /* Where to store the handle. */
{
SerialInfo *infoPtr = (SerialInfo *) instanceData;
- *handlePtr = (ClientData) infoPtr->handle;
+ *handlePtr = (void *) infoPtr->handle;
return TCL_OK;
}
@@ -1455,7 +1455,7 @@ TclWinOpenSerialChannel(
SerialInit();
- infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo));
+ infoPtr = (SerialInfo *)Tcl_Alloc(sizeof(SerialInfo));
memset(infoPtr, 0, sizeof(SerialInfo));
infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE);
@@ -1508,13 +1508,7 @@ TclWinOpenSerialChannel(
infoPtr->evWritable), 0, NULL);
}
- /*
- * Files have default translation of AUTO and ^Z eof char, which means
- * that a ^Z will be accepted as EOF when reading.
- */
-
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}");
return infoPtr->channel;
}
@@ -1619,7 +1613,7 @@ SerialModemStatusStr(
static int
SerialSetOptionProc(
- ClientData instanceData, /* File state. */
+ void *instanceData, /* File state. */
Tcl_Interp *interp, /* For error reporting - can be NULL. */
const char *optionName, /* Which option to set? */
const char *value) /* New value for option. */
@@ -1782,7 +1776,7 @@ SerialSetOptionProc(
" two elements with each a single 8-bit character", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", (void *)NULL);
}
- ckfree(argv);
+ Tcl_Free((void *)argv);
return TCL_ERROR;
}
@@ -1813,7 +1807,7 @@ SerialSetOptionProc(
}
dcb.XoffChar = (char) character;
}
- ckfree(argv);
+ Tcl_Free((void *)argv);
if (!SetCommState(infoPtr->handle, &dcb)) {
goto setStateFailed;
@@ -1839,7 +1833,7 @@ SerialSetOptionProc(
"a list of signal,value pairs", value));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", (void *)NULL);
}
- ckfree(argv);
+ Tcl_Free((void *)argv);
return TCL_ERROR;
}
@@ -1897,7 +1891,7 @@ SerialSetOptionProc(
}
}
- ckfree(argv);
+ Tcl_Free((void *)argv);
return res;
}
@@ -1923,7 +1917,7 @@ SerialSetOptionProc(
inSize = atoi(argv[0]);
outSize = atoi(argv[1]);
}
- ckfree(argv);
+ Tcl_Free((void *)argv);
if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
if (interp != NULL) {
@@ -2043,7 +2037,7 @@ SerialSetOptionProc(
static int
SerialGetOptionProc(
- ClientData instanceData, /* File state. */
+ void *instanceData, /* File state. */
Tcl_Interp *interp, /* For error reporting - can be NULL. */
const char *optionName, /* Option to get. */
Tcl_DString *dsPtr) /* Where to store value(s). */
@@ -2280,7 +2274,7 @@ SerialGetOptionProc(
static void
SerialThreadActionProc(
- ClientData instanceData,
+ void *instanceData,
int action)
{
SerialInfo *infoPtr = (SerialInfo *) instanceData;
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index c34835b..f54d8a1 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -243,12 +243,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;
@@ -265,11 +265,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc;
static const Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
-#ifndef TCL_NO_DEPRECATED
- TcpCloseProc, /* Close proc. */
-#else
- TCL_CLOSE2PROC, /* Close proc. */
-#endif
+ NULL, /* Close proc. */
TcpInputProc, /* Input proc. */
TcpOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -349,7 +345,7 @@ printaddrinfolist(
void
InitializeHostName(
char **valuePtr,
- TCL_HASH_TYPE *lengthPtr,
+ size_t *lengthPtr,
Tcl_Encoding *encodingPtr)
{
WCHAR wbuf[256];
@@ -377,15 +373,15 @@ InitializeHostName(
Tcl_DStringSetLength(&inDs, 256);
if (gethostname(Tcl_DStringValue(&inDs),
Tcl_DStringLength(&inDs)) == 0) {
- Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs),
- TCL_INDEX_NONE, &ds);
+ Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&inDs),
+ TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
}
Tcl_DStringFree(&inDs);
}
*encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
*lengthPtr = Tcl_DStringLength(&ds);
- *valuePtr = (char *)ckalloc(*lengthPtr + 1);
+ *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
Tcl_DStringFree(&ds);
}
@@ -1057,7 +1053,7 @@ TcpCloseProc(
Tcl_WinConvertError((DWORD) WSAGetLastError());
errorCode = Tcl_GetErrno();
}
- ckfree(thisfd);
+ Tcl_Free(thisfd);
}
if (statePtr->addrlist != NULL) {
@@ -1098,7 +1094,7 @@ TcpCloseProc(
* fear of damaging the list.
*/
- ckfree(statePtr);
+ Tcl_Free(statePtr);
return errorCode;
}
@@ -2032,11 +2028,11 @@ Tcl_OpenTcpClient(
statePtr, (TCL_READABLE | TCL_WRITABLE));
if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
"-translation", "auto crlf")) {
- Tcl_Close(NULL, statePtr->channel);
+ Tcl_CloseEx(NULL, statePtr->channel, 0);
return NULL;
} else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
"-eofchar", "")) {
- Tcl_Close(NULL, statePtr->channel);
+ Tcl_CloseEx(NULL, statePtr->channel, 0);
return NULL;
}
return statePtr->channel;
@@ -2275,7 +2271,7 @@ Tcl_OpenTcpServerEx(
SendSelectMessage(tsdPtr, SELECT, statePtr);
if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close(NULL, statePtr->channel);
+ Tcl_CloseEx(NULL, statePtr->channel, 0);
return NULL;
}
return statePtr->channel;
@@ -2347,12 +2343,12 @@ TcpAccept(
newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_Close(NULL, newInfoPtr->channel);
+ Tcl_CloseEx(NULL, newInfoPtr->channel, 0);
return;
}
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close(NULL, newInfoPtr->channel);
+ Tcl_CloseEx(NULL, newInfoPtr->channel, 0);
return;
}
@@ -2549,7 +2545,7 @@ SocketCheckProc(
statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
&& !GOT_BITS(statePtr->flags, SOCKET_PENDING)) {
SET_BITS(statePtr->flags, SOCKET_PENDING);
- evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent));
+ evPtr = (SocketEvent *)Tcl_Alloc(sizeof(SocketEvent));
evPtr->header.proc = SocketEventProc;
evPtr->socket = statePtr->sockets->fd;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -2824,7 +2820,7 @@ AddSocketInfoFd(
* Add the first FD.
*/
- statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList));
+ statePtr->sockets = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
fds = statePtr->sockets;
} else {
/*
@@ -2835,7 +2831,7 @@ AddSocketInfoFd(
fds = fds->next;
}
- fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList));
+ fds->next = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
fds = fds->next;
}
@@ -2868,7 +2864,7 @@ AddSocketInfoFd(
static TcpState *
NewSocketInfo(SOCKET socket)
{
- TcpState *statePtr = (TcpState *)ckalloc(sizeof(TcpState));
+ TcpState *statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
memset(statePtr, 0, sizeof(TcpState));
@@ -3231,68 +3227,6 @@ FindFDInList(
/*
*----------------------------------------------------------------------
*
- * TclWinGetSockOpt, et al. --
- *
- * Those functions are historically exported by the stubs table and
- * just use the original system calls now.
- *
- * Warning:
- * Those functions are depreciated and will be removed with TCL 9.0.
- *
- * Results:
- * As defined for each function.
- *
- * Side effects:
- * As defined for each function.
- *
- *----------------------------------------------------------------------
- */
-
-#ifndef TCL_NO_DEPRECATED
-#undef TclWinGetSockOpt
-int
-TclWinGetSockOpt(
- SOCKET s,
- int level,
- int optname,
- char *optval,
- int *optlen)
-{
-
- return getsockopt(s, level, optname, optval, optlen);
-}
-#undef TclWinSetSockOpt
-int
-TclWinSetSockOpt(
- SOCKET s,
- int level,
- int optname,
- const char *optval,
- int optlen)
-{
- return setsockopt(s, level, optname, optval, optlen);
-}
-
-#undef TclpInetNtoa
-char *
-TclpInetNtoa(
- struct in_addr addr)
-{
- return inet_ntoa(addr);
-}
-#undef TclWinGetServByName
-struct servent *
-TclWinGetServByName(
- const char *name,
- const char *proto)
-{
- return getservbyname(name, proto);
-}
-#endif /* TCL_NO_DEPRECATED */
-
-/*
- *----------------------------------------------------------------------
- *
* TcpThreadActionProc --
*
* Insert or remove any thread local refs to this channel.
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 86f36b4..1b679a9 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -9,6 +9,8 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef BUILD_tcl
+#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
# define USE_TCL_STUBS
#endif
@@ -40,7 +42,6 @@ static Tcl_ObjCmdProc TesteventloopCmd;
static Tcl_ObjCmdProc TestvolumetypeCmd;
static Tcl_ObjCmdProc TestwinclockCmd;
static Tcl_ObjCmdProc TestwinsleepCmd;
-static Tcl_ObjCmdProc TestSizeCmd;
static Tcl_ObjCmdProc TestExceptionCmd;
static int TestplatformChmod(const char *nativePath, int pmode);
static Tcl_ObjCmdProc TestchmodCmd;
@@ -77,7 +78,6 @@ TclplatformtestInit(
Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL);
return TCL_OK;
}
@@ -101,7 +101,7 @@ TclplatformtestInit(
static int
TesteventloopCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -177,7 +177,7 @@ TesteventloopCmd(
static int
TestvolumetypeCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -243,7 +243,7 @@ TestvolumetypeCmd(
static int
TestwinclockCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
@@ -292,7 +292,7 @@ TestwinclockCmd(
static int
TestwinsleepCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const * objv) /* Parameter vector */
@@ -310,28 +310,6 @@ TestwinsleepCmd(
return TCL_OK;
}
-static int
-TestSizeCmd(
- TCL_UNUSED(ClientData),
- Tcl_Interp* interp, /* Tcl interpreter */
- int objc, /* Parameter count */
- Tcl_Obj *const * objv) /* Parameter vector */
-{
-
- if (objc != 2) {
- goto syntax;
- }
- if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) {
- Tcl_StatBuf *statPtr;
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime)));
- return TCL_OK;
- }
-
-syntax:
- Tcl_WrongNumArgs(interp, 1, objv, "st_mtime");
- return TCL_ERROR;
-}
-
/*
*----------------------------------------------------------------------
*
@@ -357,7 +335,7 @@ syntax:
static int
TestExceptionCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
@@ -480,16 +458,16 @@ TestplatformChmod(
GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
goto done;
}
- pTokenUser = (TOKEN_USER *)ckalloc(dw);
+ pTokenUser = (TOKEN_USER *)Tcl_Alloc(dw);
if (!GetTokenInformation(hToken, TokenUser, pTokenUser, dw, &dw)) {
goto done;
}
aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid);
- aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen);
+ aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
if (!CopySid(aceEntry[nSids].sidLen,
aceEntry[nSids].pSid,
pTokenUser->User.Sid)) {
- ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
+ Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
goto done;
}
/*
@@ -522,19 +500,19 @@ TestplatformChmod(
GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
goto done;
}
- pTokenGroup = (TOKEN_PRIMARY_GROUP *)ckalloc(dw);
+ pTokenGroup = (TOKEN_PRIMARY_GROUP *)Tcl_Alloc(dw);
if (!GetTokenInformation(hToken, TokenPrimaryGroup, pTokenGroup, dw, &dw)) {
- ckfree(pTokenGroup);
+ Tcl_Free(pTokenGroup);
goto done;
}
aceEntry[nSids].sidLen = GetLengthSid(pTokenGroup->PrimaryGroup);
- aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen);
+ aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenGroup->PrimaryGroup)) {
- ckfree(pTokenGroup);
- ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
+ Tcl_Free(pTokenGroup);
+ Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
goto done;
}
- ckfree(pTokenGroup);
+ Tcl_Free(pTokenGroup);
/* Generate mask for group ACL */
@@ -558,10 +536,10 @@ TestplatformChmod(
goto done;
}
aceEntry[nSids].sidLen = GetLengthSid(pWorldSid);
- aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen);
+ aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pWorldSid)) {
LocalFree(pWorldSid);
- ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
+ Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
goto done;
}
LocalFree(pWorldSid);
@@ -589,7 +567,7 @@ TestplatformChmod(
newAclSize +=
offsetof(ACCESS_ALLOWED_ACE, SidStart) + aceEntry[i].sidLen;
}
- newAcl = (PACL)ckalloc(newAclSize);
+ newAcl = (PACL)Tcl_Alloc(newAclSize);
if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
goto done;
}
@@ -618,16 +596,16 @@ TestplatformChmod(
done:
if (pTokenUser) {
- ckfree(pTokenUser);
+ Tcl_Free(pTokenUser);
}
if (hToken) {
CloseHandle(hToken);
}
if (newAcl) {
- ckfree(newAcl);
+ Tcl_Free(newAcl);
}
for (i = 0; i < nSids; ++i) {
- ckfree(aceEntry[i].pSid);
+ Tcl_Free(aceEntry[i].pSid);
}
if (res != 0) {
@@ -637,6 +615,7 @@ TestplatformChmod(
/* Run normal chmod command */
return chmod(nativePath, pmode);
+
}
/*
@@ -660,7 +639,7 @@ TestplatformChmod(
static int
TestchmodCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Parameter count */
Tcl_Obj *const * objv) /* Parameter vector */
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index da9133f..37e0841 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -178,7 +178,7 @@ TclWinThreadStart(
lpOrigStartAddress = winThreadPtr->lpStartAddress;
lpOrigParameter = winThreadPtr->lpParameter;
- ckfree(winThreadPtr);
+ Tcl_Free(winThreadPtr);
return lpOrigStartAddress(lpOrigParameter);
}
@@ -203,15 +203,15 @@ int
TclpThreadCreate(
Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */
Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */
- ClientData clientData, /* The one argument to Main(). */
- TCL_HASH_TYPE stackSize, /* Size of stack for the new thread. */
+ void *clientData, /* The one argument to Main(). */
+ size_t stackSize, /* Size of stack for the new thread. */
int flags) /* Flags controlling behaviour of the new
* thread. */
{
WinThread *winThreadPtr; /* Per-thread startup info */
HANDLE tHandle;
- winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread));
+ winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread));
winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
winThreadPtr->lpParameter = clientData;
winThreadPtr->fpControl = _controlfp(0, 0);
@@ -535,7 +535,7 @@ TclFinalizeLock(void)
#if TCL_THREADS
/* locally used prototype */
-static void FinalizeConditionEvent(ClientData data);
+static void FinalizeConditionEvent(void *data);
/*
*----------------------------------------------------------------------
@@ -568,7 +568,7 @@ Tcl_MutexLock(
*/
if (*mutexPtr == NULL) {
- csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION));
+ csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION));
InitializeCriticalSection(csPtr);
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
@@ -629,7 +629,7 @@ TclpFinalizeMutex(
if (csPtr != NULL) {
DeleteCriticalSection(csPtr);
- ckfree(csPtr);
+ Tcl_Free(csPtr);
*mutexPtr = NULL;
}
}
@@ -711,7 +711,7 @@ Tcl_ConditionWait(
*/
if (*condPtr == NULL) {
- winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition));
+ winCondPtr = (WinCondition *)Tcl_Alloc(sizeof(WinCondition));
InitializeCriticalSection(&winCondPtr->condLock);
winCondPtr->firstPtr = NULL;
winCondPtr->lastPtr = NULL;
@@ -880,7 +880,7 @@ Tcl_ConditionNotify(
static void
FinalizeConditionEvent(
- ClientData data)
+ void *data)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data;
@@ -922,7 +922,7 @@ TclpFinalizeCondition(
if (winCondPtr != NULL) {
DeleteCriticalSection(&winCondPtr->condLock);
- ckfree(winCondPtr);
+ Tcl_Free(winCondPtr);
*condPtr = NULL;
}
}
@@ -1037,7 +1037,7 @@ TclpThreadCreateKey(void)
{
DWORD *key;
- key = (DWORD *)TclpSysAlloc(sizeof *key, 0);
+ key = (DWORD *)TclpSysAlloc(sizeof *key);
if (key == NULL) {
Tcl_Panic("unable to allocate thread key!");
}
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index 6fecbd2..a0c7833 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -12,10 +12,6 @@
#include "tclInt.h"
-#define SECSPERDAY (60L * 60L * 24L)
-#define SECSPERYEAR (SECSPERDAY * 365L)
-#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY)
-
/*
* Number of samples over which to estimate the performance counter.
*/
@@ -23,27 +19,6 @@
#define SAMPLES 64
/*
- * The following arrays contain the day of year for the last day of each
- * month, where index 1 is January.
- */
-
-#ifndef TCL_NO_DEPRECATED
-static const int normalDays[] = {
- -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364
-};
-
-static const int leapDays[] = {
- -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365
-};
-
-typedef struct {
- char tzName[64]; /* Time zone name */
- struct tm tm; /* time information */
-} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
-#endif /* TCL_NO_DEPRECATED */
-
-/*
* Data for managing high-resolution timers.
*/
@@ -133,10 +108,7 @@ static struct {
* Declarations for functions defined later in this file.
*/
-#ifndef TCL_NO_DEPRECATED
-static struct tm * ComputeGMT(const time_t *tp);
-#endif /* TCL_NO_DEPRECATED */
-static void StopCalibration(ClientData clientData);
+static void StopCalibration(void *clientData);
static DWORD WINAPI CalibrationThread(LPVOID arg);
static void UpdateTimeEachSecond(void);
static void ResetCounterSamples(unsigned long long fileTime,
@@ -144,10 +116,10 @@ static void ResetCounterSamples(unsigned long long fileTime,
static long long AccumulateSample(long long perfCounter,
unsigned long long fileTime);
static void NativeScaleTime(Tcl_Time* timebuf,
- ClientData clientData);
+ void *clientData);
static long long NativeGetMicroseconds(void);
static void NativeGetTime(Tcl_Time* timebuf,
- ClientData clientData);
+ void *clientData);
/*
* TIP #233 (Virtualized Time): Data for the time hooks, if any.
@@ -155,7 +127,7 @@ static void NativeGetTime(Tcl_Time* timebuf,
Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime;
Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime;
-ClientData tclTimeClientData = NULL;
+void *tclTimeClientData = NULL;
/*
* Inlined version of Tcl_GetTime.
@@ -191,7 +163,7 @@ IsTimeNative(void)
*----------------------------------------------------------------------
*/
-unsigned long
+unsigned long long
TclpGetSeconds(void)
{
long long usecSincePosixEpoch;
@@ -206,7 +178,7 @@ TclpGetSeconds(void)
Tcl_Time t;
GetTime(&t);
- return t.sec;
+ return (unsigned long long)t.sec;
}
}
@@ -229,7 +201,7 @@ TclpGetSeconds(void)
*----------------------------------------------------------------------
*/
-unsigned long
+unsigned long long
TclpGetClicks(void)
{
long long usecSincePosixEpoch;
@@ -239,7 +211,7 @@ TclpGetClicks(void)
*/
if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
- return (unsigned long) usecSincePosixEpoch;
+ return (Tcl_WideUInt) usecSincePosixEpoch;
} else {
/*
* Use the Tcl_GetTime abstraction to get the time in microseconds, as
@@ -249,7 +221,8 @@ TclpGetClicks(void)
Tcl_Time now; /* Current Tcl time */
GetTime(&now);
- return ((unsigned long)(now.sec)*1000000UL) + (unsigned long)(now.usec);
+ return ((unsigned long long)(now.sec)*1000000ULL) +
+ (unsigned long long)(now.usec);
}
}
@@ -374,7 +347,7 @@ TclpGetMicroseconds(void)
Tcl_Time now;
GetTime(&now);
- return (((long long) now.sec) * 1000000) + now.usec;
+ return now.sec * 1000000 + now.usec;
}
}
@@ -411,8 +384,8 @@ Tcl_GetTime(
*/
if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
- timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
- timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
+ timePtr->sec = usecSincePosixEpoch / 1000000;
+ timePtr->usec = usecSincePosixEpoch % 1000000;
} else {
GetTime(timePtr);
}
@@ -438,7 +411,7 @@ Tcl_GetTime(
static void
NativeScaleTime(
TCL_UNUSED(Tcl_Time *),
- TCL_UNUSED(ClientData))
+ TCL_UNUSED(void *))
{
/*
* Native scale is 1:1. Nothing is done.
@@ -626,7 +599,6 @@ NativeGetMicroseconds(void)
LONGLONG perfCounterLastCall, curCounterFreq;
/* Copy with current data of calibration
* cycle. */
-
LARGE_INTEGER curCounter;
/* Current performance counter. */
@@ -681,6 +653,7 @@ NativeGetMicroseconds(void)
/*
* High resolution timer is not available.
*/
+
return 0;
}
@@ -704,7 +677,7 @@ NativeGetMicroseconds(void)
static void
NativeGetTime(
Tcl_Time *timePtr,
- TCL_UNUSED(ClientData))
+ TCL_UNUSED(void *))
{
long long usecSincePosixEpoch;
@@ -714,8 +687,8 @@ NativeGetTime(
usecSincePosixEpoch = NativeGetMicroseconds();
if (usecSincePosixEpoch) {
- timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
- timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
+ timePtr->sec = usecSincePosixEpoch / 1000000;
+ timePtr->usec = usecSincePosixEpoch % 1000000;
} else {
/*
* High resolution timer is not available. Just use ftime.
@@ -724,7 +697,7 @@ NativeGetTime(
struct _timeb t;
_ftime(&t);
- timePtr->sec = (long) t.time;
+ timePtr->sec = t.time;
timePtr->usec = t.millitm * 1000;
}
}
@@ -751,7 +724,7 @@ void TclWinResetTimerResolution(void);
static void
StopCalibration(
- TCL_UNUSED(ClientData))
+ TCL_UNUSED(void *))
{
SetEvent(timeInfo.exitEvent);
@@ -768,226 +741,6 @@ StopCalibration(
/*
*----------------------------------------------------------------------
*
- * TclpGetDate --
- *
- * This function converts between seconds and struct tm. If useGMT is
- * true, then the returned date will be in Greenwich Mean Time (GMT).
- * Otherwise, it will be in the local time zone.
- *
- * Results:
- * Returns a static tm structure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifndef TCL_NO_DEPRECATED
-struct tm *
-TclpGetDate(
- const time_t *t,
- int useGMT)
-{
- struct tm *tmPtr;
- time_t time;
-#if defined(_WIN64) || defined(_USE_64BIT_TIME_T)
-# 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
@@ -1253,6 +1006,7 @@ UpdateTimeEachSecond(void)
* First adjust with a micro jump (short frozen time is
* acceptable).
*/
+
vt0 += nt0 - nt1;
/*
@@ -1426,77 +1180,6 @@ AccumulateSample(
/*
*----------------------------------------------------------------------
*
- * TclpGmtime --
- *
- * Wrapper around the 'gmtime' library function to make it thread safe.
- *
- * Results:
- * Returns a pointer to a 'struct tm' in thread-specific data.
- *
- * Side effects:
- * Invokes gmtime or gmtime_r as appropriate.
- *
- *----------------------------------------------------------------------
- */
-
-#ifndef TCL_NO_DEPRECATED
-struct tm *
-TclpGmtime(
- const time_t *timePtr) /* Pointer to the number of seconds since the
- * local system's epoch */
-{
- /*
- * The MS implementation of gmtime is thread safe because it returns the
- * time in a block of thread-local storage, and Windows does not provide a
- * Posix gmtime_r function.
- */
-
-#if defined(_WIN64) || defined(_USE_64BIT_TIME_T)
- 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
@@ -1515,7 +1198,7 @@ void
Tcl_SetTimeProc(
Tcl_GetTimeProc *getProc,
Tcl_ScaleTimeProc *scaleProc,
- ClientData clientData)
+ void *clientData)
{
tclGetTimeProcPtr = getProc;
tclScaleTimeProcPtr = scaleProc;
@@ -1542,7 +1225,7 @@ void
Tcl_QueryTimeProc(
Tcl_GetTimeProc **getProc,
Tcl_ScaleTimeProc **scaleProc,
- ClientData *clientData)
+ void **clientData)
{
if (getProc) {
*getProc = tclGetTimeProcPtr;
generated by cgit v0.12 at 2024-11-16 22:40:00 (GMT)