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/configure63
-rw-r--r--win/configure.ac34
-rw-r--r--win/makefile.vc56
-rw-r--r--win/tcl.dsp24
-rw-r--r--win/tcl.m48
-rw-r--r--win/tclAppInit.c11
-rw-r--r--win/tclConfig.sh.in14
-rw-r--r--win/tclWin32Dll.c84
-rw-r--r--win/tclWinChan.c99
-rw-r--r--win/tclWinConsole.c26
-rw-r--r--win/tclWinError.c12
-rw-r--r--win/tclWinFCmd.c24
-rw-r--r--win/tclWinFile.c39
-rw-r--r--win/tclWinInit.c39
-rw-r--r--win/tclWinInt.h2
-rw-r--r--win/tclWinLoad.c8
-rw-r--r--win/tclWinNotify.c15
-rw-r--r--win/tclWinPanic.c4
-rw-r--r--win/tclWinPipe.c112
-rw-r--r--win/tclWinPort.h13
-rw-r--r--win/tclWinSerial.c32
-rw-r--r--win/tclWinSock.c102
-rw-r--r--win/tclWinTest.c56
-rw-r--r--win/tclWinThrd.c18
-rw-r--r--win/tclWinTime.c345
27 files changed, 336 insertions, 970 deletions
diff --git a/win/Makefile.in b/win/Makefile.in
index 856a21c..1cc996b 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) \
@@ -463,6 +466,8 @@ REG_OBJS = tclWinReg.$(OBJEXT)
STUB_OBJS = \
tclStubLib.$(OBJEXT) \
+ tclStubCall.$(OBJEXT) \
+ tclStubLibTbl.$(OBJEXT) \
tclTomMathStubLib.$(OBJEXT) \
tclOOStubLib.$(OBJEXT) \
tclWinPanic.$(OBJEXT)
@@ -521,7 +526,7 @@ tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd
binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH)
-winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}
+winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} ${DDE_DLL_FILE8} ${REG_DLL_FILE8}
libraries:
@@ -595,6 +600,14 @@ ${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest
+${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinDde.$(OBJEXT)
+ @MAKE_DLL@ tcl8WinDde.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
+ $(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest
+
+${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinReg.$(OBJEXT)
+ @MAKE_DLL@ -DTCL_MAJOR_VERSION=8 tcl8WinReg.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
+ $(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest
+
${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
@@ -651,9 +664,15 @@ tclWinPipe.${OBJEXT}: tclWinPipe.c
tclWinReg.${OBJEXT}: tclWinReg.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+tcl8WinReg.${OBJEXT}: tclWinReg.c
+ $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+
tclWinDde.${OBJEXT}: tclWinDde.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+tcl8WinDde.${OBJEXT}: tclWinDde.c
+ $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+
tclAppInit.${OBJEXT}: tclAppInit.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
@@ -713,6 +732,15 @@ tclUuid.h: $(TOP_DIR)/manifest.uuid
tclStubLib.${OBJEXT}: tclStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME)
+tclStubCall.${OBJEXT}: tclStubCall.c
+ $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD \
+ -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
+ -DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \
+ @DEPARG@ $(CC_OBJNAME)
+
+tclStubLibTbl.${OBJEXT}: tclStubLibTbl.c
+ $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+
tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
$(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME)
@@ -843,6 +871,10 @@ install-binaries: binaries
$(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
"$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
fi
+ @if [ -f $(DDE_DLL_FILE8) ]; then \
+ echo Installing $(DDE_DLL_FILE8); \
+ $(COPY) $(DDE_DLL_FILE8) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
+ fi
@if [ -f $(DDE_LIB_FILE) ]; then \
echo Installing $(DDE_LIB_FILE); \
$(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
@@ -853,6 +885,10 @@ install-binaries: binaries
$(COPY) $(ROOT_DIR)/library/registry/pkgIndex.tcl \
"$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
fi
+ @if [ -f $(REG_DLL_FILE8) ]; then \
+ echo Installing $(REG_DLL_FILE8); \
+ $(COPY) $(REG_DLL_FILE8) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
+ fi
@if [ -f $(REG_LIB_FILE) ]; then \
echo Installing $(REG_LIB_FILE); \
$(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
@@ -876,7 +912,7 @@ install-libraries: libraries install-tzdata install-msgs
else true; \
fi; \
done;
- @for i in 8.4 8.4/platform 8.5 8.6 8.7; \
+ @for i in 9.0 9.0/platform; \
do \
if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \
echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \
@@ -894,19 +930,19 @@ install-libraries: libraries install-tzdata install-msgs
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
done;
@echo "Installing package http 2.10b2 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10b2.tm";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10b2.tm";
@echo "Installing package opt 0.4.7";
@for j in $(ROOT_DIR)/library/opt/*.tcl; do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
@echo "Installing package msgcat 1.7.1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm";
@echo "Installing package tcltest 2.5.8 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.8.tm";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.8.tm";
@echo "Installing package platform 1.0.19 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/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"; \
@@ -1112,7 +1148,7 @@ genstubs:
#
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
-# workspace. It depends on the Tcl & Tk being in directories called tcl8.* &
+# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
# tk8.* up two directories from the TOOL_DIR.
#
diff --git a/win/README b/win/README
index 3cfcc15..9b001ba 100644
--- a/win/README
+++ b/win/README
@@ -1,4 +1,4 @@
-Tcl 8.7 for Windows
+Tcl 9.0 for Windows
1. Introduction
---------------
@@ -16,7 +16,7 @@ The information in this file is maintained on the web at:
In order to compile Tcl for Windows, you need the following:
- Tcl 8.7 Source Distribution (plus any patches)
+ Tcl 9.0 Source Distribution (plus any patches)
and
@@ -80,9 +80,9 @@ Use the Makefile "install" target to install Tcl. It will install it
according to the prefix options you provided in the correct directory
structure.
-Note that in order to run tclsh87.exe, you must ensure that tcl87.dll,
+Note that in order to run tclsh90.exe, you must ensure that tcl90.dll,
libtommath.dll and zlib1.dll are on your path, in the system
-directory, or in the directory containing tclsh87.exe.
+directory, or in the directory containing tclsh90.exe.
Note: Tcl no longer provides support for systems earlier than Windows 7.
You will also need the Windows Universal C runtime (UCRT):
diff --git a/win/configure b/win/configure
index 94e04f5..103e114 100755
--- a/win/configure
+++ b/win/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.72 for tcl 8.7.
+# Generated by GNU Autoconf 2.72 for tcl 9.0.
#
#
# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation,
@@ -601,8 +601,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='tcl'
PACKAGE_TARNAME='tcl'
-PACKAGE_VERSION='8.7'
-PACKAGE_STRING='tcl 8.7'
+PACKAGE_VERSION='9.0'
+PACKAGE_STRING='tcl 9.0'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''
@@ -654,10 +654,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
@@ -799,7 +795,6 @@ ac_user_opts='
enable_option_checking
with_encoding
enable_shared
-enable_time64bit
enable_64bit
enable_zipfs
enable_symbols
@@ -1362,7 +1357,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-'configure' configures tcl 8.7 to adapt to many kinds of systems.
+'configure' configures tcl 9.0 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1424,7 +1419,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of tcl 8.7:";;
+ short | recursive ) echo "Configuration of tcl 9.0:";;
esac
cat <<\_ACEOF
@@ -1433,7 +1428,6 @@ Optional Features:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--enable-shared build and link with shared libraries (default: on)
- --enable-time64bit force 64-bit time_t for 32-bit build (default: off)
--enable-64bit enable 64bit support (where applicable)
--enable-zipfs build with Zipfs support (default: on)
--enable-symbols build with debugging symbols (default: off)
@@ -1522,7 +1516,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.72
Copyright (C) 2023 Free Software Foundation, Inc.
@@ -1732,7 +1726,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.72. Invocation command line was
$ $0$ac_configure_args_raw
@@ -2414,10 +2408,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TCL_VERSION=8.7
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=7
-TCL_PATCH_LEVEL="b1"
+TCL_VERSION=9.0
+TCL_MAJOR_VERSION=9
+TCL_MINOR_VERSION=0
+TCL_PATCH_LEVEL="b2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
@@ -3945,27 +3939,6 @@ printf "%s\n" "#define STATIC_BUILD 1" >>confdefs.h
#--------------------------------------------------------------------
-# Check whether --enable-time64bit was given.
-#--------------------------------------------------------------------
-
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking force of 64-bit time_t" >&5
-printf %s "checking force of 64-bit time_t... " >&6; }
-# Check whether --enable-time64bit was given.
-if test ${enable_time64bit+y}
-then :
- enableval=$enable_time64bit; tcl_ok=$enableval
-else case e in #(
- e) tcl_ok=no ;;
-esac
-fi
-
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: \"$tcl_ok\"" >&5
-printf "%s\n" "\"$tcl_ok\"" >&6; }
-if test "$tcl_ok" = "yes"; then
- CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T"
-fi
-
-#--------------------------------------------------------------------
# The statements below define a collection of compile flags. This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
@@ -5885,8 +5858,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}\""
@@ -6014,12 +5987,6 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d
-# empty on win, but needs sub'ing
-
-
-
-
-
@@ -6577,7 +6544,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.72. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -6632,7 +6599,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.72,
with options \\"\$ac_cs_config\\"
diff --git a/win/configure.ac b/win/configure.ac
index 25fa29f..9f6e21a 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="b1"
+TCL_VERSION=9.0
+TCL_MAJOR_VERSION=9
+TCL_MINOR_VERSION=0
+TCL_PATCH_LEVEL="b2"
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 8720b66..261e0a2 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -52,7 +52,7 @@
# 64-bit compiler, if your SDK has it.
#
# Basic macros and options usable on the commandline (see rules.vc for more info):
-# OPTS=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$(VERSION)$(SUFX:t=).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
@@ -247,8 +246,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 \
@@ -454,6 +453,8 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
TCLSTUBOBJS = \
$(TMP_DIR)\tclStubLib.obj \
+ $(TMP_DIR)\tclStubCall.obj \
+ $(TMP_DIR)\tclStubLibTbl.obj \
$(TMP_DIR)\tclTomMathStubLib.obj \
$(TMP_DIR)\tclOOStubLib.obj \
$(TMP_DIR)\tclWinPanic.obj
@@ -812,10 +813,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
@@ -885,6 +883,9 @@ $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h
$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
$(cc32) $(appcflags) -Fo$@ $?
+$(TMP_DIR)\tclTestABSList.obj: $(GENERICDIR)\tclTestABSList.c
+ $(cc32) $(appcflags) -Fo$@ $?
+
$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
$(CCAPPCMD) $?
@@ -931,11 +932,11 @@ $(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c
### The following objects should be built using the stub interfaces
$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c
- $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?
$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
- $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?
### The following objects are part of the stub library and should not
@@ -945,6 +946,15 @@ $(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
$(cc32) $(stubscflags) -Fo$@ $?
+$(TMP_DIR)\tclStubCall.obj: $(GENERICDIR)\tclStubCall.c
+ $(cc32) $(stubscflags) \
+ /DCFG_RUNTIME_DLLFILE="\"$(TCLLIBNAME)\"" \
+ /DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ $(TCL_INCLUDES) -Fo$@ $?
+
+$(TMP_DIR)\tclStubLibTbl.obj: $(GENERICDIR)\tclStubLibTbl.c
+ $(cc32) $(stubscflags) $(TCL_INCLUDES) -Fo$@ $?
+
$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
$(cc32) $(stubscflags) -Fo$@ $?
@@ -1090,30 +1100,24 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
@if not exist "$(MODULE_INSTALL_DIR)" \
$(MKDIR) "$(MODULE_INSTALL_DIR)"
@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.6" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.6"
+ @if not exist "$(MODULE_INSTALL_DIR)\9.0" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0"
@$(COPY) "$(ROOT)\library\http\http.tcl" \
- "$(MODULE_INSTALL_DIR)\8.6\http-$(PKG_HTTP_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\http-$(PKG_HTTP_VER).tm"
@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.7" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.7"
@$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
- "$(MODULE_INSTALL_DIR)\8.7\msgcat-$(PKG_MSGCAT_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\msgcat-$(PKG_MSGCAT_VER).tm"
@echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.5" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.5"
@$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
- "$(MODULE_INSTALL_DIR)\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\tcltest-$(PKG_TCLTEST_VER).tm"
@echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.4" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4"
- @if not exist "$(MODULE_INSTALL_DIR)\8.4\platform" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4\platform"
+ @if not exist "$(MODULE_INSTALL_DIR)\9.0\platform" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0\platform"
@$(COPY) "$(ROOT)\library\platform\platform.tcl" \
- "$(MODULE_INSTALL_DIR)\8.4\platform-$(PKG_PLATFORM_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\platform-$(PKG_PLATFORM_VER).tm"
@echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\platform\shell.tcl" \
- "$(MODULE_INSTALL_DIR)\8.4\platform\shell-$(PKG_SHELL_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\platform\shell-$(PKG_SHELL_VER).tm"
!endif
@echo Installing $(TCLDDELIBNAME)
!if !$(STATIC_BUILD)
diff --git a/win/tcl.dsp b/win/tcl.dsp
index d033560..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 ""
@@ -1240,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..4bac910 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -985,13 +985,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
#------------------------------------------------------------------------
AC_DEFUN([SC_WITH_TCL], [
- if test -d ../../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..339d61e 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -215,8 +215,10 @@ 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]",
+ TCL_AUTO_LENGTH, TCL_EVAL_GLOBAL);
+
return TCL_OK;
}
@@ -277,11 +279,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 9b018e4..73b61ab 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -88,10 +88,6 @@ static int FileInputProc(void *instanceData, char *buf,
int toRead, int *errorCode);
static int FileOutputProc(void *instanceData,
const char *buf, int toWrite, int *errorCode);
-#ifndef TCL_NO_DEPRECATED
-static int FileSeekProc(void *instanceData, long offset,
- int mode, int *errorCode);
-#endif
static long long FileWideSeekProc(void *instanceData,
long long offset, int mode, int *errorCode);
static void FileSetupProc(void *clientData, int flags);
@@ -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. */
@@ -314,7 +306,7 @@ FileCheckProc(
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) {
SET_FLAG(infoPtr->flags, FILE_PENDING);
- evPtr = (FileEvent *)ckalloc(sizeof(FileEvent));
+ evPtr = (FileEvent *)Tcl_Alloc(sizeof(FileEvent));
evPtr->header.proc = FileEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -486,92 +478,13 @@ FileCloseProc(
break;
}
}
- ckfree(fileInfoPtr);
+ Tcl_Free(fileInfoPtr);
return errorCode;
}
/*
*----------------------------------------------------------------------
*
- * FileSeekProc --
- *
- * Seeks on a file-based channel. Returns the new position.
- *
- * Results:
- * -1 if failed, the new position if successful. If failed, it also sets
- * *errorCodePtr to the error code.
- *
- * Side effects:
- * Moves the location at which the channel will be accessed in future
- * operations.
- *
- *----------------------------------------------------------------------
- */
-#ifndef TCL_NO_DEPRECATED
-static int
-FileSeekProc(
- void *instanceData, /* File state. */
- long offset, /* Offset to seek to. */
- int mode, /* Relative to where should we seek? */
- int *errorCodePtr) /* To store error code. */
-{
- FileInfo *infoPtr = (FileInfo *)instanceData;
- LONG newPos, newPosHigh, oldPos, oldPosHigh;
- DWORD moveMethod;
-
- *errorCodePtr = 0;
- if (mode == SEEK_SET) {
- moveMethod = FILE_BEGIN;
- } else if (mode == SEEK_CUR) {
- moveMethod = FILE_CURRENT;
- } else {
- moveMethod = FILE_END;
- }
-
- /*
- * Save our current place in case we need to roll-back the seek.
- */
-
- oldPosHigh = 0;
- oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
- if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
- DWORD winError = GetLastError();
-
- if (winError != NO_ERROR) {
- Tcl_WinConvertError(winError);
- *errorCodePtr = errno;
- return -1;
- }
- }
-
- newPosHigh = (offset < 0 ? -1 : 0);
- newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
- if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
- DWORD winError = GetLastError();
-
- if (winError != NO_ERROR) {
- Tcl_WinConvertError(winError);
- *errorCodePtr = errno;
- return -1;
- }
- }
-
- /*
- * Check for expressability in our return type, and roll-back otherwise.
- */
-
- if (newPosHigh != 0) {
- *errorCodePtr = EOVERFLOW;
- SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN);
- return -1;
- }
- return (int) newPos;
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
* FileWideSeekProc --
*
* Seeks on a file-based channel. Returns the new position.
@@ -1555,9 +1468,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;
@@ -1608,7 +1520,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
@@ -1632,7 +1544,6 @@ OpenFileChannel(
*/
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}");
return infoPtr->channel;
}
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index c7e12ae..4ee8033 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -301,7 +301,7 @@ static ConsoleChannelInfo *gWatchingChannelList;
static const Tcl_ChannelType consoleChannelType = {
"console", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- TCL_CLOSE2PROC, /* Close proc. */
+ NULL, /* Close proc. */
ConsoleInputProc, /* Input proc. */
ConsoleOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -341,7 +341,7 @@ RingBufferInit(
if (capacity <= 0 || capacity > TCL_SIZE_MAX) {
Tcl_Panic("Internal error: invalid ring buffer capacity requested.");
}
- ringPtr->bufPtr = (char *) ckalloc(capacity);
+ ringPtr->bufPtr = (char *) Tcl_Alloc(capacity);
ringPtr->capacity = capacity;
ringPtr->start = 0;
ringPtr->length = 0;
@@ -367,7 +367,7 @@ RingBufferClear(
RingBuffer *ringPtr)
{
if (ringPtr->bufPtr) {
- ckfree(ringPtr->bufPtr);
+ Tcl_Free(ringPtr->bufPtr);
ringPtr->bufPtr = NULL;
}
ringPtr->capacity = 0;
@@ -900,7 +900,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;
@@ -1067,7 +1067,7 @@ ConsoleCloseProc(
/* There may be references already on the event queue */
chanInfoPtr->numRefs -= 1;
} else {
- ckfree(chanInfoPtr);
+ Tcl_Free(chanInfoPtr);
}
return errorCode;
@@ -1457,7 +1457,7 @@ ConsoleEventProc(
}
if (freeChannel) {
- ckfree(chanInfoPtr);
+ Tcl_Free(chanInfoPtr);
}
return 1;
@@ -1815,7 +1815,7 @@ ConsoleReaderThread(
*/
}
- ckfree(handleInfoPtr);
+ Tcl_Free(handleInfoPtr);
return 0;
}
@@ -1970,7 +1970,7 @@ ConsoleWriterThread(
RingBufferClear(&handleInfoPtr->buffer);
- ckfree(handleInfoPtr);
+ Tcl_Free(handleInfoPtr);
return 0;
}
@@ -2006,8 +2006,7 @@ AllocateConsoleHandleInfo(
ConsoleHandleInfo *handleInfoPtr;
DWORD consoleMode;
- handleInfoPtr = (ConsoleHandleInfo *) ckalloc(sizeof(*handleInfoPtr));
- memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));
+ handleInfoPtr = (ConsoleHandleInfo *) Tcl_Alloc(sizeof(*handleInfoPtr));
memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));
handleInfoPtr->console = consoleHandle;
InitializeSRWLock(&handleInfoPtr->lock);
@@ -2034,7 +2033,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;
}
@@ -2113,7 +2112,7 @@ TclWinOpenConsoleChannel(
ConsoleInit();
- chanInfoPtr = (ConsoleChannelInfo *)ckalloc(sizeof(*chanInfoPtr));
+ chanInfoPtr = (ConsoleChannelInfo *)Tcl_Alloc(sizeof(*chanInfoPtr));
memset(chanInfoPtr, 0, sizeof(*chanInfoPtr));
chanInfoPtr->permissions = permissions;
@@ -2172,7 +2171,7 @@ TclWinOpenConsoleChannel(
if (permissions == TCL_READABLE) {
SetConsoleMode(handle, chanInfoPtr->initMode);
}
- ckfree(chanInfoPtr);
+ Tcl_Free(chanInfoPtr);
return NULL;
}
@@ -2204,7 +2203,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;
}
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 5d45fe1..e7164df 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);
}
/*
@@ -1711,19 +1712,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);
}
}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index b27487f..17f4898 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -177,7 +177,7 @@ static int WinLink(const WCHAR *LinkSource,
const WCHAR *LinkTarget, int linkAction);
static int WinSymLinkDirectory(const WCHAR *LinkDirectory,
const WCHAR *LinkTarget);
-MODULE_SCOPE 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);
@@ -1554,12 +1535,12 @@ TclpGetUserHome(
result[i] = '/';
}
}
- NetApiBufferFree((void *) uiPtr);
+ NetApiBufferFree((void *)uiPtr);
}
Tcl_DStringFree(&ds);
}
if (wDomain != NULL) {
- NetApiBufferFree((void *) wDomain);
+ NetApiBufferFree((void *)wDomain);
}
return result;
@@ -2976,7 +2957,7 @@ TclpNativeToNormalized(
{
Tcl_DString ds;
Tcl_Obj *objPtr;
- Tcl_Size len;
+ size_t len;
char *copy, *p;
Tcl_DStringInit(&ds);
@@ -3107,7 +3088,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;
}
@@ -3206,7 +3187,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;
}
@@ -3322,7 +3303,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);
}
@@ -3338,7 +3319,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 3764a79..4234ceb 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
@@ -169,7 +169,7 @@ TclpInitLibraryPath(
*encodingPtr = NULL;
bytes = TclGetStringFromObj(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);
@@ -639,7 +626,7 @@ TclpFindVariable(
done:
Tcl_DStringFree(&envString);
- ckfree(nameUpper);
+ Tcl_Free(nameUpper);
return result;
}
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index dfe4d10..6de1432 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -80,7 +80,7 @@ typedef struct TclPipeThreadInfo {
} TclPipeThreadInfo;
-/* If pipe-workers will use some tcl subsystem, we can use 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 8d2e5b3..1cc7ae1 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -174,8 +174,8 @@ TclpDlopen(
* Succeded; package everything up for Tcl.
*/
- handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_));
- handlePtr->clientData = (void *) 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 795db74..2c93a41 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -100,7 +100,7 @@ TclpInitNotifier(void)
clazz.style = 0;
clazz.cbClsExtra = 0;
clazz.cbWndExtra = 0;
- clazz.hInstance = TclWinGetTclInstance();
+ clazz.hInstance = (HINSTANCE) TclWinGetTclInstance();
clazz.hbrBackground = NULL;
clazz.lpszMenuName = NULL;
clazz.lpszClassName = className;
@@ -188,7 +188,7 @@ TclpFinalizeNotifier(
if (notifierCount) {
notifierCount--;
if (notifierCount == 0) {
- UnregisterClassW(className, TclWinGetTclInstance());
+ UnregisterClassW(className, (HINSTANCE) TclWinGetTclInstance());
}
}
LeaveCriticalSection(&notifierMutex);
@@ -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
@@ -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 bb4983e..d587dda 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
@@ -1329,7 +1334,7 @@ ApplicationType(
}
header.e_magic = 0;
- ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL);
+ ReadFile(hFile, (void *)&header, sizeof(header), &read, NULL);
if (header.e_magic != IMAGE_DOS_SIGNATURE) {
/*
* Doesn't have the magic number for relocatable executables. If
@@ -1364,7 +1369,7 @@ ApplicationType(
buf[0] = '\0';
SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN);
- ReadFile(hFile, (void *) buf, 2, &read, NULL);
+ ReadFile(hFile, (void *)buf, 2, &read, NULL);
CloseHandle(hFile);
if ((buf[0] == 'N') && (buf[1] == 'E')) {
@@ -1536,14 +1541,14 @@ 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 */
@@ -1769,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();
@@ -1836,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;
}
@@ -1882,10 +1880,10 @@ Tcl_CreatePipe(
return TCL_ERROR;
}
- *rchan = Tcl_MakeFileChannel((void *) readHandle, TCL_READABLE);
+ *rchan = Tcl_MakeFileChannel((void *)readHandle, TCL_READABLE);
Tcl_RegisterChannel(interp, *rchan);
- *wchan = Tcl_MakeFileChannel((void *) writeHandle, TCL_WRITABLE);
+ *wchan = Tcl_MakeFileChannel((void *)writeHandle, TCL_WRITABLE);
Tcl_RegisterChannel(interp, *wchan);
return TCL_OK;
@@ -1915,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.
@@ -1930,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;
}
}
@@ -2123,7 +2122,8 @@ PipeClose2Proc(
errChan = Tcl_MakeFileChannel((void *)filePtr->handle,
TCL_READABLE);
- ckfree(filePtr);
+ Tcl_Free(filePtr);
+ Tcl_SetChannelOption(NULL, errChan, "-profile", "replace");
} else {
errChan = NULL;
}
@@ -2133,14 +2133,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;
@@ -2309,10 +2309,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;
@@ -2515,12 +2515,12 @@ PipeGetHandleProc(
if (direction == TCL_READABLE && infoPtr->readFile) {
filePtr = (WinFile*) infoPtr->readFile;
- *handlePtr = (void *) filePtr->handle;
+ *handlePtr = (void *)filePtr->handle;
return TCL_OK;
}
if (direction == TCL_WRITABLE && infoPtr->writeFile) {
filePtr = (WinFile*) infoPtr->writeFile;
- *handlePtr = (void *) filePtr->handle;
+ *handlePtr = (void *)filePtr->handle;
return TCL_OK;
}
return TCL_ERROR;
@@ -2574,7 +2574,7 @@ Tcl_WaitPid(
prevPtrPtr = &procList;
for (infoPtr = procList; infoPtr != NULL;
prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
- if (infoPtr->dwProcessId == PTR2UINT(pid)) {
+ if (infoPtr->dwProcessId == (Tcl_Size)pid) {
*prevPtrPtr = infoPtr->nextPtr;
break;
}
@@ -2684,7 +2684,7 @@ Tcl_WaitPid(
} else {
errno = ECHILD;
*statPtr = 0xC0000000 | ECHILD;
- result = (Tcl_Pid) -1;
+ result = (Tcl_Pid)-1;
}
/*
@@ -2692,7 +2692,7 @@ Tcl_WaitPid(
*/
CloseHandle(infoPtr->hProcess);
- ckfree(infoPtr);
+ Tcl_Free(infoPtr);
return result;
}
@@ -2720,7 +2720,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();
@@ -2759,16 +2759,15 @@ 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, TclGetString(objv[1]),
NULL);
@@ -2783,8 +2782,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);
}
@@ -3266,7 +3266,7 @@ TclpOpenTemporaryFile(
TclDecrRefCount(tmpObj);
}
- return Tcl_MakeFileChannel((void *) handle,
+ return Tcl_MakeFileChannel((void *)handle,
TCL_READABLE|TCL_WRITABLE);
gotError:
@@ -3297,7 +3297,7 @@ TclPipeThreadCreateTI(
#ifndef _PTI_USE_CKALLOC
pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo));
#else
- pipeTI = (TclPipeThreadInfo *)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;
@@ -3658,7 +3658,7 @@ TclPipeThreadStop(
#ifndef _PTI_USE_CKALLOC
free(pipeTI);
#else
- ckfree(pipeTI);
+ Tcl_Free(pipeTI);
#endif /* !_PTI_USE_CKALLOC */
}
}
@@ -3708,7 +3708,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/tclWinSerial.c b/win/tclWinSerial.c
index 635e978..d8193b4 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -204,7 +204,7 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
static const Tcl_ChannelType serialChannelType = {
"serial", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- TCL_CLOSE2PROC, /* Close proc. */
+ NULL, /* Close proc. */
SerialInputProc, /* Input proc. */
SerialOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -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);
@@ -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:
@@ -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;
@@ -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);
@@ -1507,13 +1507,7 @@ TclWinOpenSerialChannel(
infoPtr->evWritable), 0, NULL);
}
- /*
- * Files have default translation of AUTO and ^Z eof char, which means
- * that a ^Z will be accepted as EOF when reading.
- */
-
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}");
return infoPtr->channel;
}
@@ -1781,7 +1775,7 @@ SerialSetOptionProc(
" two elements with each a single 8-bit character", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", (char *)NULL);
}
- ckfree(argv);
+ Tcl_Free((void *)argv);
return TCL_ERROR;
}
@@ -1812,7 +1806,7 @@ SerialSetOptionProc(
}
dcb.XoffChar = (char) character;
}
- ckfree(argv);
+ Tcl_Free((void *)argv);
if (!SetCommState(infoPtr->handle, &dcb)) {
goto setStateFailed;
@@ -1838,7 +1832,7 @@ SerialSetOptionProc(
"a list of signal,value pairs", value));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", (char *)NULL);
}
- ckfree(argv);
+ Tcl_Free((void *)argv);
return TCL_ERROR;
}
@@ -1896,7 +1890,7 @@ SerialSetOptionProc(
}
}
- ckfree(argv);
+ Tcl_Free((void *)argv);
return res;
}
@@ -1922,7 +1916,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) {
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 0dd7871..c51d69d 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -242,12 +242,12 @@ static int FindFDInList(TcpState *statePtr, SOCKET socket);
static DWORD WINAPI SocketThread(LPVOID arg);
static void TcpThreadActionProc(void *instanceData,
int action);
+static int TcpCloseProc(void *, Tcl_Interp *);
static Tcl_EventCheckProc SocketCheckProc;
static Tcl_EventProc SocketEventProc;
static Tcl_EventSetupProc SocketSetupProc;
static Tcl_DriverBlockModeProc TcpBlockModeProc;
-static Tcl_DriverCloseProc TcpCloseProc;
static Tcl_DriverClose2Proc TcpClose2Proc;
static Tcl_DriverSetOptionProc TcpSetOptionProc;
static Tcl_DriverGetOptionProc TcpGetOptionProc;
@@ -264,11 +264,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc;
static const Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
-#ifndef TCL_NO_DEPRECATED
- TcpCloseProc, /* Close proc. */
-#else
- TCL_CLOSE2PROC, /* Close proc. */
-#endif
+ NULL, /* Close proc. */
TcpInputProc, /* Input proc. */
TcpOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -348,7 +344,7 @@ printaddrinfolist(
void
InitializeHostName(
char **valuePtr,
- TCL_HASH_TYPE *lengthPtr,
+ size_t *lengthPtr,
Tcl_Encoding *encodingPtr)
{
WCHAR wbuf[256];
@@ -376,15 +372,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);
}
@@ -1056,7 +1052,7 @@ TcpCloseProc(
Tcl_WinConvertError((DWORD) WSAGetLastError());
errorCode = Tcl_GetErrno();
}
- ckfree(thisfd);
+ Tcl_Free(thisfd);
}
if (statePtr->addrlist != NULL) {
@@ -1097,7 +1093,7 @@ TcpCloseProc(
* fear of damaging the list.
*/
- ckfree(statePtr);
+ Tcl_Free(statePtr);
return errorCode;
}
@@ -1734,7 +1730,7 @@ TcpConnect(
* Set kernel space buffering
*/
- TclSockMinimumBuffers((void *) statePtr->sockets->fd,
+ TclSockMinimumBuffers((void *)statePtr->sockets->fd,
TCP_BUFFER_SIZE);
/*
@@ -2030,11 +2026,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;
@@ -2273,7 +2269,7 @@ Tcl_OpenTcpServerEx(
SendSelectMessage(tsdPtr, SELECT, statePtr);
if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close(NULL, statePtr->channel);
+ Tcl_CloseEx(NULL, statePtr->channel, 0);
return NULL;
}
return statePtr->channel;
@@ -2345,12 +2341,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;
}
@@ -2547,7 +2543,7 @@ SocketCheckProc(
statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
&& !GOT_BITS(statePtr->flags, SOCKET_PENDING)) {
SET_BITS(statePtr->flags, SOCKET_PENDING);
- evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent));
+ evPtr = (SocketEvent *)Tcl_Alloc(sizeof(SocketEvent));
evPtr->header.proc = SocketEventProc;
evPtr->socket = statePtr->sockets->fd;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -2822,7 +2818,7 @@ AddSocketInfoFd(
* Add the first FD.
*/
- statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList));
+ statePtr->sockets = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
fds = statePtr->sockets;
} else {
/*
@@ -2833,7 +2829,7 @@ AddSocketInfoFd(
fds = fds->next;
}
- fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList));
+ fds->next = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
fds = fds->next;
}
@@ -2866,7 +2862,7 @@ AddSocketInfoFd(
static TcpState *
NewSocketInfo(SOCKET socket)
{
- TcpState *statePtr = (TcpState *)ckalloc(sizeof(TcpState));
+ TcpState *statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
memset(statePtr, 0, sizeof(TcpState));
@@ -3229,68 +3225,6 @@ FindFDInList(
/*
*----------------------------------------------------------------------
*
- * TclWinGetSockOpt, et al. --
- *
- * Those functions are historically exported by the stubs table and
- * just use the original system calls now.
- *
- * Warning:
- * Those functions are depreciated and will be removed with TCL 9.0.
- *
- * Results:
- * As defined for each function.
- *
- * Side effects:
- * As defined for each function.
- *
- *----------------------------------------------------------------------
- */
-
-#ifndef TCL_NO_DEPRECATED
-#undef TclWinGetSockOpt
-int
-TclWinGetSockOpt(
- SOCKET s,
- int level,
- int optname,
- char *optval,
- int *optlen)
-{
-
- return getsockopt(s, level, optname, optval, optlen);
-}
-#undef TclWinSetSockOpt
-int
-TclWinSetSockOpt(
- SOCKET s,
- int level,
- int optname,
- const char *optval,
- int optlen)
-{
- return setsockopt(s, level, optname, optval, optlen);
-}
-
-#undef TclpInetNtoa
-char *
-TclpInetNtoa(
- struct in_addr addr)
-{
- return inet_ntoa(addr);
-}
-#undef TclWinGetServByName
-struct servent *
-TclWinGetServByName(
- const char *name,
- const char *proto)
-{
- return getservbyname(name, proto);
-}
-#endif /* TCL_NO_DEPRECATED */
-
-/*
- *----------------------------------------------------------------------
- *
* TcpThreadActionProc --
*
* Insert or remove any thread local refs to this channel.
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index ec12f67..753fe12 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;
}
@@ -310,28 +310,6 @@ TestwinsleepCmd(
return TCL_OK;
}
-static int
-TestSizeCmd(
- TCL_UNUSED(void *),
- Tcl_Interp* interp, /* Tcl interpreter */
- int objc, /* Parameter count */
- Tcl_Obj *const * objv) /* Parameter vector */
-{
-
- if (objc != 2) {
- goto syntax;
- }
- if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) {
- Tcl_StatBuf *statPtr;
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime)));
- return TCL_OK;
- }
-
-syntax:
- Tcl_WrongNumArgs(interp, 1, objv, "st_mtime");
- return TCL_ERROR;
-}
-
/*
*----------------------------------------------------------------------
*
@@ -480,15 +458,15 @@ 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;
}
/*
@@ -521,19 +499,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 */
@@ -557,10 +535,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);
@@ -588,7 +566,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;
}
@@ -612,16 +590,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) {
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index e8d4d4d..01db9f3 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. */
- void *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);
@@ -567,7 +567,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);
@@ -628,7 +628,7 @@ TclpFinalizeMutex(
if (csPtr != NULL) {
DeleteCriticalSection(csPtr);
- ckfree(csPtr);
+ Tcl_Free(csPtr);
*mutexPtr = NULL;
}
}
@@ -710,7 +710,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;
@@ -921,7 +921,7 @@ TclpFinalizeCondition(
if (winCondPtr != NULL) {
DeleteCriticalSection(&winCondPtr->condLock);
- ckfree(winCondPtr);
+ Tcl_Free(winCondPtr);
*condPtr = NULL;
}
}
@@ -1036,7 +1036,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 438a8ec..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,9 +108,6 @@ static struct {
* Declarations for functions defined later in this file.
*/
-#ifndef TCL_NO_DEPRECATED
-static struct tm * ComputeGMT(const time_t *tp);
-#endif /* TCL_NO_DEPRECATED */
static void StopCalibration(void *clientData);
static DWORD WINAPI CalibrationThread(LPVOID arg);
static void UpdateTimeEachSecond(void);
@@ -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);
}
@@ -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;
}
@@ -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;
}
}
@@ -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
generated by cgit v0.12 at 2024-08-21 16:48:12 (GMT)