diff options
Diffstat (limited to 'win')
-rw-r--r-- | win/Makefile.in | 58 | ||||
-rw-r--r-- | win/README | 8 | ||||
-rwxr-xr-x | win/configure | 63 | ||||
-rw-r--r-- | win/configure.ac | 34 | ||||
-rw-r--r-- | win/makefile.vc | 56 | ||||
-rw-r--r-- | win/tcl.dsp | 24 | ||||
-rw-r--r-- | win/tcl.m4 | 8 | ||||
-rw-r--r-- | win/tclAppInit.c | 11 | ||||
-rw-r--r-- | win/tclConfig.sh.in | 14 | ||||
-rw-r--r-- | win/tclWin32Dll.c | 84 | ||||
-rw-r--r-- | win/tclWinChan.c | 99 | ||||
-rw-r--r-- | win/tclWinConsole.c | 26 | ||||
-rw-r--r-- | win/tclWinError.c | 12 | ||||
-rw-r--r-- | win/tclWinFCmd.c | 24 | ||||
-rw-r--r-- | win/tclWinFile.c | 39 | ||||
-rw-r--r-- | win/tclWinInit.c | 39 | ||||
-rw-r--r-- | win/tclWinInt.h | 2 | ||||
-rw-r--r-- | win/tclWinLoad.c | 8 | ||||
-rw-r--r-- | win/tclWinNotify.c | 15 | ||||
-rw-r--r-- | win/tclWinPanic.c | 4 | ||||
-rw-r--r-- | win/tclWinPipe.c | 112 | ||||
-rw-r--r-- | win/tclWinPort.h | 13 | ||||
-rw-r--r-- | win/tclWinSerial.c | 32 | ||||
-rw-r--r-- | win/tclWinSock.c | 102 | ||||
-rw-r--r-- | win/tclWinTest.c | 56 | ||||
-rw-r--r-- | win/tclWinThrd.c | 18 | ||||
-rw-r--r-- | win/tclWinTime.c | 345 |
27 files changed, 336 insertions, 970 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index e71c5f3..799c584 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"; \ @@ -1122,7 +1158,7 @@ genscript: # # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool -# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & +# workspace. It depends on the Tcl & Tk being in directories called tcl9.* & # tk8.* up two directories from the TOOL_DIR. # @@ -1,4 +1,4 @@ -Tcl 8.7 for Windows +Tcl 9.0 for Windows 1. Introduction --------------- @@ -16,7 +16,7 @@ The information in this file is maintained on the web at: In order to compile Tcl for Windows, you need the following: - Tcl 8.7 Source Distribution (plus any patches) + Tcl 9.0 Source Distribution (plus any patches) and @@ -80,9 +80,9 @@ Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. -Note that in order to run tclsh87.exe, you must ensure that tcl87.dll, +Note that in order to run tclsh90.exe, you must ensure that tcl90.dll, libtommath.dll and zlib1.dll are on your path, in the system -directory, or in the directory containing tclsh87.exe. +directory, or in the directory containing tclsh90.exe. Note: Tcl no longer provides support for systems earlier than Windows 7. You will also need the Windows Universal C runtime (UCRT): diff --git a/win/configure b/win/configure index 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
@@ -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(¬ifierMutex); @@ -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 |