diff options
Diffstat (limited to 'win')
-rw-r--r-- | win/Makefile.in | 9 | ||||
-rwxr-xr-x | win/configure | 2 | ||||
-rw-r--r-- | win/makefile.bc | 594 | ||||
-rw-r--r-- | win/makefile.vc | 7 | ||||
-rw-r--r-- | win/nmakehlp.c | 24 | ||||
-rw-r--r-- | win/rules.vc | 15 | ||||
-rw-r--r-- | win/tcl.dsp | 20 | ||||
-rw-r--r-- | win/tcl.m4 | 2 | ||||
-rw-r--r-- | win/tclWin32Dll.c | 6 | ||||
-rw-r--r-- | win/tclWinFCmd.c | 14 | ||||
-rw-r--r--[-rwxr-xr-x] | win/tclWinFile.c | 24 | ||||
-rw-r--r-- | win/tclWinInit.c | 17 | ||||
-rw-r--r-- | win/tclWinPort.h | 2 | ||||
-rw-r--r-- | win/tclWinSock.c | 742 | ||||
-rw-r--r-- | win/tclWinThrd.c | 8 | ||||
-rw-r--r-- | win/tclWinTime.c | 72 |
16 files changed, 600 insertions, 958 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index 066e6b1..e967ef3 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -197,7 +197,7 @@ RM = rm -f COPY = cp CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ --I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH \ +-I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \ -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} @@ -205,7 +205,7 @@ CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ --I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ +-I"${GENERIC_DIR_NATIVE}" -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ ${COMPILE_DEBUG_FLAGS} @@ -328,6 +328,7 @@ TOMMATH_OBJS = \ bn_mp_div_3.${OBJEXT} \ bn_mp_exch.${OBJEXT} \ bn_mp_expt_d.${OBJEXT} \ + bn_mp_expt_d_ex.${OBJEXT} \ bn_mp_grow.${OBJEXT} \ bn_mp_init.${OBJEXT} \ bn_mp_init_copy.${OBJEXT} \ @@ -651,8 +652,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.8.9 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.9.tm; + @echo "Installing package http 2.8.10 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.10.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ diff --git a/win/configure b/win/configure index b8c4d0f..1eba1c0 100755 --- a/win/configure +++ b/win/configure @@ -4167,7 +4167,7 @@ $as_echo "using shared flags" >&6; } CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wsign-compare -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= diff --git a/win/makefile.bc b/win/makefile.bc deleted file mode 100644 index bee61d7..0000000 --- a/win/makefile.bc +++ /dev/null @@ -1,594 +0,0 @@ -#
-# Makefile for Borland C++ 5.5 (or C++ Builder 5), adapted from the makefile
-# for Visual C++ that came with tcl 8.3.3
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-
-# TIP #59 information.
-#
-# This makefile does not set the following configuration cpp
-# defines. Behind the defines are the makefile variables listed to set
-# to -D... when that feature is enabled.
-#
-# - TCL_CFG_PROFILED PROFDEFINES
-# - TCL_CFG_OPTIMIZED OPTDEFINES
-# - TCL_CFG_DO64BIT SIXFOURDEFINES
-
-# Have a look at the complete description on how to build and test Tcl with
-# the current Borland compilers at www.ratiosoft.com/tcl/borland.
-#
-# Usage:
-# - Adapt the paths below to match your compiler's location
-# - Make sure the compiler's bin directory is on your path
-# - Open a console
-# - To make a debug version enter
-# make -fmakefile.bc -DNODEBUG=0 xxx
-# where 'xxx' is the target you want (e.g. 'all', 'test', ...)
-# Please note: I omitted the 'd' suffix for debug versions because Tcl
-# will always call tclpip83.dll and not tclpip83d.dll, causing an error.
-# ^
-# Besides, the debug version goes into a separate directory, so there
-# should be no problem having DLLs and EXEs with the same name.
-# If you prefer your debug version having the 'd' suffix just uncomment
-# the line
-# #DBGX = d
-#
-# - To make a 'normal' version enter
-# make -fmakefile.bc xxx
-# where 'xxx' is the target you want (e.g. 'all', 'test', ...)
-#
-# DISCLAIMER:
-# This makefile has an experimental status - that is those targets which
-# have been modified do in fact compile and link with Borland's C++
-# Builder 5 and with the free Borland compiler (Borland C++ 5.5).
-# However the author assumes no responsiblity for any effect which the use of
-# this makefile or of the resulting programs might have on your system.
-#
-# Not yet modified:
-# - The 'plug-in-DLL' and the associated shell.
-#
-# Suggestions and / or improvements are always welcome.
-#
-# May 2001, H. Giese (hgiese@ratiosoft.com)
-#
-
-# Does not depend on the presence of any environment variables in
-# order to compile tcl; all needed information is derived from
-# location of the compiler directories.
-
-#
-# Project directories
-#
-# ROOT = top of source tree
-#
-# TOOLS32 = location of Borland development tools.
-#
-# INSTALLDIR = where the install-targets should copy the binaries and
-# support files
-#
-
-ROOT = ..
-INSTALLDIR = c:\program files\tcl
-
-# If you have C++ Builder 5 or the free Borland C++ 5.5 compiler
-# adapt the following paths as appropriate for your system
-TOOLS32 = c:\dev\bcc55
-TOOLS32_rc = c:\dev\bcc55
-#TOOLS32 = c:\bc55
-#TOOLS32_rc = c:\bc55
-
-cc32 = "$(TOOLS32)\bin\bcc32.exe"
-link32 = "$(TOOLS32)\bin\ilink32.exe"
-lib32 = "$(TOOLS32)\bin\tlib.exe"
-rc32 = "$(TOOLS32_rc)\bin\brcc32.exe"
-include32 = -I"$(TOOLS32)\include"
-libpath32 = -L"$(TOOLS32)\lib"
-
-# Uncomment the following line to compile with thread support
-#THREADDEFINES = -DTCL_THREADS=1
-
-# Allow definition of NDEBUG via command line
-# Set NODEBUG to 0 to compile with symbols
-!if !defined(NODEBUG)
-NODEBUG = 1
-!endif
-
-# CFG_ENCODING=encoding
-# name of encoding for configuration information. Defaults
-# to cp1252
-!if !defined(CFG_ENCODING)
-CFG_ENCODING = \"cp1252\"
-!endif
-
-# The following defines can be used to control the amount of debugging
-# code that is added to the compilation.
-#
-# -DTCL_MEM_DEBUG Enables the debugging memory allocator.
-# -DTCL_COMPILE_DEBUG Enables byte compilation logging.
-# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering.
-# -DUSE_TCLALLOC=0 Disables the Tcl memory allocator in favor
-# of the native malloc implementation. This is
-# needed when using Purify.
-#
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
-#DEBUGDEFINES = -DUSE_TCLALLOC=0
-
-######################################################################
-# Do not modify below this line
-######################################################################
-
-NAMEPREFIX = tcl
-STUBPREFIX = $(NAMEPREFIX)stub
-DOTVERSION = 8.7
-VERSION = 87
-
-DDEVERSION = 14
-DDEDOTVERSION = 1.4
-
-REGVERSION = 13
-REGDOTVERSION = 1.3
-
-BINROOT = ..
-!IF "$(NODEBUG)" == "1"
-TMPDIRNAME = Release
-DBGX =
-SYMDEFINES = -DNDEBUG
-!ELSE
-TMPDIRNAME = Debug
-#DBGX = d
-DBGX =
-SYMDEFINES = -DTCL_CFG_DEBUG
-!ENDIF
-TMPDIR = $(BINROOT)\$(TMPDIRNAME)
-OUTDIRNAME = $(TMPDIRNAME)
-OUTDIR = $(TMPDIR)
-
-TCLLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib
-TCLDLLNAME = $(NAMEPREFIX)$(VERSION)$(DBGX).dll
-TCLDLL = $(OUTDIR)\$(TCLDLLNAME)
-
-TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION)$(DBGX).lib
-TCLSTUBLIB = $(OUTDIR)\$(TCLSTUBLIBNAME)
-
-TCLPLUGINLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib
-TCLPLUGINDLLNAME = $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
-TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME)
-TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
-TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
-TCLREGDLLNAME = $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll
-TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME)
-TCLDDEDLLNAME = $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll
-TCLDDEDLL = $(OUTDIR)\$(TCLDDEDLLNAME)
-TCLTEST = $(OUTDIR)\$(NAMEPREFIX)test.exe
-CAT32 = $(TMPDIR)\cat32.exe
-RMDIR = .\rmd.bat
-MKDIR = .\mkd.bat
-RM = del
-
-LIB_INSTALL_DIR = $(INSTALLDIR)\lib
-BIN_INSTALL_DIR = $(INSTALLDIR)\bin
-SCRIPT_INSTALL_DIR = $(INSTALLDIR)\lib\tcl$(DOTVERSION)
-INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
-
-TCLSHOBJS = \
- $(TMPDIR)\tclAppInit.obj
-
-TCLTESTOBJS = \
- $(TMPDIR)\tclTest.obj \
- $(TMPDIR)\tclTestObj.obj \
- $(TMPDIR)\tclTestProcBodyObj.obj \
- $(TMPDIR)\tclThreadTest.obj \
- $(TMPDIR)\tclWinTest.obj \
- $(TMPDIR)\testMain.obj
-
-TCLOBJS = \
- $(TMPDIR)\regcomp.obj \
- $(TMPDIR)\regexec.obj \
- $(TMPDIR)\regfree.obj \
- $(TMPDIR)\regerror.obj \
- $(TMPDIR)\tclAlloc.obj \
- $(TMPDIR)\tclAsync.obj \
- $(TMPDIR)\tclBasic.obj \
- $(TMPDIR)\tclBinary.obj \
- $(TMPDIR)\tclCkalloc.obj \
- $(TMPDIR)\tclClock.obj \
- $(TMPDIR)\tclCmdAH.obj \
- $(TMPDIR)\tclCmdIL.obj \
- $(TMPDIR)\tclCmdMZ.obj \
- $(TMPDIR)\tclCompCmds.obj \
- $(TMPDIR)\tclCompCmdsGR.obj \
- $(TMPDIR)\tclCompCmdsSZ.obj \
- $(TMPDIR)\tclCompExpr.obj \
- $(TMPDIR)\tclCompile.obj \
- $(TMPDIR)\tclConfig.obj \
- $(TMPDIR)\tclDate.obj \
- $(TMPDIR)\tclDictObj.obj \
- $(TMPDIR)\tclDisassemble.obj \
- $(TMPDIR)\tclEncoding.obj \
- $(TMPDIR)\tclEnsemble.obj \
- $(TMPDIR)\tclEnv.obj \
- $(TMPDIR)\tclEvent.obj \
- $(TMPDIR)\tclExecute.obj \
- $(TMPDIR)\tclFCmd.obj \
- $(TMPDIR)\tclFileName.obj \
- $(TMPDIR)\tclGet.obj \
- $(TMPDIR)\tclHash.obj \
- $(TMPDIR)\tclHistory.obj \
- $(TMPDIR)\tclIndexObj.obj \
- $(TMPDIR)\tclInterp.obj \
- $(TMPDIR)\tclIO.obj \
- $(TMPDIR)\tclIOCmd.obj \
- $(TMPDIR)\tclIOGT.obj \
- $(TMPDIR)\tclIOSock.obj \
- $(TMPDIR)\tclIOUtil.obj \
- $(TMPDIR)\tclLink.obj \
- $(TMPDIR)\tclLiteral.obj \
- $(TMPDIR)\tclListObj.obj \
- $(TMPDIR)\tclLoad.obj \
- $(TMPDIR)\tclMain.obj \
- $(TMPDIR)\tclNamesp.obj \
- $(TMPDIR)\tclNotify.obj \
- $(TMPDIR)\tclOO.obj \
- $(TMPDIR)\tclOOBasic.obj \
- $(TMPDIR)\tclOOCall.obj \
- $(TMPDIR)\tclOODefineCmds.obj \
- $(TMPDIR)\tclOOInfo.obj \
- $(TMPDIR)\tclOOMethod.obj \
- $(TMPDIR)\tclOOStubInit.obj \
- $(TMPDIR)\tclObj.obj \
- $(TMPDIR)\tclOptimize.obj \
- $(TMPDIR)\tclPanic.obj \
- $(TMPDIR)\tclParse.obj \
- $(TMPDIR)\tclPipe.obj \
- $(TMPDIR)\tclPkg.obj \
- $(TMPDIR)\tclPkgConfig.obj \
- $(TMPDIR)\tclPosixStr.obj \
- $(TMPDIR)\tclPreserve.obj \
- $(TMPDIR)\tclProc.obj \
- $(TMPDIR)\tclRegexp.obj \
- $(TMPDIR)\tclResolve.obj \
- $(TMPDIR)\tclResult.obj \
- $(TMPDIR)\tclScan.obj \
- $(TMPDIR)\tclStringObj.obj \
- $(TMPDIR)\tclStubInit.obj \
- $(TMPDIR)\tclThread.obj \
- $(TMPDIR)\tclThreadJoin.obj \
- $(TMPDIR)\tclTimer.obj \
- $(TMPDIR)\tclTrace.obj \
- $(TMPDIR)\tclUtf.obj \
- $(TMPDIR)\tclUtil.obj \
- $(TMPDIR)\tclVar.obj \
- $(TMPDIR)\tclWin32Dll.obj \
- $(TMPDIR)\tclWinChan.obj \
- $(TMPDIR)\tclWinConsole.obj \
- $(TMPDIR)\tclWinSerial.obj \
- $(TMPDIR)\tclWinError.obj \
- $(TMPDIR)\tclWinFCmd.obj \
- $(TMPDIR)\tclWinFile.obj \
- $(TMPDIR)\tclWinInit.obj \
- $(TMPDIR)\tclWinLoad.obj \
- $(TMPDIR)\tclWinNotify.obj \
- $(TMPDIR)\tclWinPipe.obj \
- $(TMPDIR)\tclWinSock.obj \
- $(TMPDIR)\tclWinThrd.obj \
- $(TMPDIR)\tclWinTime.obj \
- $(TMPDIR)\tclZlib.obj
-
-TCLSTUBOBJS = \
- $(TMPDIR)\tclStubLib.obj \
- $(TMPDIR)\tclTomMathStubLib.obj \
- $(TMPDIR)\tclOOStubLib.obj
-
-WINDIR = $(ROOT)\win
-GENERICDIR = $(ROOT)\generic
-
-TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
-TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \
- $(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \
- -DTCL_CFGVAL_ENCODING=${CFG_ENCODING}
-### TODO: Add -DHAVE_ZLIB=1
-
-######################################################################
-# Compiler flags
-######################################################################
-
-!IF "$(NODEBUG)" == "1"
-# these macros cause maximum optimization and no symbols
-cdebug = -v- -vi- -O2 -D_DEBUG
-!ELSE
-# these macros enable debugging
-cdebug = -k -Od -r- -v -vi- -y
-!ENDIF
-
-SYSDEFINES = _MT;NO_STRICT;_NO_VCL
-
-# declarations common to all compiler options
-cbase = -c -q -3 -a4 -g0 -tWM -Ve -Vx -X-
-WARNINGS = -w-rch -w-pch -w-par -w-dup -w-pro -w-dpu
-
-ccons = -tWC
-
-INCLUDEPATH = $(include32) $(TCL_INCLUDES)
-
-CFLAGS = $(cdebug) $(cbase) $(INCLUDEPATH) $(WARNINGS) -D$(SYSDEFINES)
-TCL_CFLAGS = $(CFLAGS) $(TCL_DEFINES)
-CONS_CFLAGS = $(CFLAGS) $(TCL_DEFINES) $(ccons)
-
-######################################################################
-# Linker flags
-######################################################################
-
-!IF "$(NODEBUG)" == "1"
-ldebug =
-!ELSE
-ldebug = -v
-!ENDIF
-
-# declarations common to all linker options
-LNFLAGS = -D"" -Gn -I$(TMPDIR) -x $(ldebug) $(libpath32)
-# -Gi: create lib file (is -Gl in doc)
-# -aa: Windows app, -ap: Windows console app
-LNFLAGS_DLL = -ap -Gi -Tpd
-LNFLAGS_CONS = -ap -Tpe
-
-LNLIBS = import32 cw32mt
-
-
-######################################################################
-# Project specific targets
-######################################################################
-
-release: setup $(TCLSH) dlls
-dlls: setup $(TCLREGDLL) $(TCLDDEDLL)
-all: setup $(TCLSH) dlls $(CAT32)
-tcltest: setup $(TCLTEST) dlls $(CAT32)
-plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
-install: install-binaries install-libraries
-
-test: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT)/library
- $(TCLTEST) $(ROOT)/tests/all.tcl
-
-setup:
- @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) &\
- echo *** Created directory '$(OUT_DIR)'
- @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) &\
- echo *** Created directory '$(TMP_DIR)'
-
-
-$(TCLLIB): $(TCLDLL)
-
-$(TCLDLL): $(TCLOBJS) $(TMPDIR)\$(NAMEPREFIX).res
- $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 @&&!
- $(TCLOBJS), $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
-!
-
-$(TCLSTUBLIB): $(TCLSTUBOBJS)
- $(lib32) /u $@ $(TCLSTUBOBJS)
-
-$(TCLPLUGINLIB): $(TCLPLUGINDLL)
-
-$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\tcl.res
- $(link32) $(ldebug) $(dlllflags) \
- -out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @&&!
-$(TCLOBJS)
-!
-
-$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
- $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
- $(TCLSHOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
-!
-
-$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res
- $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
- -out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS)
-
-$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
- $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
- $(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
-!
-
-$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
- $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
- $(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
- $(TMPDIR)\$(NAMEPREFIX).res
-
-$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB)
- $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
- $(TMPDIR)\tclWinReg.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
- $(TMPDIR)\$(NAMEPREFIX).res
-
-$(CAT32): $(WINDIR)\cat.c
- $(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $?
- $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
- $(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),,
-
-install-binaries: $(TCLSH)
- $(MKDIR) "$(BIN_INSTALL_DIR)"
- $(MKDIR) "$(LIB_INSTALL_DIR)"
- @echo Installing $(TCLDLLNAME)
- @copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)"
- @copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
- @echo Installing "$(TCLSH)"
- @copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
- @echo Installing $(TCLSTUBLIBNAME)
- @copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)"
- @echo Installing $(WINDIR)\tclooConfig.sh
- @copy "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)"
-
-install-libraries:
- -@$(MKDIR) "$(LIB_INSTALL_DIR)"
- -@$(MKDIR) "$(INCLUDE_INSTALL_DIR)"
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
- @echo Installing http1.0
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0"
- -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
- -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
- @echo Installing http2.8
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.8"
- -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8"
- -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8"
- @echo Installing opt0.4
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
- -@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
- -@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
- @echo Installing msgcat1.5
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
- -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
- -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
- @echo Installing tcltest2.3
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
- -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
- -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
- @echo Installing platform1.0
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\platform1.0"
- -@copy "$(ROOT)\library\platform\platform.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
- -@copy "$(ROOT)\library\platform\shell.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
- -@copy "$(ROOT)\library\platform\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
- @echo Installing $(TCLDDEDLLNAME)
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.3"
- -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.3"
- -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.3"
- @echo Installing $(TCLREGDLLNAME)
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.2"
- -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.3"
- -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2"
- @echo Installing encoding files
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
- -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding"
- @echo Installing library files
- -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)"
- -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)"
- -@copy "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)"
- -@copy "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)"
- -@copy "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)"
- -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)"
-
-#
-# Regenerate the stubs files.
-#
-
-genstubs:
- tclsh$(VERSION) $(ROOT)\tools\genStubs.tcl $(GENERICDIR) \
- $(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls
-
-#
-# Special case object file targets
-#
-$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
-
-$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) -DTCL_TEST -o$(TMPDIR)\testMain.obj $?
-
-$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
- $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
-
-$(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
- $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
-
-$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
- $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
-
-$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
- $(cc32) $(TCL_CFLAGS) \
- -DCFG_INSTALL_EXEC_PREFIX=\"$(INSTALL_EXEC_PREFIX)\" \
- -DCFG_INSTALL_PREFIX=\"$(INSTALL_PREFIX)\" \
- -DCFG_RUNTIME_EXEC_PREFIX=\"$(RUNTIME_EXEC_PREFIX)\" \
- -DCFG_RUNTIME_PREFIX=\"$(RUNTIME_PREFIX)\" \
- -o$(TMPDIR)\$@ $?
-
-$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
-
-# The following objects should be built using the stub interfaces
-
-# tclWinReg: Produces errors in ANSI mode
-$(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c
- $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
-
-# tclWinDde: Produces errors in ANSI mode
-$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c
- $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
-
-
-# The following objects are part of the stub library and should not
-# be built as DLL objects but none of the symbols should be exported
-
-$(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c
- $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
-
-$(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c
- $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
-
-$(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c
- $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
-
-
-# Dedependency rules
-
-$(GENERICDIR)\regcomp.c: \
- $(GENERICDIR)\regguts.h \
- $(GENERICDIR)\regc_lex.c \
- $(GENERICDIR)\regc_color.c \
- $(GENERICDIR)\regc_nfa.c \
- $(GENERICDIR)\regc_cvec.c \
- $(GENERICDIR)\regc_locale.c
-
-$(GENERICDIR)\regcustom.h: \
- $(GENERICDIR)\tclInt.h \
- $(GENERICDIR)\tclPort.h \
- $(GENERICDIR)\regex.h
-
-$(GENERICDIR)\regexec.c: \
- $(GENERICDIR)\rege_dfa.c \
- $(GENERICDIR)\regguts.h
-
-$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
-
-#
-# Implicit rules
-#
-
-{$(WINDIR)}.c{$(TMPDIR)}.obj:
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
-
-{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
-
-{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
-
-{$(WINDIR)}.rc{$(TMPDIR)}.res:
- $(rc32) $(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $<
-
-clean:
- -@$(RM) $(OUTDIR)\*.exp
- -@$(RM) $(OUTDIR)\*.lib
- -@$(RM) $(OUTDIR)\*.dll
- -@$(RM) $(OUTDIR)\*.exe
- -@$(RM) $(OUTDIR)\*.pdb
- -@$(RM) $(TMPDIR)\*.pch
- -@$(RM) $(TMPDIR)\*.obj
- -@$(RM) $(TMPDIR)\*.res
- -@$(RM) $(TMPDIR)\*.exe
- -@$(RMDIR) $(OUTDIR)
- -@$(RMDIR) $(TMPDIR)
-
-# Local Variables:
-# mode: makefile
-# End:
diff --git a/win/makefile.vc b/win/makefile.vc index f401541..d6de5e1 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -113,12 +113,12 @@ the build instructions. # memdbg = Enables the debugging memory allocator.
#
# CHECKS=64bit,fullwarn,nodep,none
-# Sets special macros for checking compatability.
+# Sets special macros for checking compatibility.
#
# 64bit = Enable 64bit portability warnings (if available)
# fullwarn = Builds with full compiler and link warnings enabled.
# Very verbose.
-# nodep = Turns off compatability macros to ensure the core
+# nodep = Turns off compatibility macros to ensure the core
# isn't being built with deprecated functions.
#
# MACHINE=(ALPHA|AMD64|IA64|IX86)
@@ -383,6 +383,7 @@ TOMMATHOBJS = \ $(TMP_DIR)\bn_mp_div_3.obj \
$(TMP_DIR)\bn_mp_exch.obj \
$(TMP_DIR)\bn_mp_expt_d.obj \
+ $(TMP_DIR)\bn_mp_expt_d_ex.obj \
$(TMP_DIR)\bn_mp_grow.obj \
$(TMP_DIR)\bn_mp_init.obj \
$(TMP_DIR)\bn_mp_init_copy.obj \
@@ -503,7 +504,7 @@ crt = -MT !endif
TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
-TCL_DEFINES = -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1
+TCL_DEFINES = -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1
BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE
TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES)
diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 84cf75c..22b7b06 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -43,7 +43,7 @@ /* protos */ static int CheckForCompilerFeature(const char *option); -static int CheckForLinkerFeature(const char *option); +static int CheckForLinkerFeature(const char **options, int count); static int IsIn(const char *string, const char *substring); static int SubstituteFile(const char *substs, const char *filename); static int QualifyPath(const char *path); @@ -102,16 +102,16 @@ main( } return CheckForCompilerFeature(argv[2]); case 'l': - if (argc != 3) { + if (argc < 3) { chars = snprintf(msg, sizeof(msg) - 1, - "usage: %s -l <linker option>\n" + "usage: %s -l <linker option> ?<mandatory option> ...?\n" "Tests for whether link.exe supports an option\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } - return CheckForLinkerFeature(argv[2]); + return CheckForLinkerFeature(&argv[2], argc-2); case 'f': if (argc == 2) { chars = snprintf(msg, sizeof(msg) - 1, @@ -313,7 +313,8 @@ CheckForCompilerFeature( static int CheckForLinkerFeature( - const char *option) + const char **options, + int count) { STARTUPINFO si; PROCESS_INFORMATION pi; @@ -322,7 +323,8 @@ CheckForLinkerFeature( char msg[300]; BOOL ok; HANDLE hProcess, h, pipeThreads[2]; - char cmdline[100]; + int i; + char cmdline[255]; hProcess = GetCurrentProcess(); @@ -368,7 +370,11 @@ CheckForLinkerFeature( * Append our option for testing. */ - lstrcat(cmdline, option); + for (i = 0; i < count; i++) { + lstrcat(cmdline, " \""); + lstrcat(cmdline, options[i]); + lstrcat(cmdline, "\""); + } ok = CreateProcess( NULL, /* Module name. */ @@ -433,7 +439,9 @@ CheckForLinkerFeature( return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL || strstr(Out.buffer, "LNK4044") != NULL || - strstr(Err.buffer, "LNK4044") != NULL); + strstr(Err.buffer, "LNK4044") != NULL || + strstr(Out.buffer, "LNK4224") != NULL || + strstr(Err.buffer, "LNK4224") != NULL); } static DWORD WINAPI diff --git a/win/rules.vc b/win/rules.vc index e12854d..4a3ae26 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -188,9 +188,14 @@ COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx !endif
!endif
+# Prevents "LNK1561: entry point must be defined" error compiling from VS-IDE:
+!ifndef LINKER_TESTFLAGS
+LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmhlp-out.txt
+!endif
+
!if "$(MACHINE)" == "IX86"
### test for -align:4096, when align:512 will do.
-!if [nmakehlp -l -opt:nowin98]
+!if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)]
!message *** Linker has 'Win98 alignment problem'
ALIGN98_HACK = 1
!else
@@ -203,7 +208,7 @@ ALIGN98_HACK = 0 LINKERFLAGS =
-!if [nmakehlp -l -ltcg]
+!if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)]
LINKERFLAGS =-ltcg
!endif
@@ -417,7 +422,7 @@ TCL_NO_DEPRECATED = 0 !if [nmakehlp -f $(CHECKS) "fullwarn"]
!message *** Doing full warnings check
WARNINGS = -W4
-!if [nmakehlp -l -warn:3]
+!if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)]
LINKERFLAGS = $(LINKERFLAGS) -warn:3
!endif
!else
@@ -430,7 +435,7 @@ WARNINGS = $(WARNINGS) -Wp64 !endif
!if $(PGO) > 1
-!if [nmakehlp -l -ltcg:pgoptimize]
+!if [nmakehlp -l -ltcg:pgoptimize $(LINKER_TESTFLAGS)]
LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize
!else
MSG=^
@@ -438,7 +443,7 @@ This compiler does not support profile guided optimization. !error $(MSG)
!endif
!elseif $(PGO) > 0
-!if [nmakehlp -l -ltcg:pginstrument]
+!if [nmakehlp -l -ltcg:pginstrument $(LINKER_TESTFLAGS)]
LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument
!else
MSG=^
diff --git a/win/tcl.dsp b/win/tcl.dsp index 9ea990b..48eae9d 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 OPTS=none MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh85.exe"
+# PROP BASE Target_File "Release\tclsh87.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -45,7 +45,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Release\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Release\tclsh85t.exe"
+# PROP Target_File "Release\tclsh87t.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -57,7 +57,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh85g.exe"
+# PROP BASE Target_File "Debug\tclsh87g.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -66,7 +66,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Debug\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Debug\tclsh85tg.exe"
+# PROP Target_File "Debug\tclsh87tg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -78,7 +78,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh85sg.exe"
+# PROP BASE Target_File "Debug\tclsh87sg.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -87,7 +87,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Debug\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Debug\tclsh85sg.exe"
+# PROP Target_File "Debug\tclsh87sg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -99,7 +99,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Release\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh85s.exe"
+# PROP BASE Target_File "Release\tclsh87s.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -108,7 +108,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Release\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Release\tclsh85s.exe"
+# PROP Target_File "Release\tclsh87s.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -1428,10 +1428,6 @@ SOURCE=.\configure.ac # End Source File
# Begin Source File
-SOURCE=.\makefile.bc
-# End Source File
-# Begin Source File
-
SOURCE=.\Makefile.in
# End Source File
# Begin Source File
@@ -727,7 +727,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wsign-compare -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 688fa8d..e4adb1d 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -49,7 +49,7 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, */ typedef struct MountPointMap { - const TCHAR *volumeName; /* Native wide string volume name. */ + TCHAR *volumeName; /* Native wide string volume name. */ TCHAR driveLetter; /* Drive letter corresponding to the volume * name. */ struct MountPointMap *nextPtr; @@ -603,8 +603,8 @@ Tcl_WinTCharToUtf( int TclWinCPUID( - unsigned int index, /* Which CPUID value to retrieve. */ - unsigned int *regsPtr) /* Registers after the CPUID. */ + int index, /* Which CPUID value to retrieve. */ + int *regsPtr) /* Registers after the CPUID. */ { int status = TCL_ERROR; diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 8904a05..01af950 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1525,8 +1525,8 @@ GetWinFileAttributes( * We test for, and fix that case, here. */ - int len; - const char *str = TclGetStringFromObj(fileName,&len); + const char *str = TclGetString(fileName); + size_t len = fileName->length; if (len < 4) { if (len == 0) { @@ -1611,11 +1611,12 @@ ConvertFileNameFormat( for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; - int pathLen; + size_t pathLen; Tcl_ListObjIndex(NULL, splitPath, i, &elt); - pathv = TclGetStringFromObj(elt, &pathLen); + pathv = TclGetString(elt); + pathLen = elt->length; if ((pathv[0] == '/') || ((pathLen == 3) && (pathv[1] == ':')) || (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) { /* @@ -1639,7 +1640,6 @@ ConvertFileNameFormat( Tcl_DString dsTemp; const TCHAR *nativeName; const char *tempString; - int tempLen; WIN32_FIND_DATA data; HANDLE handle; DWORD attr; @@ -1653,8 +1653,8 @@ ConvertFileNameFormat( */ Tcl_DStringInit(&ds); - tempString = TclGetStringFromObj(tempPath,&tempLen); - nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds); + tempString = TclGetString(tempPath); + nativeName = Tcl_WinUtfToTChar(tempString, tempPath->length, &ds); Tcl_DecrRefCount(tempPath); handle = FindFirstFile(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 9458933..e61d619 100755..100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -169,7 +169,7 @@ static int NativeWriteReparse(const TCHAR *LinkDirectory, REPARSE_DATA_BUFFER *buffer); static int NativeMatchType(int isDrive, DWORD attr, const TCHAR *nativeName, Tcl_GlobTypeData *types); -static int WinIsDrive(const char *name, int nameLen); +static int WinIsDrive(const char *name, size_t nameLen); static int WinIsReserved(const char *path); static Tcl_Obj * WinReadLink(const TCHAR *LinkSource); static Tcl_Obj * WinReadLinkDirectory(const TCHAR *LinkDirectory); @@ -933,10 +933,9 @@ TclpMatchInDirectory( * Match a single file directly. */ - int len; DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; - const char *str = TclGetStringFromObj(norm,&len); + const char *str = TclGetString(norm); native = Tcl_FSGetNativePath(pathPtr); @@ -946,7 +945,7 @@ TclpMatchInDirectory( } attr = data.dwFileAttributes; - if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) { + if (NativeMatchType(WinIsDrive(str,norm->length), attr, native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } } @@ -957,7 +956,7 @@ TclpMatchInDirectory( WIN32_FIND_DATA data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ - int dirLength; + size_t dirLength; int matchSpecialDots; Tcl_DString ds; /* Native encoding of dir, also used * temporarily for other things. */ @@ -996,7 +995,8 @@ TclpMatchInDirectory( */ Tcl_DStringInit(&dsOrig); - dirName = TclGetStringFromObj(fileNamePtr, &dirLength); + dirName = TclGetString(fileNamePtr); + dirLength = fileNamePtr->length; Tcl_DStringAppend(&dsOrig, dirName, dirLength); lastChar = dirName[dirLength -1]; @@ -1174,7 +1174,7 @@ TclpMatchInDirectory( static int WinIsDrive( const char *name, /* Name (UTF-8) */ - int len) /* Length of name */ + size_t len) /* Length of name */ { int remove = 0; @@ -2705,15 +2705,14 @@ TclpObjNormalizePath( * Not the end of the string. */ - int len; char *path; Tcl_Obj *tmpPathPtr; tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); - path = TclGetStringFromObj(tmpPathPtr, &len); - Tcl_SetStringObj(pathPtr, path, len); + path = TclGetString(tmpPathPtr); + Tcl_SetStringObj(pathPtr, path, tmpPathPtr->length); Tcl_DecrRefCount(tmpPathPtr); } else { /* @@ -2796,9 +2795,8 @@ TclWinVolumeRelativeNormalize( * also on drive C. */ - int cwdLen; - const char *drive = - TclGetStringFromObj(useThisCwd, &cwdLen); + const char *drive = TclGetString(useThisCwd); + size_t cwdLen = useThisCwd->length; char drive_cur = path[0]; if (drive_cur >= 'a') { diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 66d971b..ca72a35 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -207,7 +207,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 @@ -249,9 +249,10 @@ TclpInitLibraryPath( TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; - bytes = TclGetStringFromObj(pathPtr, lengthPtr); - *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1); + bytes = TclGetString(pathPtr); + *lengthPtr = pathPtr->length; + *valuePtr = ckalloc(*lengthPtr + 1); + memcpy(*valuePtr, bytes, *lengthPtr + 1); Tcl_DecrRefCount(pathPtr); } @@ -369,7 +370,7 @@ AppendEnvironment( static void InitializeDefaultLibraryDir( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); @@ -396,7 +397,7 @@ InitializeDefaultLibraryDir( *lengthPtr = strlen(name); *valuePtr = ckalloc(*lengthPtr + 1); *encodingPtr = NULL; - memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); + memcpy(*valuePtr, name, *lengthPtr + 1); } /* @@ -420,7 +421,7 @@ InitializeDefaultLibraryDir( static void InitializeSourceLibraryDir( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); @@ -447,7 +448,7 @@ InitializeSourceLibraryDir( *lengthPtr = strlen(name); *valuePtr = ckalloc(*lengthPtr + 1); *encodingPtr = NULL; - memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); + memcpy(*valuePtr, name, *lengthPtr + 1); } /* diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 159a708..41201c7 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -551,7 +551,7 @@ typedef DWORD_PTR * PDWORD_PTR; * address platform-specific issues. */ -#define TclpReleaseFile(file) ckfree((char *) file) +#define TclpReleaseFile(file) ckfree(file) /* * The following macros and declarations wrap the C runtime library diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 4690708..ee6be96 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -69,6 +69,7 @@ #define SET_BITS(var, bits) ((var) |= (bits)) #define CLEAR_BITS(var, bits) ((var) &= ~(bits)) +#define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ #define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) @@ -124,6 +125,8 @@ typedef struct TcpFdList { struct TcpState { Tcl_Channel channel; /* Channel associated with this socket. */ + int testFlags; /* bit field for tests. Is set by testsocket + * test procedure */ struct TcpFdList *sockets; /* Windows SOCKET handle. */ int flags; /* Bit field comprised of the flags described * below. */ @@ -184,6 +187,15 @@ struct TcpState { #define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */ /* + * These bits may be ORed together into the "testFlags" field of a TcpState + * structure. + */ + +#define TCP_ASYNC_TEST_MODE (1<<0) /* Async testing activated. Do not + * automatically continue connection + * process */ + +/* * The following structure is what is added to the Tcl event queue when a * socket event occurs. */ @@ -292,22 +304,39 @@ static const Tcl_ChannelType tcpChannelType = { static TclInitProcessGlobalValueProc InitializeHostName; static ProcessGlobalValue hostName = {0, 0, NULL, NULL, InitializeHostName, NULL, NULL}; + +/* + * Simple wrapper round the SendMessage syscall. + */ + +#define SendSelectMessage(tsdPtr, message, payload) \ + SendMessage((tsdPtr)->hwnd, SOCKET_SELECT, \ + (WPARAM) (message), (LPARAM) (payload)) + /* * Address print debug functions */ #if 0 -void printaddrinfo(struct addrinfo *ai, char *prefix) +void +printaddrinfo( + struct addrinfo *ai, + char *prefix) { char host[NI_MAXHOST], port[NI_MAXSERV]; + getnameinfo(ai->ai_addr, ai->ai_addrlen, - host, sizeof(host), - port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); + host, sizeof(host), port, sizeof(port), + NI_NUMERICHOST|NI_NUMERICSERV); } -void printaddrinfolist(struct addrinfo *addrlist, char *prefix) + +void +printaddrinfolist( + struct addrinfo *addrlist, + char *prefix) { struct addrinfo *ai; + for (ai = addrlist; ai != NULL; ai = ai->ai_next) { printaddrinfo(ai, prefix); } @@ -331,7 +360,7 @@ void printaddrinfolist(struct addrinfo *addrlist, char *prefix) void InitializeHostName( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; @@ -368,8 +397,8 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); - *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1); + *valuePtr = ckalloc(*lengthPtr + 1); + memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); Tcl_DStringFree(&ds); } @@ -524,9 +553,9 @@ TcpBlockModeProc( TcpState *statePtr = instanceData; if (mode == TCL_MODE_NONBLOCKING) { - statePtr->flags |= TCP_NONBLOCKING; + SET_BITS(statePtr->flags, TCP_NONBLOCKING); } else { - statePtr->flags &= ~(TCP_NONBLOCKING); + CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING); } return 0; } @@ -536,29 +565,28 @@ TcpBlockModeProc( * * WaitForConnect -- * - * Check the state of an async connect process. If a connection - * attempt terminated, process it, which may finalize it or may - * start the next attempt. If a connect error occures, it is saved - * in statePtr->connectError to be reported by 'fconfigure -error'. + * Check the state of an async connect process. If a connection attempt + * terminated, process it, which may finalize it or may start the next + * attempt. If a connect error occures, it is saved in + * statePtr->connectError to be reported by 'fconfigure -error'. * * There are two modes of operation, defined by errorCodePtr: - * * non-NULL: Called by explicite read/write command. block if - * socket is blocking. + * * non-NULL: Called by explicite read/write command. Block if socket + * is blocking. * May return two error codes: * * EWOULDBLOCK: if connect is still in progress - * * ENOTCONN: if connect failed. This would be the error - * message of a rect or sendto syscall so this is - * emulated here. - * * Null: Called by a backround operation. Do not block and - * don't return any error code. + * * ENOTCONN: if connect failed. This would be the error message + * of a rect or sendto syscall so this is emulated here. + * * Null: Called by a backround operation. Do not block and don't + * return any error code. * * Results: - * 0 if the connection has completed, -1 if still in progress - * or there is an error. + * 0 if the connection has completed, -1 if still in progress or there is + * an error. * * Side effects: - * Processes socket events off the system queue. - * May process asynchroneous connect. + * Processes socket events off the system queue. May process + * asynchroneous connect. * *---------------------------------------------------------------------- */ @@ -566,20 +594,19 @@ TcpBlockModeProc( static int WaitForConnect( TcpState *statePtr, /* State of the socket. */ - int *errorCodePtr) /* Where to store errors? - * A passed null-pointer activates background mode. - */ + int *errorCodePtr) /* Where to store errors? A passed + * null-pointer activates background mode. */ { int result; int oldMode; ThreadSpecificData *tsdPtr; /* - * Check if an async connect failed already and error reporting is demanded, - * return the error ENOTCONN + * Check if an async connect failed already and error reporting is + * demanded, return the error ENOTCONN. */ - if (errorCodePtr != NULL && (statePtr->flags & TCP_ASYNC_FAILED)) { + if (errorCodePtr != NULL && GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) { *errorCodePtr = ENOTCONN; return -1; } @@ -588,11 +615,26 @@ WaitForConnect( * Check if an async connect is running. If not return ok */ - if (!(statePtr->flags & TCP_ASYNC_CONNECT)) { + if (!GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { return 0; } /* + * In socket test mode do not continue with the connect + * Exceptions are: + * - Call by recv/send and blocking socket + * (errorCodePtr != NULL && !GOT_BITS(flags, TCP_NONBLOCKING)) + * - Call by the event queue (errorCodePtr == NULL) + */ + + if (GOT_BITS(statePtr->testFlags, TCP_ASYNC_TEST_MODE) + && errorCodePtr != NULL + && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { + *errorCodePtr = EWOULDBLOCK; + return -1; + } + + /* * Be sure to disable event servicing so we are truly modal. */ @@ -603,36 +645,51 @@ WaitForConnect( */ while (1) { + /* + * Get the statePtr lock. + */ - /* get statePtr lock */ tsdPtr = TclThreadDataKeyGet(&dataKey); WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - /* Check for connect event */ - if (statePtr->readyEvents & FD_CONNECT) { + /* + * Check for connect event. + */ + + if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) { + /* + * Consume the connect event. + */ - /* Consume the connect event */ - statePtr->readyEvents &= ~(FD_CONNECT); + CLEAR_BITS(statePtr->readyEvents, FD_CONNECT); /* - * For blocking sockets and foreground processing - * disable async connect as we continue now synchoneously + * For blocking sockets and foreground processing, disable async + * connect as we continue now synchoneously. */ - if ( errorCodePtr != NULL && - ! (statePtr->flags & TCP_NONBLOCKING) ) { + + if (errorCodePtr != NULL && + !GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); } - /* Free list lock */ + /* + * Free list lock. + */ + SetEvent(tsdPtr->socketListLock); /* - * Continue connect. - * If switched to synchroneous connect, the connect is terminated. + * Continue connect. If switched to synchroneous connect, the + * connect is terminated. */ + result = TcpConnect(NULL, statePtr); - /* Restore event service mode */ + /* + * Restore event service mode. + */ + (void) Tcl_SetServiceMode(oldMode); /* @@ -641,10 +698,11 @@ WaitForConnect( if (result == TCL_OK) { /* - * Check for async connect restart - * (not possible for foreground blocking operation) + * Check for async connect restart (not possible for + * foreground blocking operation) */ - if ( statePtr->flags & TCP_ASYNC_PENDING ) { + + if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { if (errorCodePtr != NULL) { *errorCodePtr = EWOULDBLOCK; } @@ -654,8 +712,8 @@ WaitForConnect( } /* - * Connect finally failed. - * For foreground operation return ENOTCONN. + * Connect finally failed. For foreground operation return + * ENOTCONN. */ if (errorCodePtr != NULL) { @@ -664,7 +722,10 @@ WaitForConnect( return -1; } - /* Free list lock */ + /* + * Free list lock. + */ + SetEvent(tsdPtr->socketListLock); /* @@ -672,16 +733,16 @@ WaitForConnect( * event */ - if ( errorCodePtr == NULL ) { + if (errorCodePtr == NULL) { return -1; } /* - * A non blocking socket waiting for an asyncronous connect - * returns directly the error EWOULDBLOCK + * A non blocking socket waiting for an asyncronous connect returns + * directly the error EWOULDBLOCK. */ - if (statePtr->flags & TCP_NONBLOCKING) { + if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { *errorCodePtr = EWOULDBLOCK; return -1; } @@ -745,7 +806,7 @@ TcpInputProc( * socket stack after the first time EOF is detected. */ - if (statePtr->flags & SOCKET_EOF) { + if (GOT_BITS(statePtr->flags, SOCKET_EOF)) { return 0; } @@ -768,18 +829,22 @@ TcpInputProc( */ while (1) { - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) UNSELECT, (LPARAM) statePtr); - /* single fd operation: this proc is only called for a connected socket. */ + SendSelectMessage(tsdPtr, UNSELECT, statePtr); + + /* + * Single fd operation: this proc is only called for a connected + * socket. + */ + bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0); - statePtr->readyEvents &= ~(FD_READ); + CLEAR_BITS(statePtr->readyEvents, FD_READ); /* * Check for end-of-file condition or successful read. */ if (bytesRead == 0) { - statePtr->flags |= SOCKET_EOF; + SET_BITS(statePtr->flags, SOCKET_EOF); } if (bytesRead != SOCKET_ERROR) { break; @@ -790,8 +855,8 @@ TcpInputProc( * error and report an EOF. */ - if (statePtr->readyEvents & FD_CLOSE) { - statePtr->flags |= SOCKET_EOF; + if (GOT_BITS(statePtr->readyEvents, FD_CLOSE)) { + SET_BITS(statePtr->flags, SOCKET_EOF); bytesRead = 0; break; } @@ -804,7 +869,7 @@ TcpInputProc( */ if (error == WSAECONNRESET) { - statePtr->flags |= SOCKET_EOF; + SET_BITS(statePtr->flags, SOCKET_EOF); bytesRead = 0; break; } @@ -813,7 +878,8 @@ TcpInputProc( * Check for error condition or underflow in non-blocking case. */ - if ((statePtr->flags & TCP_NONBLOCKING) || (error != WSAEWOULDBLOCK)) { + if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING) + || (error != WSAEWOULDBLOCK)) { TclWinConvertError(error); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; @@ -831,7 +897,7 @@ TcpInputProc( } } - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr); + SendSelectMessage(tsdPtr, SELECT, statePtr); return bytesRead; } @@ -889,10 +955,13 @@ TcpOutputProc( } while (1) { - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) UNSELECT, (LPARAM) statePtr); + SendSelectMessage(tsdPtr, UNSELECT, statePtr); + + /* + * Single fd operation: this proc is only called for a connected + * socket. + */ - /* single fd operation: this proc is only called for a connected socket. */ written = send(statePtr->sockets->fd, buf, toWrite, 0); if (written != SOCKET_ERROR) { /* @@ -901,8 +970,9 @@ TcpOutputProc( * until the condition changes. */ - if (statePtr->watchEvents & FD_WRITE) { + if (GOT_BITS(statePtr->watchEvents, FD_WRITE)) { Tcl_Time blockTime = { 0, 0 }; + Tcl_SetMaxBlockTime(&blockTime); } break; @@ -917,8 +987,8 @@ TcpOutputProc( error = WSAGetLastError(); if (error == WSAEWOULDBLOCK) { - statePtr->readyEvents &= ~(FD_WRITE); - if (statePtr->flags & TCP_NONBLOCKING) { + CLEAR_BITS(statePtr->readyEvents, FD_WRITE); + if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { *errorCodePtr = EWOULDBLOCK; written = -1; break; @@ -941,7 +1011,7 @@ TcpOutputProc( } } - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr); + SendSelectMessage(tsdPtr, SELECT, statePtr); return written; } @@ -988,10 +1058,10 @@ TcpCloseProc( * background. */ - while ( statePtr->sockets != NULL ) { + while (statePtr->sockets != NULL) { TcpFdList *thisfd = statePtr->sockets; - statePtr->sockets = thisfd->next; + statePtr->sockets = thisfd->next; if (closesocket(thisfd->fd) == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); errorCode = Tcl_GetErrno(); @@ -1009,18 +1079,25 @@ TcpCloseProc( /* * Clear an eventual tsd info list pointer. + * * This may be called, if an async socket connect fails or is closed * between connect and thread action callback. */ + if (tsdPtr->pendingTcpState != NULL && tsdPtr->pendingTcpState == statePtr) { + /* + * Get infoPtr lock, because this concerns the notifier thread. + */ - /* get infoPtr lock, because this concerns the notifier thread */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); tsdPtr->pendingTcpState = NULL; - /* Free list lock */ + /* + * Free list lock. + */ + SetEvent(tsdPtr->socketListLock); } @@ -1081,8 +1158,11 @@ TcpClose2Proc( return TCL_ERROR; } - /* single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or - * TCL_WRITABLE so this should never be called for a server socket. */ + /* + * Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or + * TCL_WRITABLE so this should never be called for a server socket. + */ + if (shutdown(statePtr->sockets->fd, sd) == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); errorCode = Tcl_GetErrno(); @@ -1134,7 +1214,7 @@ TcpSetOptionProc( } #ifdef TCL_FEATURE_KEEPALIVE_NAGLE - #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list" +#error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list" sock = statePtr->sockets->fd; if (!strcasecmp(optionName, "-keepalive")) { @@ -1243,9 +1323,14 @@ TcpGetOptionProc( /* * Go one step in async connect - * If any error is thrown save it as backround error to report eventually below + * + * If any error is thrown save it as backround error to report eventually + * below. */ - WaitForConnect(statePtr, NULL); + + if (!GOT_BITS(statePtr->testFlags, TCP_ASYNC_TEST_MODE)) { + WaitForConnect(statePtr, NULL); + } sock = statePtr->sockets->fd; if (optionName != NULL) { @@ -1254,31 +1339,26 @@ TcpGetOptionProc( if ((len > 1) && (optionName[1] == 'e') && (strncmp(optionName, "-error", len) == 0)) { - /* - * Do not return any errors if async connect is running - */ - if ( ! (statePtr->flags & TCP_ASYNC_PENDING) ) { - - - if ( statePtr->flags & TCP_ASYNC_FAILED ) { + * Do not return any errors if async connect is running. + */ + if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { + if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) { /* * In case of a failed async connect, eventually report the - * connect error only once. - * Do not report the system error, as this comes again and again. + * connect error only once. Do not report the system error, + * as this comes again and again. */ - if ( statePtr->connectError != 0 ) { + if (statePtr->connectError != 0) { Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(statePtr->connectError), -1); statePtr->connectError = 0; } - } else { - /* - * Report an eventual last error of the socket system + * Report an eventual last error of the socket system. */ int optlen; @@ -1286,24 +1366,30 @@ TcpGetOptionProc( DWORD err; /* - * Populater the err Variable with a possix error + * Populate the err variable with a POSIX error */ + optlen = sizeof(int); ret = getsockopt(sock, SOL_SOCKET, SO_ERROR, (char *)&err, &optlen); + /* - * The error was not returned directly but should be - * taken from WSA + * The error was not returned directly but should be taken + * from WSA. */ + if (ret == SOCKET_ERROR) { err = WSAGetLastError(); } + /* - * Return error message + * Return error message. */ + if (err) { TclWinConvertError(err); - Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1); + Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), + -1); } } } @@ -1312,14 +1398,14 @@ TcpGetOptionProc( if ((len > 1) && (optionName[1] == 'c') && (strncmp(optionName, "-connecting", len) == 0)) { - Tcl_DStringAppend(dsPtr, - (statePtr->flags & TCP_ASYNC_PENDING) + GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING) ? "1" : "0", -1); return TCL_OK; } - if (interp != NULL && Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { + if (interp != NULL + && Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { reverseDNS = NI_NUMERICHOST; } @@ -1328,20 +1414,23 @@ TcpGetOptionProc( address peername; socklen_t size = sizeof(peername); - if ( (statePtr->flags & TCP_ASYNC_PENDING) ) { + if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { /* * In async connect output an empty string */ + if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringAppendElement(dsPtr, ""); } else { return TCL_OK; } - } else if ( getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) { + } else if (getpeername(sock, (LPSOCKADDR) &(peername.sa), + &size) == 0) { /* * Peername fetch succeeded - output list */ + if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringStartSublist(dsPtr); @@ -1390,11 +1479,12 @@ TcpGetOptionProc( Tcl_DStringAppendElement(dsPtr, "-sockname"); Tcl_DStringStartSublist(dsPtr); } - if ( (statePtr->flags & TCP_ASYNC_PENDING ) ) { + if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { /* * In async connect output an empty string */ - found = 1; + + found = 1; } else { for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { sock = fds->fd; @@ -1408,9 +1498,11 @@ TcpGetOptionProc( Tcl_DStringAppendElement(dsPtr, host); /* - * We don't want to resolve INADDR_ANY and sin6addr_any; they - * can sometimes cause problems (and never have a name). + * We don't want to resolve INADDR_ANY and sin6addr_any; + * they can sometimes cause problems (and never have a + * name). */ + flags |= NI_NUMERICSERV; if (sockname.sa.sa_family == AF_INET) { if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) { @@ -1494,7 +1586,8 @@ TcpGetOptionProc( return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname keepalive nagle"); #else - return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname"); + return Tcl_BadChannelOption(interp, optionName, + "connecting peername sockname"); #endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ } @@ -1535,11 +1628,11 @@ TcpWatchProc( if (!statePtr->acceptProc) { statePtr->watchEvents = 0; - if (mask & TCL_READABLE) { - statePtr->watchEvents |= (FD_READ|FD_CLOSE); + if (GOT_BITS(mask, TCL_READABLE)) { + SET_BITS(statePtr->watchEvents, FD_READ | FD_CLOSE); } - if (mask & TCL_WRITABLE) { - statePtr->watchEvents |= (FD_WRITE|FD_CLOSE); + if (GOT_BITS(mask, TCL_WRITABLE)) { + SET_BITS(statePtr->watchEvents, FD_WRITE | FD_CLOSE); } /* @@ -1630,13 +1723,13 @@ TcpConnect( TcpState *statePtr) { DWORD error; - /* - * We are started with async connect and the connect notification - * was not jet received - */ - int async_connect = statePtr->flags & TCP_ASYNC_CONNECT; - /* We were called by the event procedure and continue our loop */ - int async_callback = statePtr->flags & TCP_ASYNC_PENDING; + int async_connect = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT); + /* We are started with async connect and the + * connect notification was not yet + * received. */ + int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING); + /* We were called by the event procedure and + * continue our loop. */ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); if (async_callback) { @@ -1644,11 +1737,10 @@ TcpConnect( } for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; - statePtr->addr = statePtr->addr->ai_next) { - - for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL; - statePtr->myaddr = statePtr->myaddr->ai_next) { - + statePtr->addr = statePtr->addr->ai_next) { + for (statePtr->myaddr = statePtr->myaddrlist; + statePtr->myaddr != NULL; + statePtr->myaddr = statePtr->myaddr->ai_next) { /* * No need to try combinations of local and remote addresses * of different families. @@ -1662,25 +1754,37 @@ TcpConnect( * Close the socket if it is still open from the last unsuccessful * iteration. */ + if (statePtr->sockets->fd != INVALID_SOCKET) { closesocket(statePtr->sockets->fd); } - /* get statePtr lock */ + /* + * Get statePtr lock. + */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Reset last error from last try */ + statePtr->notifierConnectError = 0; Tcl_SetErrno(0); - statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, SOCK_STREAM, 0); + statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, + SOCK_STREAM, 0); + + /* + * Free list lock. + */ - /* Free list lock */ SetEvent(tsdPtr->socketListLock); - /* continue on socket creation error */ + /* + * Continue on socket creation error. + */ + if (statePtr->sockets->fd == INVALID_SOCKET) { TclWinConvertError((DWORD) WSAGetLastError()); continue; @@ -1691,31 +1795,39 @@ TcpConnect( * processes by default. Turn off the inherit bit. */ - SetHandleInformation((HANDLE) statePtr->sockets->fd, HANDLE_FLAG_INHERIT, 0); + SetHandleInformation((HANDLE) statePtr->sockets->fd, + HANDLE_FLAG_INHERIT, 0); /* * Set kernel space buffering */ - TclSockMinimumBuffers((void *) statePtr->sockets->fd, TCP_BUFFER_SIZE); + TclSockMinimumBuffers((void *) statePtr->sockets->fd, + TCP_BUFFER_SIZE); /* * Try to bind to a local port. */ if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr, - statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) { + statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); continue; } + /* * For asyncroneous connect set the socket in nonblocking mode * and activate connect notification */ + if (async_connect) { TcpState *statePtr2; int in_socket_list = 0; - /* get statePtr lock */ + + /* + * Get statePtr lock. + */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* @@ -1725,8 +1837,8 @@ TcpConnect( * It is set after this call by TcpThreadActionProc and is set * on a second round. * - * If not, we buffer my statePtr in the tsd memory so it is not - * lost by the event procedure + * If not, we buffer my statePtr in the tsd memory so it is + * not lost by the event procedure */ for (statePtr2 = tsdPtr->socketList; statePtr2 != NULL; @@ -1739,21 +1851,27 @@ TcpConnect( if (!in_socket_list) { tsdPtr->pendingTcpState = statePtr; } + /* * Set connect mask to connect events - * This is activated by a SOCKET_SELECT message to the notifier - * thread. + * + * This is activated by a SOCKET_SELECT message to the + * notifier thread. */ - statePtr->selectEvents |= FD_CONNECT; + + SET_BITS(statePtr->selectEvents, FD_CONNECT); /* - * Free list lock + * Free list lock. */ + SetEvent(tsdPtr->socketListLock); - /* activate accept notification */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, - (LPARAM) statePtr); + /* + * Activate accept notification. + */ + + SendSelectMessage(tsdPtr, SELECT, statePtr); } /* @@ -1769,12 +1887,11 @@ TcpConnect( if (async_connect && error == WSAEWOULDBLOCK) { /* * Asynchroneous connect - */ - - /* + * * Remember that we jump back behind this next round */ - statePtr->flags |= TCP_ASYNC_PENDING; + + SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); return TCL_OK; reenter: @@ -1784,21 +1901,39 @@ TcpConnect( * * Clear the reenter flag */ - statePtr->flags &= ~(TCP_ASYNC_PENDING); - /* get statePtr lock */ + + CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); + + /* + * Get statePtr lock. + */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - /* Get signaled connect error */ + + /* + * Get signaled connect error. + */ + TclWinConvertError((DWORD) statePtr->notifierConnectError); - /* Clear eventual connect flag */ - statePtr->selectEvents &= ~(FD_CONNECT); - /* Free list lock */ + + /* + * Clear eventual connect flag. + */ + + CLEAR_BITS(statePtr->selectEvents, FD_CONNECT); + + /* + * Free list lock. + */ + SetEvent(tsdPtr->socketListLock); } /* - * Clear the tsd socket list pointer if we did not wait for - * the FD_CONNECT asyncroneously + * Clear the tsd socket list pointer if we did not wait for the + * FD_CONNECT asynchronously. */ + tsdPtr->pendingTcpState = NULL; if (Tcl_GetErrno() == 0) { @@ -1807,7 +1942,7 @@ TcpConnect( } } -out: + out: /* * Socket connected or connection failed */ @@ -1818,13 +1953,13 @@ out: CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); - if ( Tcl_GetErrno() == 0 ) { + if (Tcl_GetErrno() == 0) { /* * Succesfully connected - */ - /* + * * Set up the select mask for read/write events. */ + statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE; /* @@ -1832,35 +1967,56 @@ out: * automatically places the socket into non-blocking mode. */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, - (LPARAM) statePtr); + SendSelectMessage(tsdPtr, SELECT, statePtr); } else { /* * Connect failed - */ - - /* + * * For async connect schedule a writable event to report the fail. */ + if (async_callback) { /* * Set up the select mask for read/write events. */ + statePtr->selectEvents = FD_WRITE|FD_READ; - /* get statePtr lock */ + + /* + * Get statePtr lock. + */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - /* Signal ready readable and writable events */ - statePtr->readyEvents |= FD_WRITE | FD_READ; - /* Flag error to event routine */ - statePtr->flags |= TCP_ASYNC_FAILED; - /* Save connect error to be reported by 'fconfigure -error' */ + + /* + * Signal ready readable and writable events. + */ + + SET_BITS(statePtr->readyEvents, FD_WRITE | FD_READ); + + /* + * Flag error to event routine. + */ + + SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); + + /* + * Save connect error to be reported by 'fconfigure -error'. + */ + statePtr->connectError = Tcl_GetErrno(); - /* Free list lock */ + + /* + * Free list lock. + */ + SetEvent(tsdPtr->socketListLock); } + /* * Error message on syncroneous connect */ + if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open socket: %s", Tcl_PosixError(interp))); @@ -1938,7 +2094,7 @@ Tcl_OpenTcpClient( statePtr->addrlist = addrlist; statePtr->myaddrlist = myaddrlist; if (async) { - statePtr->flags |= TCP_ASYNC_CONNECT; + SET_BITS(statePtr->flags, TCP_ASYNC_CONNECT); } /* @@ -2008,7 +2164,7 @@ Tcl_MakeTcpClientChannel( */ statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr); + SendSelectMessage(tsdPtr, SELECT, statePtr); sprintf(channelName, SOCK_TEMPLATE, statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, @@ -2020,7 +2176,7 @@ Tcl_MakeTcpClientChannel( /* *---------------------------------------------------------------------- * - * Tcl_OpenTcpServer -- + * Tcl_OpenTcpServerEx -- * * Opens a TCP server socket and creates a channel around it. * @@ -2035,10 +2191,11 @@ Tcl_MakeTcpClientChannel( */ Tcl_Channel -Tcl_OpenTcpServer( +Tcl_OpenTcpServerEx( Tcl_Interp *interp, /* For error reporting - may be NULL. */ - int port, /* Port number to open. */ + const char *service, /* Port number to open. */ const char *myHost, /* Name of local host. */ + unsigned int flags, /* Flags. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ @@ -2052,6 +2209,7 @@ Tcl_OpenTcpServer( char channelName[SOCK_CHAN_LENGTH]; u_long flag = 1; /* Indicates nonblocking mode. */ const char *errorMsg = NULL; + int optvalue, port; if (TclpHasSockets(interp) != TCL_OK) { return NULL; @@ -2071,7 +2229,13 @@ Tcl_OpenTcpServer( * Construct the addresses for each end of the socket. */ - if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) { + if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) { + errorMsg = "invalid port number"; + goto error; + } + + if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, + &errorMsg)) { goto error; } @@ -2110,17 +2274,26 @@ Tcl_OpenTcpServer( } /* - * Bind to the specified port. Note that we must not call - * setsockopt with SO_REUSEADDR because Microsoft allows addresses - * to be reused even if they are still in use. + * The SO_REUSEADDR option on Windows behaves like SO_REUSEPORT on + * unix systems. + */ + + if (GOT_BITS(flags, TCL_TCPSERVER_REUSEPORT)) { + optvalue = 1; + (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, + (char *) &optvalue, sizeof(optvalue)); + } + + /* + * Bind to the specified port. * * Bind should not be affected by the socket having already been * set into nonblocking mode. If there is trouble, this is one * place to look for bugs. */ - if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen) - == SOCKET_ERROR) { + if (bind(sock, addrPtr->ai_addr, + addrPtr->ai_addrlen) == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; @@ -2155,13 +2328,14 @@ Tcl_OpenTcpServer( /* * Add this socket to the global list of sockets. */ + statePtr = NewSocketInfo(sock); } else { - AddSocketInfoFd( statePtr, sock ); + AddSocketInfoFd(statePtr, sock); } } -error: + error: if (addrlist != NULL) { freeaddrinfo(addrlist); } @@ -2186,8 +2360,7 @@ error: */ ioctlsocket(sock, (long) FIONBIO, &flag); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, - (LPARAM) statePtr); + SendSelectMessage(tsdPtr, SELECT, statePtr); if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "") == TCL_ERROR) { Tcl_Close(NULL, statePtr->channel); @@ -2256,8 +2429,7 @@ TcpAccept( */ newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, - (LPARAM) newInfoPtr); + SendSelectMessage(tsdPtr, SELECT, newInfoPtr); sprintf(channelName, SOCK_TEMPLATE, newInfoPtr); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, @@ -2488,7 +2660,7 @@ SocketSetupProc( Tcl_Time blockTime = { 0, 0 }; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (!(flags & TCL_FILE_EVENTS)) { + if (!GOT_BITS(flags, TCL_FILE_EVENTS)) { return; } @@ -2498,9 +2670,8 @@ SocketSetupProc( WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (statePtr = tsdPtr->socketList; statePtr != NULL; statePtr = statePtr->nextPtr) { - if (statePtr->readyEvents & - (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) - ) { + if (GOT_BITS(statePtr->readyEvents, + statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)) { Tcl_SetMaxBlockTime(&blockTime); break; } @@ -2534,7 +2705,7 @@ SocketCheckProc( SocketEvent *evPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (!(flags & TCL_FILE_EVENTS)) { + if (!GOT_BITS(flags, TCL_FILE_EVENTS)) { return; } @@ -2547,11 +2718,10 @@ SocketCheckProc( WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (statePtr = tsdPtr->socketList; statePtr != NULL; statePtr = statePtr->nextPtr) { - if ((statePtr->readyEvents & - (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)) - && !(statePtr->flags & SOCKET_PENDING) - ) { - statePtr->flags |= SOCKET_PENDING; + if (GOT_BITS(statePtr->readyEvents, + statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) + && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { + SET_BITS(statePtr->flags, SOCKET_PENDING); evPtr = ckalloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; evPtr->socket = statePtr->sockets->fd; @@ -2597,7 +2767,7 @@ SocketEventProc( address addr; int len; - if (!(flags & TCL_FILE_EVENTS)) { + if (!GOT_BITS(flags, TCL_FILE_EVENTS)) { return 0; } @@ -2626,29 +2796,26 @@ SocketEventProc( * Clear flag that (this) event is pending */ - statePtr->flags &= ~SOCKET_PENDING; + CLEAR_BITS(statePtr->flags, SOCKET_PENDING); /* * Continue async connect if pending and ready */ - if ( statePtr->readyEvents & FD_CONNECT ) { - if ( statePtr->flags & TCP_ASYNC_PENDING ) { - + if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) { + if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { /* * Do one step and save eventual connect error */ SetEvent(tsdPtr->socketListLock); WaitForConnect(statePtr,NULL); - } else { - /* * No async connect reenter pending. Just clear event. */ - statePtr->readyEvents &= ~(FD_CONNECT); + CLEAR_BITS(statePtr->readyEvents, FD_CONNECT); SetEvent(tsdPtr->socketListLock); } return 1; @@ -2657,20 +2824,23 @@ SocketEventProc( /* * Handle connection requests directly. */ - if (statePtr->readyEvents & FD_ACCEPT) { - for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { + if (GOT_BITS(statePtr->readyEvents, FD_ACCEPT)) { + for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { /* - * Accept the incoming connection request. - */ - len = sizeof(address); + * Accept the incoming connection request. + */ + len = sizeof(address); newSocket = accept(fds->fd, &(addr.sa), &len); - /* On Tcl server sockets with multiple OS fds we loop over the fds trying - * an accept() on each, so we expect INVALID_SOCKET. There are also other - * network stack conditions that can result in FD_ACCEPT but a subsequent - * failure on accept() by the time we get around to it. + /* + * On Tcl server sockets with multiple OS fds we loop over the fds + * trying an accept() on each, so we expect INVALID_SOCKET. There + * are also other network stack conditions that can result in + * FD_ACCEPT but a subsequent failure on accept() by the time we + * get around to it. + * * Access to sockets (acceptEventCount, readyEvents) in socketList * is still protected by the lock (prevents reintroduction of * SF Tcl Bug 3056775. @@ -2682,35 +2852,40 @@ SocketEventProc( } /* - * It is possible that more than one FD_ACCEPT has been sent, so an extra - * count must be kept. Decrement the count, and reset the readyEvent bit - * if the count is no longer > 0. + * It is possible that more than one FD_ACCEPT has been sent, so + * an extra count must be kept. Decrement the count, and reset the + * readyEvent bit if the count is no longer > 0. */ + statePtr->acceptEventCount--; if (statePtr->acceptEventCount <= 0) { - statePtr->readyEvents &= ~(FD_ACCEPT); + CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT); } SetEvent(tsdPtr->socketListLock); - /* Caution: TcpAccept() has the side-effect of evaluating the server - * accept script (via AcceptCallbackProc() in tclIOCmd.c), which can - * close the server socket and invalidate statePtr and fds. - * If TcpAccept() accepts a socket we must return immediately and let - * SocketCheckProc queue additional FD_ACCEPT events. + /* + * Caution: TcpAccept() has the side-effect of evaluating the + * server accept script (via AcceptCallbackProc() in tclIOCmd.c), + * which can close the server socket and invalidate statePtr and + * fds. If TcpAccept() accepts a socket we must return immediately + * and let SocketCheckProc queue additional FD_ACCEPT events. */ + TcpAccept(fds, newSocket, addr); return 1; } - /* Loop terminated with no sockets accepted; clear the ready mask so + /* + * Loop terminated with no sockets accepted; clear the ready mask so * we can detect the next connection request. Note that connection * requests are level triggered, so if there is a request already * pending, a new event will be generated. */ + statePtr->acceptEventCount = 0; - statePtr->readyEvents &= ~(FD_ACCEPT); + CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT); SetEvent(tsdPtr->socketListLock); return 1; @@ -2725,7 +2900,7 @@ SocketEventProc( events = statePtr->readyEvents & statePtr->watchEvents; - if (events & FD_CLOSE) { + if (GOT_BITS(events, FD_CLOSE)) { /* * If the socket was closed and the channel is still interested in * read events, then we need to ensure that we keep polling for this @@ -2739,17 +2914,14 @@ SocketEventProc( Tcl_Time blockTime = { 0, 0 }; Tcl_SetMaxBlockTime(&blockTime); - mask |= TCL_READABLE|TCL_WRITABLE; - } else if (events & FD_READ) { - + SET_BITS(mask, TCL_READABLE | TCL_WRITABLE); + } else if (GOT_BITS(events, FD_READ)) { /* * Throw the readable event if an async connect failed. */ - if ( statePtr->flags & TCP_ASYNC_FAILED ) { - - mask |= TCL_READABLE; - + if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) { + SET_BITS(mask, TCL_READABLE); } else { fd_set readFds; struct timeval timeout; @@ -2762,8 +2934,7 @@ SocketEventProc( * async select handler and keep waiting. */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) UNSELECT, (LPARAM) statePtr); + SendSelectMessage(tsdPtr, UNSELECT, statePtr); FD_ZERO(&readFds); FD_SET(statePtr->sockets->fd, &readFds); @@ -2771,11 +2942,10 @@ SocketEventProc( timeout.tv_sec = 0; if (select(0, &readFds, NULL, NULL, &timeout) != 0) { - mask |= TCL_READABLE; + SET_BITS(mask, TCL_READABLE); } else { - statePtr->readyEvents &= ~(FD_READ); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) statePtr); + CLEAR_BITS(statePtr->readyEvents, FD_READ); + SendSelectMessage(tsdPtr, SELECT, statePtr); } } } @@ -2784,8 +2954,8 @@ SocketEventProc( * writable event */ - if (events & FD_WRITE) { - mask |= TCL_WRITABLE; + if (GOT_BITS(events, FD_WRITE)) { + SET_BITS(mask, TCL_WRITABLE); } /* @@ -2822,13 +2992,19 @@ AddSocketInfoFd( { TcpFdList *fds = statePtr->sockets; - if ( fds == NULL ) { - /* Add the first FD */ + if (fds == NULL) { + /* + * Add the first FD. + */ + statePtr->sockets = ckalloc(sizeof(TcpFdList)); fds = statePtr->sockets; } else { - /* Find end of list and append FD */ - while ( fds->next != NULL ) { + /* + * Find end of list and append FD. + */ + + while (fds->next != NULL) { fds = fds->next; } @@ -2836,7 +3012,10 @@ AddSocketInfoFd( fds = fds->next; } - /* Populate new FD */ + /* + * Populate new FD. + */ + fds->fd = socket; fds->statePtr = statePtr; fds->next = NULL; @@ -2906,6 +3085,7 @@ WaitForSocketEvent( int result = 1; int oldMode; ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + /* * Be sure to disable event servicing so we are truly modal. */ @@ -2916,29 +3096,42 @@ WaitForSocketEvent( * Reset WSAAsyncSelect so we have a fresh set of events pending. */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, - (LPARAM) statePtr); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, - (LPARAM) statePtr); + SendSelectMessage(tsdPtr, UNSELECT, statePtr); + SendSelectMessage(tsdPtr, SELECT, statePtr); while (1) { int event_found; - /* get statePtr lock */ + /* + * Get statePtr lock. + */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - /* Check if event occured */ - event_found = (statePtr->readyEvents & events); + /* + * Check if event occured. + */ + + event_found = GOT_BITS(statePtr->readyEvents, events); + + /* + * Free list lock. + */ - /* Free list lock */ SetEvent(tsdPtr->socketListLock); - /* exit loop if event occured */ + /* + * Exit loop if event occured. + */ + if (event_found) { break; } - /* Exit loop if event did not occur but this is a non-blocking channel */ + /* + * Exit loop if event did not occur but this is a non-blocking channel + */ + if (statePtr->flags & TCP_NONBLOCKING) { *errorCodePtr = EWOULDBLOCK; result = 0; @@ -3095,55 +3288,59 @@ SocketProc( for (statePtr = tsdPtr->socketList; statePtr != NULL; statePtr = statePtr->nextPtr) { - if ( FindFDInList(statePtr,socket) ) { + if (FindFDInList(statePtr, socket)) { info_found = 1; break; } } + /* - * Check if there is a pending info structure not jet in the - * list + * Check if there is a pending info structure not jet in the list. */ - if ( !info_found + + if (!info_found && tsdPtr->pendingTcpState != NULL - && FindFDInList(tsdPtr->pendingTcpState,socket) ) { + && FindFDInList(tsdPtr->pendingTcpState, socket)) { statePtr = tsdPtr->pendingTcpState; info_found = 1; } if (info_found) { - /* * Update the socket state. * * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event - * happens, then clear the FD_ACCEPT count. Otherwise, - * increment the count if the current event is an FD_ACCEPT. + * happens, then clear the FD_ACCEPT count. Otherwise, increment + * the count if the current event is an FD_ACCEPT. */ - if (event & FD_CLOSE) { + if (GOT_BITS(event, FD_CLOSE)) { statePtr->acceptEventCount = 0; - statePtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT); - } else if (event & FD_ACCEPT) { + CLEAR_BITS(statePtr->readyEvents, FD_WRITE | FD_ACCEPT); + } else if (GOT_BITS(event, FD_ACCEPT)) { statePtr->acceptEventCount++; } - if (event & FD_CONNECT) { + if (GOT_BITS(event, FD_CONNECT)) { /* * Remember any error that occurred so we can report * connection failures. */ + if (error != ERROR_SUCCESS) { statePtr->notifierConnectError = error; } } + /* * Inform main thread about signaled events */ - statePtr->readyEvents |= event; + + SET_BITS(statePtr->readyEvents, event); /* * Wake up the Main Thread. */ + SetEvent(tsdPtr->readyEvent); Tcl_ThreadAlert(tsdPtr->threadId); } @@ -3224,6 +3421,7 @@ FindFDInList( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED #undef TclWinGetSockOpt int TclWinGetSockOpt( @@ -3263,6 +3461,7 @@ TclWinGetServByName( { return getservbyname(name, proto); } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -3352,8 +3551,7 @@ TcpThreadActionProc( * thread. */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) notifyCmd, (LPARAM) statePtr); + SendSelectMessage(tsdPtr, notifyCmd, statePtr); } /* diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 26d745d..b9cde72 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -180,7 +180,7 @@ TclWinThreadStart( lpOrigStartAddress = winThreadPtr->lpStartAddress; lpOrigParameter = winThreadPtr->lpParameter; - ckfree((char *)winThreadPtr); + ckfree(winThreadPtr); return lpOrigStartAddress(lpOrigParameter); } @@ -1008,8 +1008,10 @@ TclpFreeAllocCache( if (ptr != NULL) { /* - * Called by us in TclpFinalizeThreadData when a thread exits and - * destroys the tsd key which stores allocator caches. + * Called by TclFinalizeThreadAlloc() and + * TclFinalizeThreadAllocThread() during Tcl_Finalize() or + * Tcl_FinalizeThread(). This function destroys the tsd key which + * stores allocator caches in thread local storage. */ TclFreeAllocCache(ptr); diff --git a/win/tclWinTime.c b/win/tclWinTime.c index e0d4219..e138664 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -27,6 +27,7 @@ * 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 }; @@ -40,6 +41,7 @@ typedef struct { struct tm tm; /* time information */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; +#endif /* TCL_NO_DEPRECATED */ /* * Data for managing high-resolution timers. @@ -113,7 +115,9 @@ static TimeInfo timeInfo = { * Declarations for functions defined later in this file. */ +#ifndef TCL_NO_DEPRECATED static struct tm * ComputeGMT(const time_t *tp); +#endif /* TCL_NO_DEPRECATED */ static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); @@ -281,8 +285,6 @@ NativeGetTime( ClientData clientData) { struct _timeb t; - int useFtime = 1; /* Flag == TRUE if we need to fall back on - * ftime rather than using the perf counter. */ /* * Initialize static storage on the first trip through. @@ -341,7 +343,7 @@ NativeGetTime( */ SYSTEM_INFO systemInfo; - unsigned int regs[4]; + int regs[4]; GetSystemInfo(&systemInfo); if (TclWinCPUID(0, regs) == TCL_OK @@ -353,7 +355,7 @@ NativeGetTime( || ((regs[0] & 0x00F00000) /* Extended family */ && (regs[3] & 0x10000000))) /* Hyperthread */ && (((regs[1]&0x00FF0000) >> 16)/* CPU count */ - == systemInfo.dwNumberOfProcessors)) { + == (int)systemInfo.dwNumberOfProcessors)) { timeInfo.perfCounterAvailable = TRUE; } else { timeInfo.perfCounterAvailable = FALSE; @@ -398,6 +400,10 @@ NativeGetTime( * time. */ + ULARGE_INTEGER fileTimeLastCall; + LARGE_INTEGER perfCounterLastCall, curCounterFreq; + /* Copy with current data of calibration cycle */ + LARGE_INTEGER curCounter; /* Current performance counter. */ Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns @@ -411,9 +417,29 @@ NativeGetTime( posixEpoch.LowPart = 0xD53E8000; posixEpoch.HighPart = 0x019DB1DE; + QueryPerformanceCounter(&curCounter); + + /* + * Hold time section locked as short as possible + */ EnterCriticalSection(&timeInfo.cs); - QueryPerformanceCounter(&curCounter); + fileTimeLastCall.QuadPart = timeInfo.fileTimeLastCall.QuadPart; + perfCounterLastCall.QuadPart = timeInfo.perfCounterLastCall.QuadPart; + curCounterFreq.QuadPart = timeInfo.curCounterFreq.QuadPart; + + LeaveCriticalSection(&timeInfo.cs); + + /* + * If calibration cycle occurred after we get curCounter + */ + if (curCounter.QuadPart <= perfCounterLastCall.QuadPart) { + usecSincePosixEpoch = + (fileTimeLastCall.QuadPart - posixEpoch.QuadPart) / 10; + timePtr->sec = (long) (usecSincePosixEpoch / 1000000); + timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); + return; + } /* * If it appears to be more than 1.1 seconds since the last trip @@ -425,31 +451,27 @@ NativeGetTime( * loop should recover. */ - if (curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart < - 11 * timeInfo.curCounterFreq.QuadPart / 10) { - curFileTime = timeInfo.fileTimeLastCall.QuadPart + - ((curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart) - * 10000000 / timeInfo.curCounterFreq.QuadPart); - timeInfo.fileTimeLastCall.QuadPart = curFileTime; - timeInfo.perfCounterLastCall.QuadPart = curCounter.QuadPart; + if (curCounter.QuadPart - perfCounterLastCall.QuadPart < + 11 * curCounterFreq.QuadPart / 10 + ) { + curFileTime = fileTimeLastCall.QuadPart + + ((curCounter.QuadPart - perfCounterLastCall.QuadPart) + * 10000000 / curCounterFreq.QuadPart); + usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10; timePtr->sec = (long) (usecSincePosixEpoch / 1000000); timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); - useFtime = 0; + return; } - - LeaveCriticalSection(&timeInfo.cs); } - if (useFtime) { - /* - * High resolution timer is not available. Just use ftime. - */ + /* + * High resolution timer is not available. Just use ftime. + */ - _ftime(&t); - timePtr->sec = (long)t.time; - timePtr->usec = t.millitm * 1000; - } + _ftime(&t); + timePtr->sec = (long)t.time; + timePtr->usec = t.millitm * 1000; } /* @@ -504,6 +526,7 @@ StopCalibration( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED struct tm * TclpGetDate( const time_t *t, @@ -706,6 +729,7 @@ ComputeGMT( return tmPtr; } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -1050,6 +1074,7 @@ AccumulateSample( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED struct tm * TclpGmtime( const time_t *timePtr) /* Pointer to the number of seconds since the @@ -1094,6 +1119,7 @@ TclpLocaltime( return localtime(timePtr); } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- |