summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in373
-rw-r--r--win/README8
-rw-r--r--win/buildall.vc.bat10
-rw-r--r--win/cat.c9
-rwxr-xr-xwin/configure454
-rw-r--r--win/configure.in134
-rw-r--r--win/makefile.bc93
-rw-r--r--win/makefile.vc233
-rw-r--r--win/nmakehlp.c9
-rw-r--r--win/rules.vc26
-rw-r--r--win/stub16.c195
-rw-r--r--win/tcl.dsp16
-rw-r--r--win/tcl.hpj.in4
-rw-r--r--win/tcl.m482
-rw-r--r--win/tclAppInit.c182
-rw-r--r--win/tclWin32Dll.c566
-rw-r--r--win/tclWinChan.c179
-rw-r--r--win/tclWinConsole.c496
-rw-r--r--win/tclWinDde.c442
-rw-r--r--win/tclWinError.c59
-rw-r--r--win/tclWinFCmd.c387
-rwxr-xr-xwin/tclWinFile.c1414
-rw-r--r--win/tclWinInit.c101
-rw-r--r--win/tclWinInt.h131
-rw-r--r--win/tclWinLoad.c299
-rw-r--r--win/tclWinNotify.c451
-rw-r--r--win/tclWinPipe.c447
-rw-r--r--win/tclWinPort.h294
-rw-r--r--win/tclWinReg.c644
-rw-r--r--win/tclWinSerial.c200
-rw-r--r--win/tclWinSock.c3493
-rw-r--r--win/tclWinTest.c202
-rw-r--r--win/tclWinThrd.c84
-rw-r--r--win/tclWinThrd.h19
-rw-r--r--win/tclWinTime.c133
-rw-r--r--win/tclooConfig.sh19
-rw-r--r--win/tclsh.icobin57022 -> 3630 bytes
37 files changed, 5642 insertions, 6246 deletions
diff --git a/win/Makefile.in b/win/Makefile.in
index 132721a..e9a28c4 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -81,12 +81,7 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
#CFLAGS = $(CFLAGS_DEBUG)
#CFLAGS = $(CFLAGS_OPTIMIZE)
#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
-CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE
-
-# To compile without backward compatibility and deprecated code uncomment the
-# following
-NO_DEPRECATED_FLAGS =
-#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
+CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
# To enable compilation debugging reverse the comment characters on one of the
# following lines.
@@ -94,15 +89,15 @@ COMPILE_DEBUG_FLAGS =
#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG
#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+# Special compiler flags to use when building man2tcl on Windows.
+MAN2TCLFLAGS = @MAN2TCLFLAGS@
+
SRC_DIR = @srcdir@
ROOT_DIR = @srcdir@/..
-TOP_DIR = $(shell cd @srcdir@/..; pwd -P)
-GENERIC_DIR = $(TOP_DIR)/generic
-TOMMATH_DIR = $(TOP_DIR)/libtommath
-WIN_DIR = $(TOP_DIR)/win
-COMPAT_DIR = $(TOP_DIR)/compat
-PKGS_DIR = $(TOP_DIR)/pkgs
-ZLIB_DIR = $(COMPAT_DIR)/zlib
+GENERIC_DIR = @srcdir@/../generic
+TOMMATH_DIR = @srcdir@/../libtommath
+WIN_DIR = @srcdir@
+COMPAT_DIR = @srcdir@/../compat
# Converts a POSIX path to a Windows native path.
CYGPATH = @CYGPATH@
@@ -116,7 +111,6 @@ GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)')
TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)')
WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)')
ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)')
-ZLIB_DIR_NATIVE = $(shell $(CYGPATH) '$(ZLIB_DIR)')
#GENERIC_DIR_NATIVE = $(GENERIC_DIR)
#TOMMATH_DIR_NATIVE = $(TOMMATH_DIR)
#WIN_DIR_NATIVE = $(WIN_DIR)
@@ -124,7 +118,7 @@ ZLIB_DIR_NATIVE = $(shell $(CYGPATH) '$(ZLIB_DIR)')
# Fully qualify library path so that `make test`
# does not depend on the current directory.
-LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P)
+LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd)
LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)')
DLLSUFFIX = @DLLSUFFIX@
LIBSUFFIX = @LIBSUFFIX@
@@ -141,33 +135,37 @@ 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_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX}
+DDE_LIB_FILE = tcldde$(DDEVER)${LIBSUFFIX}
REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX}
-REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX}
-TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX}
-TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX}
-ZLIB_DLL_FILE = zlib1.dll
+REG_LIB_FILE = tclreg$(REGVER)${LIBSUFFIX}
+PIPE_DLL_FILE = tclpip$(VER)${DLLSUFFIX}
+
+SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \
+ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE)
+STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE)
+
+# To compile without backward compatibility and deprecated code
+# uncomment the following
+NO_DEPRECATED_FLAGS =
+#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
-SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
-STATIC_LIBRARIES = $(TCL_LIB_FILE)
+# TCL_EXE is the name of a tclsh executable that is available *BEFORE* running
+# make for the first time. Certain build targets (make genstubs) need it to be
+# available on the PATH. This executable should *NOT* be required just to do a
+# normal build although it can be required to run make dist.
+TCL_EXE = tclsh
TCLSH = tclsh$(VER)${EXESUFFIX}
+TCLTEST = tcltest${EXEEXT}
CAT32 = cat32$(EXEEXT)
MAN2TCL = man2tcl$(EXEEXT)
-# For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is
-# available *BEFORE* running make for the first time. Certain build targets
-# (make genstubs, make install) need it to be available on the PATH. This
-# executable should *NOT* be required just to do a normal build although
-# it can be required to run make dist.
-TCL_EXE = @TCL_EXE@
-
@SET_MAKE@
# Setting the VPATH variable to a list of paths will cause the Makefile to
# look into these paths when resolving .c to .obj dependencies.
-VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR):$(ZLIB_DIR)
+VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR)
AR = @AR@
RANLIB = @RANLIB@
@@ -185,10 +183,10 @@ EXEEXT = @EXEEXT@
OBJEXT = @OBJEXT@
STLIB_LD = @STLIB_LD@
SHLIB_LD = @SHLIB_LD@
-SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
+SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(LIBS)
SHLIB_CFLAGS = @SHLIB_CFLAGS@
SHLIB_SUFFIX = @SHLIB_SUFFIX@
-LIBS = @LIBS@ $(shell $(CYGPATH) '@ZLIB_LIBS@')
+LIBS = @LIBS@
RMDIR = rm -rf
MKDIR = mkdir -p
@@ -197,9 +195,9 @@ RM = rm -f
COPY = cp
CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
--I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH \
--DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
-${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}
+-I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \
+-I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
+${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}
CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@
@@ -214,7 +212,8 @@ TCLTEST_OBJS = \
tclTestObj.$(OBJEXT) \
tclTestProcBodyObj.$(OBJEXT) \
tclThreadTest.$(OBJEXT) \
- tclWinTest.$(OBJEXT)
+ tclWinTest.$(OBJEXT) \
+ testMain.$(OBJEXT)
GENERIC_OBJS = \
regcomp.$(OBJEXT) \
@@ -222,7 +221,6 @@ GENERIC_OBJS = \
regfree.$(OBJEXT) \
regerror.$(OBJEXT) \
tclAlloc.$(OBJEXT) \
- tclAssembly.$(OBJEXT) \
tclAsync.$(OBJEXT) \
tclBasic.$(OBJEXT) \
tclBinary.$(OBJEXT) \
@@ -232,16 +230,12 @@ GENERIC_OBJS = \
tclCmdIL.$(OBJEXT) \
tclCmdMZ.$(OBJEXT) \
tclCompCmds.$(OBJEXT) \
- tclCompCmdsGR.$(OBJEXT) \
- tclCompCmdsSZ.$(OBJEXT) \
tclCompExpr.$(OBJEXT) \
tclCompile.$(OBJEXT) \
tclConfig.$(OBJEXT) \
tclDate.$(OBJEXT) \
tclDictObj.$(OBJEXT) \
- tclDisassemble.$(OBJEXT) \
tclEncoding.$(OBJEXT) \
- tclEnsemble.$(OBJEXT) \
tclEnv.$(OBJEXT) \
tclEvent.$(OBJEXT) \
tclExecute.$(OBJEXT) \
@@ -256,7 +250,6 @@ GENERIC_OBJS = \
tclIOCmd.$(OBJEXT) \
tclIOGT.$(OBJEXT) \
tclIORChan.$(OBJEXT) \
- tclIORTrans.$(OBJEXT) \
tclIOSock.$(OBJEXT) \
tclIOUtil.$(OBJEXT) \
tclLink.$(OBJEXT) \
@@ -264,18 +257,9 @@ GENERIC_OBJS = \
tclListObj.$(OBJEXT) \
tclLoad.$(OBJEXT) \
tclMain.$(OBJEXT) \
- tclMain2.$(OBJEXT) \
tclNamesp.$(OBJEXT) \
tclNotify.$(OBJEXT) \
- tclOO.$(OBJEXT) \
- tclOOBasic.$(OBJEXT) \
- tclOOCall.$(OBJEXT) \
- tclOODefineCmds.$(OBJEXT) \
- tclOOInfo.$(OBJEXT) \
- tclOOMethod.$(OBJEXT) \
- tclOOStubInit.$(OBJEXT) \
tclObj.$(OBJEXT) \
- tclOptimize.$(OBJEXT) \
tclPanic.$(OBJEXT) \
tclParse.$(OBJEXT) \
tclPathObj.$(OBJEXT) \
@@ -292,6 +276,7 @@ GENERIC_OBJS = \
tclStringObj.$(OBJEXT) \
tclStrToD.$(OBJEXT) \
tclStubInit.$(OBJEXT) \
+ tclStubLib.$(OBJEXT) \
tclThread.$(OBJEXT) \
tclThreadAlloc.$(OBJEXT) \
tclThreadJoin.$(OBJEXT) \
@@ -301,8 +286,7 @@ GENERIC_OBJS = \
tclTrace.$(OBJEXT) \
tclUtf.$(OBJEXT) \
tclUtil.$(OBJEXT) \
- tclVar.$(OBJEXT) \
- tclZlib.$(OBJEXT)
+ tclVar.$(OBJEXT)
TOMMATH_OBJS = \
bncore.${OBJEXT} \
@@ -387,46 +371,45 @@ WIN_OBJS = \
tclWinThrd.$(OBJEXT) \
tclWinTime.$(OBJEXT)
+PIPE_OBJS = stub16.$(OBJEXT)
+
DDE_OBJS = tclWinDde.$(OBJEXT)
REG_OBJS = tclWinReg.$(OBJEXT)
-STUB_OBJS = \
- tclStubLib.$(OBJEXT) \
- tclTomMathStubLib.$(OBJEXT) \
- tclOOStubLib.$(OBJEXT)
+STUB_OBJS = tclStubLib.$(OBJEXT)
TCLSH_OBJS = tclAppInit.$(OBJEXT)
-ZLIB_OBJS = \
- adler32.$(OBJEXT) \
- compress.$(OBJEXT) \
- crc32.$(OBJEXT) \
- deflate.$(OBJEXT) \
- infback.$(OBJEXT) \
- inffast.$(OBJEXT) \
- inflate.$(OBJEXT) \
- inftrees.$(OBJEXT) \
- trees.$(OBJEXT) \
- uncompr.$(OBJEXT) \
- zutil.$(OBJEXT)
-
-TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@
+TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS}
TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]
-all: binaries libraries doc packages
+all: binaries libraries doc
-tcltest: $(TCLSH) $(TEST_DLL_FILE)
+tcltest: $(TCLTEST)
-binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH)
+binaries: @LIBRARIES@ $(TCLSH)
libraries:
doc:
-$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
- $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
+winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL)
+ TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
+ ./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS)
+ hcw /c /e tcl.hpj
+
+$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c
+ $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c
+
+$(TCLSH): $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES)
+ $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \
+ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
+ @VC_MANIFEST_EMBED_EXE@
+
+$(TCLTEST): $(TCL_LIB_FILE) $(TCLTEST_OBJS) $(CAT32) tclsh.$(RES)
+ $(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \
tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
@VC_MANIFEST_EMBED_EXE@
@@ -444,33 +427,37 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
@MAKE_STUB_LIB@ ${STUB_OBJS}
@POST_MAKE_LIB@
-${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@
- @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE)
+${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES)
+ @$(RM) ${TCL_DLL_FILE}
@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
@VC_MANIFEST_EMBED_DLL@
-${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
+${TCL_LIB_FILE}: ${TCL_OBJS}
@$(RM) ${TCL_LIB_FILE}
- @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
+ @MAKE_LIB@ ${TCL_OBJS}
@POST_MAKE_LIB@
-${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}
+${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE}
+ @$(RM) ${DDE_DLL_FILE}
@MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
-${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
+${DDE_LIB_FILE}: ${DDE_OBJS} ${TCL_LIB_FILE}
+ @$(RM) ${DDE_LIB_FILE}
+ @MAKE_LIB@ ${DDE_OBJS} ${TCL_LIB_FILE}
+
+${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE}
+ @$(RM) ${REG_DLL_FILE}
@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
-${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)
+${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE}
+ @$(RM) ${REG_LIB_FILE}
+ @MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE}
-# use pre-built zlib1.dll
-${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE}
- @if test "@ZLIB_LIBS@set" != "${ZLIB_DIR}/win32/zdll.libset" ; then \
- $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
- else \
- $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
- fi;
+# PIPE_DLL_FILE is actually an executable, don't build it like a DLL.
+
+${PIPE_DLL_FILE}: ${PIPE_OBJS}
+ @$(RM) ${PIPE_DLL_FILE}
+ @MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS) $(LDFLAGS_CONSOLE)
# Add the object extension to the implicit rules. By default .obj is not
# automatically added.
@@ -485,13 +472,31 @@ tclWinInit.${OBJEXT}: tclWinInit.c
$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tclWinPipe.${OBJEXT}: tclWinPipe.c
- $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+ $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \
+ $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
testMain.${OBJEXT}: tclAppInit.c
$(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME)
-tclMain2.${OBJEXT}: tclMain.c
- $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)
+tclTest.${OBJEXT}: tclTest.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+tclTestObj.${OBJEXT}: tclTestObj.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+tclWinTest.${OBJEXT}: tclWinTest.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+tclAppInit.${OBJEXT} : tclAppInit.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+# The following objects should be built using the stub interfaces
+
+tclWinReg.${OBJEXT} : tclWinReg.c
+ $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME)
+
+tclWinDde.${OBJEXT} : tclWinDde.c
+ $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME)
# TIP #59, embedding of configuration information into the binary library.
#
@@ -523,11 +528,6 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c
tclStubLib.${OBJEXT}: tclStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
-tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
- $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
-
-tclOOStubLib.${OBJEXT}: tclOOStubLib.c
- $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
# Implicit rule for all object files that will end up in the Tcl library
@@ -553,11 +553,11 @@ gendate:
# run (and the results checked) after updating to a new release of libtommath.
gentommath_h:
- $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/fix_tommath_h.tcl" \
- "$(TOMMATH_DIR_NATIVE)/tommath.h" \
- > "$(GENERIC_DIR_NATIVE)/tclTomMath.h"
+ $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\fix_tommath_h.tcl" \
+ "$(TOMMATH_DIR_NATIVE)\tommath.h" \
+ > "$(GENERIC_DIR_NATIVE)\tclTomMath.h"
-install: all install-binaries install-libraries install-doc install-packages
+install: all install-binaries install-libraries install-doc
install-binaries: binaries
@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
@@ -569,7 +569,7 @@ install-binaries: binaries
else true; \
fi; \
done;
- @for i in dde${DDEDOTVER} reg${REGDOTVER}; \
+ @for i in dde$(DDEDOTVER) reg$(REGDOTVER); \
do \
if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
@@ -577,14 +577,14 @@ install-binaries: binaries
else true; \
fi; \
done;
- @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH); \
+ @for i in $(TCL_DLL_FILE) $(TCLSH) $(PIPE_DLL_FILE); \
do \
if [ -f $$i ]; then \
echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \
$(COPY) $$i "$(BIN_INSTALL_DIR)"; \
fi; \
done
- @for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
+ @for i in tclConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
do \
if [ -f $$i ]; then \
echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \
@@ -593,27 +593,27 @@ install-binaries: binaries
done
@if [ -f $(DDE_DLL_FILE) ]; then \
echo Installing $(DDE_DLL_FILE); \
- $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
+ $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \
$(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
+ $(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}; \
+ $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \
fi
@if [ -f $(REG_DLL_FILE) ]; then \
echo Installing $(REG_DLL_FILE); \
- $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
+ $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \
$(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
+ $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \
fi
@if [ -f $(REG_LIB_FILE) ]; then \
echo Installing $(REG_LIB_FILE); \
- $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
+ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \
fi
install-libraries: libraries install-tzdata install-msgs
- @for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \
+ @for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \
$(SCRIPT_INSTALL_DIR); \
do \
if [ ! -d $$i ] ; then \
@@ -622,7 +622,7 @@ install-libraries: libraries install-tzdata install-msgs
else true; \
fi; \
done;
- @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
+ @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
@@ -632,7 +632,6 @@ install-libraries: libraries install-tzdata install-msgs
done;
@echo "Installing header files";
@for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
- "$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \
"$(GENERIC_DIR)/tclPlatDecls.h" \
"$(GENERIC_DIR)/tclTomMath.h" \
"$(GENERIC_DIR)/tclTomMathDecls.h"; \
@@ -649,15 +648,15 @@ 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.7.13 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.13.tm;
@echo "Installing library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
- @echo "Installing package msgcat 1.6.0 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.0.tm;
+ @echo "Installing package msgcat 1.5.2 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm;
@echo "Installing package tcltest 2.3.8 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.8.tm;
@echo "Installing package platform 1.0.14 as a Tcl Module";
@@ -671,12 +670,14 @@ install-libraries: libraries install-tzdata install-msgs
install-tzdata:
@echo "Installing time zone data"
- @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
+ @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \
+ ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \
"$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
install-msgs:
@echo "Installing message catalogs"
- @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
+ @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \
+ ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \
"$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
install-doc: doc
@@ -694,7 +695,6 @@ install-private-headers: libraries
@echo "Installing private header files";
@for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \
"$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \
- "$(GENERIC_DIR)/tclOOInt.h" "$(GENERIC_DIR)/tclOOIntDecls.h" \
"$(WIN_DIR)/tclWinPort.h" ; \
do \
$(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
@@ -704,21 +704,17 @@ install-private-headers: libraries
# tcltest, i.e.:
# % make test TESTFLAGS="-verbose bps -file fileName.test"
-test: test-tcl test-packages
-
-test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
+test: binaries $(TCLTEST)
TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
- -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
- package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
- package ifneeded registry 1.3.1 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
+ ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
+ -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
+ package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
-# Useful target to launch a built tclsh with the proper path,...
-runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
+# Useful target to launch a built tcltest with the proper path,...
+runtest: binaries $(TCLTEST)
@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
- package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
- package ifneeded registry 1.3.1 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
+ ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
+ package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
@@ -740,94 +736,16 @@ Makefile: $(SRC_DIR)/Makefile.in
cleanhelp:
$(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe
-clean: cleanhelp clean-packages
+clean: cleanhelp
$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
- $(RM) $(TCLSH) $(CAT32)
+ $(RM) $(TCLSH) $(TCLTEST) $(CAT32)
$(RM) *.pch *.ilk *.pdb
-distclean: distclean-packages clean
+distclean: clean
$(RM) Makefile config.status config.cache config.log tclConfig.sh \
tcl.hpj config.status.lineno
#
-# Bundled package targets
-#
-
-PKG_CFG_ARGS = @PKG_CFG_ARGS@
-PKG_DIR = ./pkgs
-
-packages:
- @builddir=`$(CYGPATH) $$(pwd -P)`; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ] ; then \
- if [ -x $$i/configure ] ; then \
- pkg=`basename $$i`; \
- mkdir -p $(PKG_DIR)/$$pkg; \
- if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; \
- echo "Configuring package '$$i' wd = `$(CYGPATH) $$(pwd -P)`"; \
- $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \
- fi ; \
- echo "Building package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \
- fi; \
- fi; \
- done; \
- cd $$builddir
-
-install-packages: packages
- @builddir=`pwd -P`; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- echo "Installing package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) install "DESTDIR=$(INSTALL_ROOT)"; ) \
- fi; \
- fi; \
- done; \
- cd $$builddir
-
-test-packages: tcltest packages
- @builddir=`pwd -P`; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- echo "Testing package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) "LD_LIBRARY_PATH=$$builddir:${LD_LIBRARY_PATH}" "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" "TCLLIBPATH=$$builddir/pkgs" test "TCLSH_PROG=$$builddir/${TCLSH}"; ) \
- fi; \
- fi; \
- done; \
- cd $$builddir
-
-clean-packages:
- @builddir=`pwd -P`; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
- fi; \
- fi; \
- done; \
- cd $$builddir
-
-distclean-packages:
- @builddir=`pwd -P`; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
- fi; \
- cd $$builddir; \
- rm -rf $(PKG_DIR)/$$pkg; \
- fi; \
- done; \
- rm -rf $(PKG_DIR)
-
-#
# Regenerate the stubs files.
#
@@ -841,29 +759,8 @@ genstubs:
$(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
"$(GENERIC_DIR_NATIVE)" \
"$(GENERIC_DIR_NATIVE)/tcl.decls" \
- "$(GENERIC_DIR_NATIVE)/tclInt.decls" \
+ "$(GENERIC_DIR_NATIVE)/tclInt.decls" \
"$(GENERIC_DIR_NATIVE)/tclTomMath.decls"
- $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
- "$(GENERIC_DIR_NATIVE)" \
- "$(GENERIC_DIR_NATIVE)/tclOO.decls"
-
-#
-# 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.* &
-# tk8.* up two directories from the TOOL_DIR.
-#
-
-TOOL_DIR=$(ROOT_DIR)/tools
-HTML_INSTALL_DIR=$(ROOT_DIR)/html
-html:
- $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)"
-
-html-tcl: $(TCLSH)
- $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl"
-
-html-tk: $(TCLSH)
- $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk"
#
# The list of all the targets that do not correspond to real files. This stops
diff --git a/win/README b/win/README
index 5e060ef..8288e3d 100644
--- a/win/README
+++ b/win/README
@@ -1,4 +1,4 @@
-Tcl 8.6 for Windows
+Tcl 8.5 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.6 Source Distribution (plus any patches)
+ Tcl 8.5 Source Distribution (plus any patches)
and
@@ -79,9 +79,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 tclsh86.exe, you must ensure that tcl86.dll is
+Note that in order to run tclsh85.exe, you must ensure that tcl85.dll is
on your path, in the system directory, or in the directory containing
-tclsh86.exe.
+tclsh85.exe.
Note: Tcl no longer provides support for Win32s.
diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat
index deb9e39..1a0f36d 100644
--- a/win/buildall.vc.bat
+++ b/win/buildall.vc.bat
@@ -59,15 +59,15 @@ if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl
:: Build the normal stuff along with the help file.
::
-set OPTS=none
-if not %SYMBOLS%.==. set OPTS=symbols
-nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1
+set OPTS=threads
+if not %SYMBOLS%.==. set OPTS=symbols,threads
+nmake -nologo -f makefile.vc release winhelp OPTS=%OPTS% %1
if errorlevel 1 goto error
:: Build the static core and shell.
::
-set OPTS=static,msvcrt
-if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt
+set OPTS=static,msvcrt,threads
+if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt,threads
nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
if errorlevel 1 goto error
diff --git a/win/cat.c b/win/cat.c
index d49e37c..d413923 100644
--- a/win/cat.c
+++ b/win/cat.c
@@ -9,19 +9,12 @@
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#ifdef TCL_BROKEN_MAINARGS
-/* On mingw32 and cygwin this doesn't work */
-# undef UNICODE
-# undef _UNICODE
-#endif
-
#include <stdio.h>
#include <io.h>
#include <string.h>
-#include <tchar.h>
int
-_tmain(void)
+main(void)
{
char buf[1024];
int n;
diff --git a/win/configure b/win/configure
index 4ce23f9..dc03e62 100755
--- a/win/configure
+++ b/win/configure
@@ -309,7 +309,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@@ -840,7 +840,7 @@ if test -n "$ac_init_help"; then
Optional Features:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --enable-threads build with threads (default: on)
+ --enable-threads build with threads (default: off)
--enable-shared build and link with shared libraries (default: on)
--enable-64bit enable 64bit support (where applicable)
--enable-wince enable Win/CE support (where applicable)
@@ -1308,29 +1308,22 @@ 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.6
+TCL_VERSION=8.5
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".4"
+TCL_MINOR_VERSION=5
+TCL_PATCH_LEVEL=".18"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-TCL_DDE_VERSION=1.4
+TCL_DDE_VERSION=1.3
TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=4
+TCL_DDE_MINOR_VERSION=3
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
-TCL_REG_VERSION=1.3
+TCL_REG_VERSION=1.2
TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=3
+TCL_REG_MINOR_VERSION=2
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
-PKG_CFG_ARGS=$@
-
-#------------------------------------------------------------------------
-# Empty slate for bundled packages, to avoid stale configuration
-#------------------------------------------------------------------------
-rm -Rf pkgs
-
#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
@@ -3064,12 +3057,12 @@ if test "${enable_threads+set}" = set; then
enableval="$enable_threads"
tcl_ok=$enableval
else
- tcl_ok=yes
+ tcl_ok=no
fi;
if test "$tcl_ok" = "yes"; then
- echo "$as_me:$LINENO: result: yes (default)" >&5
-echo "${ECHO_T}yes (default)" >&6
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
TCL_THREADS=1
cat >>confdefs.h <<\_ACEOF
#define TCL_THREADS 1
@@ -3083,8 +3076,8 @@ _ACEOF
else
TCL_THREADS=0
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ echo "$as_me:$LINENO: result: no (default)" >&5
+echo "${ECHO_T}no (default)" >&6
fi
@@ -3278,11 +3271,6 @@ echo "${ECHO_T}$CELIB_DIR" >&6
# Set some defaults (may get changed below)
EXTRA_CFLAGS=""
-cat >>confdefs.h <<\_ACEOF
-#define MODULE_SCOPE extern
-_ACEOF
-
-
# Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
echo "$as_me:$LINENO: checking for $ac_word" >&5
@@ -3340,7 +3328,7 @@ cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
- #ifndef _WIN32
+ #ifndef __WIN32__
#error cross-compiler
#endif
@@ -3463,7 +3451,7 @@ cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
- #ifdef _WIN32
+ #ifdef __WIN32__
#error win32
#endif
@@ -3514,80 +3502,14 @@ echo "${ECHO_T}$ac_cv_win32" >&6
echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;}
{ (exit 1); exit 1; }; }
fi
-
- hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
- echo "$as_me:$LINENO: checking for working -municode linker flag" >&5
-echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6
-if test "${ac_cv_municode+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
- #include <windows.h>
- int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_municode=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_municode=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $ac_cv_municode" >&5
-echo "${ECHO_T}$ac_cv_municode" >&6
- CFLAGS=$hold_cflags
- if test "$ac_cv_municode" = "yes" ; then
- extra_ldflags="$extra_ldflags -municode"
- else
- extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
- fi
fi
echo "$as_me:$LINENO: checking compiler flags" >&5
echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
- SHLIB_LD_LIBS='${LIBS}'
- LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
+ SHLIB_LD_LIBS=""
+ LIBS="-lws2_32"
# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
STLIB_LD='${AR} cr'
@@ -3607,6 +3529,9 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
echo "$as_me:$LINENO: result: using static flags" >&5
echo "${ECHO_T}using static flags" >&6
runtime=
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.a"
+ LIBFLAGSUFFIX="s\${DBGX}"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
else
@@ -3624,29 +3549,29 @@ echo "$as_me: error: ${CC} does not support the -shared option.
fi
runtime=
+ # Link with gcc since ld does not link to default libs like
+ # -luser32 and -lmsvcrt by default.
+ SHLIB_LD='${CC} -shared'
+ SHLIB_LD_LIBS='${LIBS}'
# Add SHLIB_LD_LIBS to the Make rule, not here.
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \
+ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)"
+ LIBSUFFIX="\${DBGX}.a"
+ LIBFLAGSUFFIX="\${DBGX}"
EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
fi
- # Link with gcc since ld does not link to default libs like
- # -luser32 and -lmsvcrt by default.
- SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \
- -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.a"
- LIBFLAGSUFFIX="\${DBGX}"
SHLIB_SUFFIX=.dll
EXTRA_CFLAGS="${extra_cflags}"
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
+ CFLAGS_WARNING="-Wall"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
@@ -3747,16 +3672,24 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
echo "$as_me:$LINENO: result: using static flags" >&5
echo "${ECHO_T}using static flags" >&6
runtime=-MT
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.lib"
+ LIBFLAGSUFFIX="s\${DBGX}"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
+ SHLIB_LD_LIBS=""
else
# dynamic
echo "$as_me:$LINENO: result: using shared flags" >&5
echo "${ECHO_T}using shared flags" >&6
runtime=-MD
# Add SHLIB_LD_LIBS to the Make rule, not here.
- LIBRARIES="\${SHARED_LIBRARIES}"
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
+ LIBSUFFIX="\${DBGX}.lib"
+ LIBFLAGSUFFIX="\${DBGX}"
EXESUFFIX="\${DBGX}.exe"
+ LIBRARIES="\${SHARED_LIBRARIES}"
+ SHLIB_LD_LIBS='${LIBS}'
case "x`echo \${VisualStudioVersion}`" in
x1[4-9]*)
lflags="${lflags} -nodefaultlib:libucrt.lib"
@@ -3765,12 +3698,9 @@ echo "${ECHO_T}using shared flags" >&6
;;
esac
fi
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.lib"
- LIBFLAGSUFFIX="\${DBGX}"
# This is a 2-stage check to make sure we have the 64-bit SDK
# We have to know where the SDK is installed.
@@ -3803,7 +3733,7 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
fi
fi
- LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
+ LIBS="user32.lib advapi32.lib ws2_32.lib"
case "x`echo \${VisualStudioVersion}`" in
x1[4-9]*)
@@ -4010,7 +3940,6 @@ _ACEOF
fi
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
- SHLIB_LD_LIBS='${LIBS}'
# link -lib only works when -lib is the first arg
STLIB_LD="${LINKBIN} -lib ${lflags}"
RC_OUT=-fo
@@ -4346,72 +4275,6 @@ _ACEOF
-# Cross-compiling
-case ${host_alias} in
-*mingw32*)
- TCL_EXE="tclsh"
- ;;
-*)
- TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}"
- ;;
-esac
-
-#------------------------------------------------------------------------
-# Add stuff for zlib; note that this is mostly done in the makefile now
-# as we just assume that the platform hasn't got a usable z.lib
-#------------------------------------------------------------------------
-
-if test "${enable_shared+set}" = "set"; then
-
- enableval="$enable_shared"
- tcl_ok=$enableval
-
-else
-
- tcl_ok=yes
-
-fi
-
-if test "$tcl_ok" = "yes"; then
-
- ZLIB_DLL_FILE=\${ZLIB_DLL_FILE}
-
- if test "$do64bit" = "yes"; then
-
- if test "$GCC" == "yes"; then
-
- ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a
-
-
-else
-
- ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib
-
-
-fi
-
-
-else
-
- ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib
-
-
-fi
-
-
-else
-
- ZLIB_OBJS=\${ZLIB_OBJS}
-
-
-fi
-
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_ZLIB 1
-_ACEOF
-
-
echo "$as_me:$LINENO: checking for intptr_t" >&5
echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6
if test "${ac_cv_type_intptr_t+set}" = set; then
@@ -4683,7 +4546,6 @@ _ACEOF
fi
-
#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------
@@ -4761,217 +4623,6 @@ _ACEOF
fi
-# See if the compiler supports intrinsics.
-
-echo "$as_me:$LINENO: checking for intrinsics support in compiler" >&5
-echo $ECHO_N "checking for intrinsics support in compiler... $ECHO_C" >&6
-if test "${tcl_cv_intrinsics+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-#include <intrin.h>
-
-int
-main ()
-{
-
- __cpuidex(0,0,0);
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_intrinsics=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_intrinsics=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_intrinsics" >&5
-echo "${ECHO_T}$tcl_cv_intrinsics" >&6
-if test "$tcl_cv_intrinsics" = "yes"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_INTRIN_H 1
-_ACEOF
-
-fi
-
-# See if the <wspiapi.h> header file is present
-
-echo "$as_me:$LINENO: checking for wspiapi.h" >&5
-echo $ECHO_N "checking for wspiapi.h... $ECHO_C" >&6
-if test "${tcl_cv_wspiapi_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#include <wspiapi.h>
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_wspiapi_h=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_wspiapi_h=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_wspiapi_h" >&5
-echo "${ECHO_T}$tcl_cv_wspiapi_h" >&6
-if test "$tcl_cv_wspiapi_h" = "yes"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_WSPIAPI_H 1
-_ACEOF
-
-fi
-
-# See if declarations like FINDEX_INFO_LEVELS are
-# missing from winbase.h. This is known to be
-# a problem with VC++ 5.2.
-
-echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
-echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
-if test "${tcl_cv_findex_enums+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-int
-main ()
-{
-
- FINDEX_INFO_LEVELS i;
- FINDEX_SEARCH_OPS j;
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_findex_enums=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_findex_enums=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
-echo "${ECHO_T}$tcl_cv_findex_enums" >&6
-if test "$tcl_cv_findex_enums" = "no"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NO_FINDEX_ENUMS 1
-_ACEOF
-
-fi
-
#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option. This macro depends on C flags, and should be called
@@ -5128,6 +4779,12 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\""
eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
+eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}"
+
+eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\""
+eval "TCL_BUILD_LIB_SPEC=\"-L`pwd` ${TCL_LIB_FLAG}\""
+eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\""
+
eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\""
eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\""
@@ -5135,10 +4792,6 @@ eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\""
eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""
-eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
-eval "TCL_BUILD_LIB_SPEC=\"-L`pwd` -ltcl${VER}${FLAGSUFFIX}\""
-eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\""
-
# Install time header dir can be set via --includedir
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
@@ -5204,12 +4857,6 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d
-
-
-
-
-
-
# empty on win
@@ -5952,9 +5599,6 @@ s,@DL_LIBS@,$DL_LIBS,;t t
s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t
s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t
s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t
-s,@ZLIB_DLL_FILE@,$ZLIB_DLL_FILE,;t t
-s,@ZLIB_LIBS@,$ZLIB_LIBS,;t t
-s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t
s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t
s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t
s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t
@@ -5965,14 +5609,8 @@ s,@TCL_VERSION@,$TCL_VERSION,;t t
s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t
s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t
s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t
-s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t
-s,@TCL_EXE@,$TCL_EXE,;t t
s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t
s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t
-s,@TCL_STATIC_LIB_FILE@,$TCL_STATIC_LIB_FILE,;t t
-s,@TCL_STATIC_LIB_FLAG@,$TCL_STATIC_LIB_FLAG,;t t
-s,@TCL_IMPORT_LIB_FILE@,$TCL_IMPORT_LIB_FILE,;t t
-s,@TCL_IMPORT_LIB_FLAG@,$TCL_IMPORT_LIB_FLAG,;t t
s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t
s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t
s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t
diff --git a/win/configure.in b/win/configure.in
index 9e9df90..6b30162 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -11,29 +11,22 @@ AC_PREREQ(2.59)
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TCL_VERSION=8.6
+TCL_VERSION=8.5
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".4"
+TCL_MINOR_VERSION=5
+TCL_PATCH_LEVEL=".18"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-TCL_DDE_VERSION=1.4
+TCL_DDE_VERSION=1.3
TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=4
+TCL_DDE_MINOR_VERSION=3
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
-TCL_REG_VERSION=1.3
+TCL_REG_VERSION=1.2
TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=3
+TCL_REG_MINOR_VERSION=2
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
-PKG_CFG_ARGS=$@
-
-#------------------------------------------------------------------------
-# Empty slate for bundled packages, to avoid stale configuration
-#------------------------------------------------------------------------
-rm -Rf pkgs
-
#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
@@ -105,43 +98,6 @@ SC_ENABLE_SHARED
SC_CONFIG_CFLAGS
-# Cross-compiling
-case ${host_alias} in
-*mingw32*)
- TCL_EXE="tclsh"
- ;;
-*)
- TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}"
- ;;
-esac
-
-#------------------------------------------------------------------------
-# Add stuff for zlib; note that this is mostly done in the makefile now
-# as we just assume that the platform hasn't got a usable z.lib
-#------------------------------------------------------------------------
-
-AS_IF([test "${enable_shared+set}" = "set"], [
- enableval="$enable_shared"
- tcl_ok=$enableval
-], [
- tcl_ok=yes
-])
-AS_IF([test "$tcl_ok" = "yes"], [
- AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}])
- AS_IF([test "$do64bit" = "yes"], [
- AS_IF([test "$GCC" == "yes"],[
- AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a])
- ], [
- AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/zdll.lib])
- ])
- ], [
- AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win32/zdll.lib])
- ])
-], [
- AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
-])
-AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?])
-
AC_CHECK_TYPE([intptr_t], [
AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
@@ -173,7 +129,6 @@ AC_CHECK_TYPE([uintptr_t], [
type wide enough to hold a pointer.])
fi
])
-
#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------
@@ -201,65 +156,6 @@ if test "$tcl_cv_findex_enums" = "no"; then
[Defined when enums are missing from winbase.h])
fi
-# See if the compiler supports intrinsics.
-
-AC_CACHE_CHECK(for intrinsics support in compiler,
- tcl_cv_intrinsics,
-AC_TRY_LINK([
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-#include <intrin.h>
-],
-[
- __cpuidex(0,0,0);
-],
- tcl_cv_intrinsics=yes,
- tcl_cv_intrinsics=no)
-)
-if test "$tcl_cv_intrinsics" = "yes"; then
- AC_DEFINE(HAVE_INTRIN_H, 1,
- [Defined when the compilers supports intrinsics])
-fi
-
-# See if the <wspiapi.h> header file is present
-
-AC_CACHE_CHECK(for wspiapi.h,
- tcl_cv_wspiapi_h,
-AC_TRY_COMPILE([
-#include <wspiapi.h>
-], [],
- tcl_cv_wspiapi_h=yes,
- tcl_cv_wspiapi_h=no)
-)
-if test "$tcl_cv_wspiapi_h" = "yes"; then
- AC_DEFINE(HAVE_WSPIAPI_H, 1,
- [Defined when wspiapi.h exists])
-fi
-
-# See if declarations like FINDEX_INFO_LEVELS are
-# missing from winbase.h. This is known to be
-# a problem with VC++ 5.2.
-
-AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h,
- tcl_cv_findex_enums,
-AC_TRY_COMPILE([
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-],
-[
- FINDEX_INFO_LEVELS i;
- FINDEX_SEARCH_OPS j;
-],
- tcl_cv_findex_enums=yes,
- tcl_cv_findex_enums=no)
-)
-if test "$tcl_cv_findex_enums" = "no"; then
- AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1,
- [Defined when enums are missing from winbase.h])
-fi
-
#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option. This macro depends on C flags, and should be called
@@ -294,6 +190,12 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""
eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
+eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}"
+
+eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\""
+eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\""
+eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\""
+
eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\""
eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\""
@@ -301,10 +203,6 @@ eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\""
eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""
-eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
-eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${FLAGSUFFIX}\""
-eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\""
-
# Install time header dir can be set via --includedir
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
@@ -367,15 +265,9 @@ AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
-AC_SUBST(PKG_CFG_ARGS)
-AC_SUBST(TCL_EXE)
AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
-AC_SUBST(TCL_STATIC_LIB_FILE)
-AC_SUBST(TCL_STATIC_LIB_FLAG)
-AC_SUBST(TCL_IMPORT_LIB_FILE)
-AC_SUBST(TCL_IMPORT_LIB_FLAG)
# empty on win
AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_FILE)
diff --git a/win/makefile.bc b/win/makefile.bc
index f5b5acc..6421682 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -50,6 +50,7 @@
#
# Not yet modified:
# - The 'plug-in-DLL' and the associated shell.
+# - The programs to create the windows help files.
#
# Suggestions and / or improvements are always welcome.
#
@@ -123,14 +124,14 @@ CFG_ENCODING = \"cp1252\"
NAMEPREFIX = tcl
STUBPREFIX = $(NAMEPREFIX)stub
-DOTVERSION = 8.6
-VERSION = 86
+DOTVERSION = 8.5
+VERSION = 85
-DDEVERSION = 14
-DDEDOTVERSION = 1.4
+DDEVERSION = 13
+DDEDOTVERSION = 1.3
-REGVERSION = 13
-REGDOTVERSION = 1.3
+REGVERSION = 12
+REGDOTVERSION = 1.2
BINROOT = ..
!IF "$(NODEBUG)" == "1"
@@ -159,6 +160,8 @@ TCLPLUGINDLLNAME = $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME)
TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
+TCLPIPEDLLNAME = $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
+TCLPIPEDLL = $(OUTDIR)\$(TCLPIPEDLLNAME)
TCLREGDLLNAME = $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll
TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME)
TCLDDEDLLNAME = $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll
@@ -200,16 +203,12 @@ TCLOBJS = \
$(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 \
@@ -232,15 +231,7 @@ TCLOBJS = \
$(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 \
@@ -255,6 +246,7 @@ TCLOBJS = \
$(TMPDIR)\tclScan.obj \
$(TMPDIR)\tclStringObj.obj \
$(TMPDIR)\tclStubInit.obj \
+ $(TMPDIR)\tclStubLib.obj \
$(TMPDIR)\tclThread.obj \
$(TMPDIR)\tclThreadJoin.obj \
$(TMPDIR)\tclTimer.obj \
@@ -275,13 +267,9 @@ TCLOBJS = \
$(TMPDIR)\tclWinPipe.obj \
$(TMPDIR)\tclWinSock.obj \
$(TMPDIR)\tclWinThrd.obj \
- $(TMPDIR)\tclWinTime.obj \
- $(TMPDIR)\tclZlib.obj
+ $(TMPDIR)\tclWinTime.obj
-TCLSTUBOBJS = \
- $(TMPDIR)\tclStubLib.obj \
- $(TMPDIR)\tclTomMathStubLib.obj \
- $(TMPDIR)\tclOOStubLib.obj
+TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj
WINDIR = $(ROOT)\win
GENERICDIR = $(ROOT)\generic
@@ -290,7 +278,6 @@ 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
@@ -343,7 +330,7 @@ LNLIBS = import32 cw32mt
######################################################################
release: setup $(TCLSH) dlls
-dlls: setup $(TCLREGDLL) $(TCLDDEDLL)
+dlls: setup $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL)
all: setup $(TCLSH) dlls $(CAT32)
tcltest: setup $(TCLTEST) dlls $(CAT32)
plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
@@ -392,6 +379,11 @@ $(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
$(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
!
+$(TCLPIPEDLL): $(WINDIR)\stub16.c
+ $(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WINDIR)\stub16.c
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
+ $(TMPDIR)\stub16.obj, $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
+
$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
$(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
$(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
@@ -415,10 +407,10 @@ install-binaries: $(TCLSH)
@copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
@echo Installing "$(TCLSH)"
@copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
+ @echo Installing $(TCLPIPEDLLNAME)
+ @copy "$(TCLPIPEDLL)" "$(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)"
@@ -428,10 +420,10 @@ install-libraries:
-@$(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 http2.7
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.7"
+ -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7"
+ -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7"
@echo Installing opt0.4
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
-@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
@@ -455,7 +447,7 @@ install-libraries:
-@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 "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.2"
-@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2"
@echo Installing encoding files
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
@@ -463,8 +455,6 @@ install-libraries:
@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)"
@@ -484,6 +474,29 @@ genstubs:
$(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls
#
+# Regenerate the windows help files.
+#
+
+TCLTOOLS = $(ROOT)/tools
+MAN2TCL = $(TCLTOOLS)/man2tcl
+TCLRTF = $(TCLTOOLS)/tcl.rtf
+TCLHPJ = $(TCLTOOLS)/tcl.hpj
+MAN2HELP = $(TCLTOOLS)/man2help.tcl
+HCRTF = $(TOOLS32)/bin/hcrtf.exe
+
+winhelp: $(TCLRTF)
+ cd $(TCLTOOLS)
+ start /wait $(HCRTF) -xn $(TCLHPJ)
+
+$(MAN2TCL).exe: $(MAN2TCL).obj
+ cd $(TCLTOOLS)
+ $(cc32) /nologo /G4 /ML /O2 $(MAN2TCL).c
+
+$(TCLRTF): $(MAN2TCL).exe $(TCLSH)
+ cd $(TCLTOOLS)
+ ..\win\$(TCLSH) $(MAN2HELP) $(NAMEPREFIX) $(VERSION) $(ROOT)/doc ../../tk$(DOTVERSION)/doc
+
+#
# Special case object file targets
#
$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
@@ -529,12 +542,6 @@ $(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c
$(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
@@ -588,7 +595,3 @@ clean:
-@$(RM) $(TMPDIR)\*.exe
-@$(RMDIR) $(OUTDIR)
-@$(RMDIR) $(TMPDIR)
-
-# Local Variables:
-# mode: makefile
-# End:
diff --git a/win/makefile.vc b/win/makefile.vc
index 70f3f6e..267f53f 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -1,4 +1,4 @@
-#-------------------------------------------------------------
+#------------------------------------------------------------- -*- makefile -*-
# makefile.vc --
#
# Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+)
@@ -43,7 +43,8 @@ the build instructions.
#
# 3) Targets are:
# release -- Builds the core, the shell and the dlls. (default)
-# dlls -- Just builds the windows extensions
+# dlls -- Just builds the windows extensions and the 16-bit DOS
+# pipe/thunk helper app.
# shell -- Just builds the shell and the core.
# core -- Only builds the core [tclXX.(dll|lib)].
# all -- Builds everything.
@@ -61,17 +62,15 @@ the build instructions.
# troff manual pages found in $(ROOT)\doc. You need to
# have installed the HTML Help Compiler package from Microsoft
# to produce the .chm file.
-# winhelp -- (deprecated) Builds the windows .hlp file for Tcl from
-# the troff man files found in $(ROOT)\doc. This type of
-# help file is deprecated by Microsoft in favour of html
-# help files (.chm)
+# winhelp -- Builds the windows .hlp file for Tcl from the troff man
+# files found in $(ROOT)\doc.
#
# 4) Macros usable on the commandline:
# INSTALLDIR=<path>
# Sets where to install Tcl from the built binaries.
# C:\Progra~1\Tcl is assumed when not specified.
#
-# OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,tclalloc,unchecked,none
+# OPTS=loimpact,msvcrt,static,staticpkg,symbols,threads,profile,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.
@@ -82,24 +81,17 @@ the build instructions.
# using libcmt(d) as the C runtime [by default] to
# msvcrt(d). This is useful for static embedding
# support.
-# nothreads= Turns off full multithreading support.
-# pdbs = Build detached symbols for release builds.
-# profile = Adds profiling hooks. Map file is assumed.
# static = Builds a static library of the core instead of a
-# dll. The static library will contain the dde and reg
-# extensions. External applications who want to use
-# this, need to link with the stub library as well as
-# the static Tcl library.The shell will be static (and
-# large), as well.
-# staticpkg = Affects the static option only to switch
+# dll. The shell will be static (and large), as well.
+# staticpkg= Affects the static option only to switch
# tclshXX.exe to have the dde and reg extension linked
# inside it.
-# symbols = Debug build. Links to the debug C runtime, disables
-# optimizations and creates pdb symbols files.
-# thrdalloc = Use the thread allocator (shared global free pool)
-# This is the default on threaded builds.
-# tclalloc = Use the old non-thread allocator
-# unchecked= Allows a symbols build to not use the debug
+# threads = Turns on full multithreading support.
+# thrdalloc = Use the thread allocator (shared global free pool).
+# thrdstorage = Use the generic thread storage support.
+# symbols = Adds symbols for step debugging.
+# profile = Adds profiling hooks. Map file is assumed.
+# unchecked = Allows a symbols build to not use the debug
# enabled runtime (msvcrt.dll not msvcrtd.dll
# or libcmt.lib not libcmtd.lib).
#
@@ -190,14 +182,14 @@ STUBPREFIX = $(PROJECT)stub
DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-DDEDOTVERSION = 1.4
+DDEDOTVERSION = 1.3
DDEVERSION = $(DDEDOTVERSION:.=)
-REGDOTVERSION = 1.3
+REGDOTVERSION = 1.2
REGVERSION = $(REGDOTVERSION:.=)
-BINROOT = $(MAKEDIR) # originally .
-ROOT = $(MAKEDIR)\.. # originally ..
+BINROOT = .
+ROOT = ..
TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
@@ -208,6 +200,8 @@ TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe
TCLSH = $(OUT_DIR)\$(TCLSHNAME)
+TCLPIPEDLLNAME = $(PROJECT)pip$(VERSION)$(SUFX:t=).dll
+TCLPIPEDLL = $(OUT_DIR)\$(TCLPIPEDLLNAME)
TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
@@ -236,12 +230,10 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
TCLSHOBJS = \
$(TMP_DIR)\tclAppInit.obj \
-!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
$(TMP_DIR)\tclWinReg.obj \
$(TMP_DIR)\tclWinDde.obj \
!endif
-!endif
$(TMP_DIR)\tclsh.res
TCLTESTOBJS = \
@@ -250,21 +242,18 @@ TCLTESTOBJS = \
$(TMP_DIR)\tclTestProcBodyObj.obj \
$(TMP_DIR)\tclThreadTest.obj \
$(TMP_DIR)\tclWinTest.obj \
-!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
$(TMP_DIR)\tclWinReg.obj \
$(TMP_DIR)\tclWinDde.obj \
!endif
-!endif
$(TMP_DIR)\testMain.obj
-COREOBJS = \
+TCLOBJS = \
$(TMP_DIR)\regcomp.obj \
$(TMP_DIR)\regerror.obj \
$(TMP_DIR)\regexec.obj \
$(TMP_DIR)\regfree.obj \
$(TMP_DIR)\tclAlloc.obj \
- $(TMP_DIR)\tclAssembly.obj \
$(TMP_DIR)\tclAsync.obj \
$(TMP_DIR)\tclBasic.obj \
$(TMP_DIR)\tclBinary.obj \
@@ -274,16 +263,12 @@ COREOBJS = \
$(TMP_DIR)\tclCmdIL.obj \
$(TMP_DIR)\tclCmdMZ.obj \
$(TMP_DIR)\tclCompCmds.obj \
- $(TMP_DIR)\tclCompCmdsGR.obj \
- $(TMP_DIR)\tclCompCmdsSZ.obj \
$(TMP_DIR)\tclCompExpr.obj \
$(TMP_DIR)\tclCompile.obj \
$(TMP_DIR)\tclConfig.obj \
$(TMP_DIR)\tclDate.obj \
$(TMP_DIR)\tclDictObj.obj \
- $(TMP_DIR)\tclDisassemble.obj \
$(TMP_DIR)\tclEncoding.obj \
- $(TMP_DIR)\tclEnsemble.obj \
$(TMP_DIR)\tclEnv.obj \
$(TMP_DIR)\tclEvent.obj \
$(TMP_DIR)\tclExecute.obj \
@@ -300,24 +285,14 @@ COREOBJS = \
$(TMP_DIR)\tclIOSock.obj \
$(TMP_DIR)\tclIOUtil.obj \
$(TMP_DIR)\tclIORChan.obj \
- $(TMP_DIR)\tclIORTrans.obj \
$(TMP_DIR)\tclLink.obj \
$(TMP_DIR)\tclListObj.obj \
$(TMP_DIR)\tclLiteral.obj \
$(TMP_DIR)\tclLoad.obj \
$(TMP_DIR)\tclMain.obj \
- $(TMP_DIR)\tclMain2.obj \
$(TMP_DIR)\tclNamesp.obj \
$(TMP_DIR)\tclNotify.obj \
- $(TMP_DIR)\tclOO.obj \
- $(TMP_DIR)\tclOOBasic.obj \
- $(TMP_DIR)\tclOOCall.obj \
- $(TMP_DIR)\tclOODefineCmds.obj \
- $(TMP_DIR)\tclOOInfo.obj \
- $(TMP_DIR)\tclOOMethod.obj \
- $(TMP_DIR)\tclOOStubInit.obj \
$(TMP_DIR)\tclObj.obj \
- $(TMP_DIR)\tclOptimize.obj \
$(TMP_DIR)\tclPanic.obj \
$(TMP_DIR)\tclParse.obj \
$(TMP_DIR)\tclPathObj.obj \
@@ -334,6 +309,7 @@ COREOBJS = \
$(TMP_DIR)\tclStringObj.obj \
$(TMP_DIR)\tclStrToD.obj \
$(TMP_DIR)\tclStubInit.obj \
+ $(TMP_DIR)\tclStubLib.obj \
$(TMP_DIR)\tclThread.obj \
$(TMP_DIR)\tclThreadAlloc.obj \
$(TMP_DIR)\tclThreadJoin.obj \
@@ -344,22 +320,20 @@ COREOBJS = \
$(TMP_DIR)\tclUtf.obj \
$(TMP_DIR)\tclUtil.obj \
$(TMP_DIR)\tclVar.obj \
- $(TMP_DIR)\tclZlib.obj
-
-ZLIBOBJS = \
- $(TMP_DIR)\adler32.obj \
- $(TMP_DIR)\compress.obj \
- $(TMP_DIR)\crc32.obj \
- $(TMP_DIR)\deflate.obj \
- $(TMP_DIR)\infback.obj \
- $(TMP_DIR)\inffast.obj \
- $(TMP_DIR)\inflate.obj \
- $(TMP_DIR)\inftrees.obj \
- $(TMP_DIR)\trees.obj \
- $(TMP_DIR)\uncompr.obj \
- $(TMP_DIR)\zutil.obj
-
-TOMMATHOBJS = \
+ $(TMP_DIR)\tclWin32Dll.obj \
+ $(TMP_DIR)\tclWinChan.obj \
+ $(TMP_DIR)\tclWinConsole.obj \
+ $(TMP_DIR)\tclWinSerial.obj \
+ $(TMP_DIR)\tclWinError.obj \
+ $(TMP_DIR)\tclWinFCmd.obj \
+ $(TMP_DIR)\tclWinFile.obj \
+ $(TMP_DIR)\tclWinInit.obj \
+ $(TMP_DIR)\tclWinLoad.obj \
+ $(TMP_DIR)\tclWinNotify.obj \
+ $(TMP_DIR)\tclWinPipe.obj \
+ $(TMP_DIR)\tclWinSock.obj \
+ $(TMP_DIR)\tclWinThrd.obj \
+ $(TMP_DIR)\tclWinTime.obj \
$(TMP_DIR)\bncore.obj \
$(TMP_DIR)\bn_reverse.obj \
$(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \
@@ -423,36 +397,13 @@ TOMMATHOBJS = \
$(TMP_DIR)\bn_s_mp_add.obj \
$(TMP_DIR)\bn_s_mp_mul_digs.obj \
$(TMP_DIR)\bn_s_mp_sqr.obj \
- $(TMP_DIR)\bn_s_mp_sub.obj
-
-PLATFORMOBJS = \
- $(TMP_DIR)\tclWin32Dll.obj \
- $(TMP_DIR)\tclWinChan.obj \
- $(TMP_DIR)\tclWinConsole.obj \
- $(TMP_DIR)\tclWinError.obj \
- $(TMP_DIR)\tclWinFCmd.obj \
- $(TMP_DIR)\tclWinFile.obj \
- $(TMP_DIR)\tclWinInit.obj \
- $(TMP_DIR)\tclWinLoad.obj \
- $(TMP_DIR)\tclWinNotify.obj \
- $(TMP_DIR)\tclWinPipe.obj \
- $(TMP_DIR)\tclWinSerial.obj \
- $(TMP_DIR)\tclWinSock.obj \
- $(TMP_DIR)\tclWinThrd.obj \
- $(TMP_DIR)\tclWinTime.obj \
-!if $(STATIC_BUILD)
- $(TMP_DIR)\tclWinReg.obj \
- $(TMP_DIR)\tclWinDde.obj \
-!else
+ $(TMP_DIR)\bn_s_mp_sub.obj \
+!if !$(STATIC_BUILD)
$(TMP_DIR)\tcl.res
!endif
-TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
-
TCLSTUBOBJS = \
- $(TMP_DIR)\tclStubLib.obj \
- $(TMP_DIR)\tclTomMathStubLib.obj \
- $(TMP_DIR)\tclOOStubLib.obj
+ $(TMP_DIR)\tclStubLib.obj
### The following paths CANNOT have spaces in them.
COMPATDIR = $(ROOT)\compat
@@ -461,7 +412,6 @@ GENERICDIR = $(ROOT)\generic
TOMMATHDIR = $(ROOT)\libtommath
TOOLSDIR = $(ROOT)\tools
WINDIR = $(ROOT)\win
-PKGSDIR = $(ROOT)\pkgs
#---------------------------------------------------------------------
# Compile flags
@@ -503,7 +453,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 = -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline
BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE
TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES)
@@ -550,7 +500,7 @@ dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
-baselibs = netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib
+baselibs = kernel32.lib user32.lib ws2_32.lib
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
@@ -575,27 +525,27 @@ TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
# Project specific targets
#---------------------------------------------------------------------
-release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
+release: setup $(TCLSH) $(TCLSTUBLIB) dlls
core: setup $(TCLLIB) $(TCLSTUBLIB)
shell: setup $(TCLSH)
-dlls: setup $(TCLREGLIB) $(TCLDDELIB)
-all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs
+dlls: setup $(TCLPIPEDLL) $(TCLREGLIB) $(TCLDDELIB)
+all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32)
tcltest: setup $(TCLTEST) dlls $(CAT32)
-install: install-binaries install-libraries install-docs install-pkgs
+install: install-binaries install-libraries install-docs
-test: test-core test-pkgs
+test: test-core
test-core: setup $(TCLTEST) dlls $(CAT32)
set TCL_LIBRARY=$(ROOT:\=/)/library
!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
- package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
- package ifneeded registry 1.3.1 [list load "$(TCLREGLIB:\=/)" registry]
+ package ifneeded dde 1.3.3 [list load "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.2.2 [list load "$(TCLREGLIB:\=/)" registry]
<<
!else
@echo Please wait while the tests are collected...
$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
- package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde]
- package ifneeded registry 1.3.1 "$(TCLREGLIB:\=/)" registry]
+ package ifneeded dde 1.3.3 "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.2.2 "$(TCLREGLIB:\=/)" registry]
<<
type tests.log | more
!endif
@@ -627,6 +577,7 @@ $**
$**
<<
$(_VC_MANIFEST_EMBED_DLL)
+ -@del $*.exp
!endif
$(TCLSTUBLIB): $(TCLSTUBOBJS)
@@ -640,6 +591,11 @@ $(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
$(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
$(_VC_MANIFEST_EMBED_EXE)
+$(TCLPIPEDLL): $(WINDIR)\stub16.c
+ $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WINDIR)\stub16.c
+ $(link32) $(conlflags) -out:$@ $(TMP_DIR)\stub16.obj $(baselibs)
+ $(_VC_MANIFEST_EMBED_DLL)
+
!if $(STATIC_BUILD)
$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
$(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
@@ -648,6 +604,8 @@ $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
$(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \
$** $(baselibs)
$(_VC_MANIFEST_EMBED_DLL)
+ -@del $*.exp
+ -@del $*.lib
!endif
!if $(STATIC_BUILD)
@@ -658,40 +616,10 @@ $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
$(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \
$** $(baselibs)
$(_VC_MANIFEST_EMBED_DLL)
+ -@del $*.exp
+ -@del $*.lib
!endif
-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\
- popd \
- )
-
-test-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) test &\
- popd \
- )
-
-install-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) install &\
- popd \
- )
-
-clean-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\
- popd \
- )
-
$(CAT32): $(WINDIR)\cat.c
$(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
$(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \
@@ -709,8 +637,6 @@ genstubs:
$(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
$(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \
$(GENERICDIR:\=/)/tclTomMath.decls
- $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
- $(GENERICDIR:\=/)/tclOO.decls
!endif
@@ -926,10 +852,6 @@ $(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
-DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
-Fo$@ $?
-$(TMP_DIR)\tclMain2.obj: $(GENERICDIR)\tclMain.c
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -DTCL_ASCII_MAIN \
- -Fo$@ $?
-
$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
$(cc32) $(TCL_CFLAGS) -Fo$@ $?
@@ -939,9 +861,6 @@ $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
$(cc32) $(TCL_CFLAGS) -Fo$@ $?
-$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
- $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $?
-
$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
$(cc32) -DBUILD_tcl $(TCL_CFLAGS) \
-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
@@ -987,12 +906,6 @@ $(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
-$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
- $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
-
-$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
- $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
-
$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
@nmakehlp -s << $** >$@
@MACHINE@ $(MACHINE:IX86=X86)
@@ -1034,9 +947,7 @@ $(TCLOBJS)
#---------------------------------------------------------------------
-# Implicit rules. A limitation exists with nmake that requires that
-# source directory can not contain spaces in the path. This an
-# absolute.
+# Implicit rules
#---------------------------------------------------------------------
{$(WINDIR)}.c{$(TMP_DIR)}.obj::
@@ -1059,11 +970,6 @@ $<
$<
<<
-{$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
-$<
-<<
-
{$(WINDIR)}.rc{$(TMP_DIR)}.res:
$(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
-d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
@@ -1092,6 +998,10 @@ install-binaries:
@echo Installing $(TCLSHNAME)
@$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
!endif
+!if exist($(TCLPIPEDLL))
+ @echo Installing $(TCLPIPEDLLNAME)
+ @$(CPY) "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)\"
+!endif
@echo Installing $(TCLSTUBLIBNAME)
@$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"
@@ -1112,13 +1022,9 @@ install-libraries: tclConfig install-msgs install-tzdata
$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform"
@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \
$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6$(NULL)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6"
@echo Installing header files
@$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\"
@@ -1136,7 +1042,6 @@ install-libraries: tclConfig install-msgs install-tzdata
@$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\"
@$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\"
@$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\"
- @$(CPY) "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\"
@echo Installing library http1.0 directory
@$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
"$(SCRIPT_INSTALL_DIR)\http1.0\"
@@ -1145,7 +1050,7 @@ install-libraries: tclConfig install-msgs install-tzdata
"$(SCRIPT_INSTALL_DIR)\opt0.4\"
@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\http\http.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\http-$(PKG_HTTP_VER).tm"
@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
"$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm"
@@ -1216,7 +1121,7 @@ tidy:
@echo Removing $(TCLREGLIB) ...
@if exist $(TCLREGLIB) del $(TCLREGLIB)
-clean: clean-pkgs
+clean:
@echo Cleaning $(TMP_DIR)\* ...
@if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
@echo Cleaning $(WINDIR)\nmakehlp.obj ...
@@ -1237,7 +1142,3 @@ realclean: hose
hose:
@echo Hosing $(OUT_DIR)\* ...
@if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
-
-# Local Variables:
-# mode: makefile
-# End:
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index b1a1517..d0edcf0 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -498,10 +498,9 @@ GetVersionFromFile(
p = strstr(szBuffer, match);
if (p != NULL) {
/*
- * Skip to first digit after the match.
+ * Skip to first digit.
*/
- p += strlen(match);
while (*p && !isdigit(*p)) {
++p;
}
@@ -631,11 +630,11 @@ SubstituteFile(
}
}
#endif
-
+
/*
* Run the substitutions over each line of the input
*/
-
+
while (fgets(szBuffer, cbBuffer, fp) != NULL) {
list_item_t *p = NULL;
for (p = substPtr; p != NULL; p = p->nextPtr) {
@@ -655,7 +654,7 @@ SubstituteFile(
}
printf(szBuffer);
}
-
+
list_free(&substPtr);
}
fclose(fp);
diff --git a/win/rules.vc b/win/rules.vc
index d4c2f35..78a167a 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -159,7 +159,7 @@ DEBUGFLAGS = $(DEBUGFLAGS) -RTC1
DEBUGFLAGS = $(DEBUGFLAGS) -GZ
!endif
-COMPILERFLAGS =-W3 -DUNICODE -D_UNICODE
+COMPILERFLAGS =-W3
# In v13 -GL and -YX are incompatible.
!if [nmakehlp -c -YX]
@@ -213,7 +213,7 @@ LINKERFLAGS =-ltcg
!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
STATIC_BUILD = 0
-TCL_THREADS = 1
+TCL_THREADS = 0
DEBUG = 0
SYMBOLS = 0
PROFILE = 0
@@ -221,7 +221,7 @@ PGO = 0
MSVCRT = 1
LOIMPACT = 0
TCL_USE_STATIC_PACKAGES = 0
-USE_THREAD_ALLOC = 1
+USE_THREAD_ALLOC = 0
UNCHECKED = 0
!else
!if [nmakehlp -f $(OPTS) "static"]
@@ -246,13 +246,13 @@ TCL_USE_STATIC_PACKAGES = 1
!else
TCL_USE_STATIC_PACKAGES = 0
!endif
-!if [nmakehlp -f $(OPTS) "nothreads"]
-!message *** Compile explicitly for non-threaded tcl
-TCL_THREADS = 0
-USE_THREAD_ALLOC= 0
-!else
+!if [nmakehlp -f $(OPTS) "threads"]
+!message *** Doing threads
TCL_THREADS = 1
-USE_THREAD_ALLOC= 1
+USE_THREAD_ALLOC = 1
+!else
+TCL_THREADS = 0
+USE_THREAD_ALLOC = 0
!endif
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols
@@ -585,8 +585,8 @@ TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe"
TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
TCL_LIBRARY = $(_TCLDIR)\lib
-TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib"
+TCLREGLIB = "$(_TCLDIR)\lib\tclreg12$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib"
COFFBASE = \must\have\tcl\sources\to\build\this\target
TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES = -I"$(_TCLDIR)\include"
@@ -598,8 +598,8 @@ TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe"
TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
TCL_LIBRARY = $(_TCLDIR)\library
-TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib"
+TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
COFFBASE = "$(_TCLDIR)\win\coffbase.txt"
TCLTOOLSDIR = $(_TCLDIR)\tools
TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
diff --git a/win/stub16.c b/win/stub16.c
new file mode 100644
index 0000000..70fc051
--- /dev/null
+++ b/win/stub16.c
@@ -0,0 +1,195 @@
+/*
+ * stub16.c
+ *
+ * A helper program used for running 16-bit DOS applications under
+ * Windows 95.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#define STRICT
+
+#include <windows.h>
+#include <stdio.h>
+
+static HANDLE CreateTempFile(void);
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * main
+ *
+ * Entry point for the 32-bit console mode app used by Windows 95 to help
+ * run the 16-bit program specified on the command line.
+ *
+ * 1. EOF on a pipe that connects a detached 16-bit process and a 32-bit
+ * process is never seen. So, this process runs the 16-bit process
+ * _attached_, and then it is run detached from the calling 32-bit
+ * process.
+ *
+ * 2. If a 16-bit process blocks reading from or writing to a pipe, it
+ * never wakes up, and eventually brings the whole system down with it if
+ * you try to kill the process. This app simulates pipes. If any of the
+ * stdio handles is a pipe, this program accumulates information into
+ * temp files and forwards it to or from the DOS application as
+ * appropriate. This means that this program must receive EOF from a
+ * stdin pipe before it will actually start the DOS app, and the DOS app
+ * must finish generating stdout or stderr before the data will be sent
+ * to the next stage of the pipe. If the stdio handles are not pipes, no
+ * accumulation occurs and the data is passed straight through to and
+ * from the DOS application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The child process is created and this process waits for it to
+ * complete.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+main(void)
+{
+ DWORD dwRead, dwWrite;
+ char *cmdLine;
+ HANDLE hStdInput, hStdOutput, hStdError;
+ HANDLE hFileInput, hFileOutput, hFileError;
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+ char buf[8192];
+ DWORD result;
+
+ hFileInput = INVALID_HANDLE_VALUE;
+ hFileOutput = INVALID_HANDLE_VALUE;
+ hFileError = INVALID_HANDLE_VALUE;
+ result = 1;
+
+ /*
+ * Don't get command line from argc, argv, because the command line
+ * tokenizer will have stripped off all the escape sequences needed for
+ * quotes and backslashes, and then we'd have to put them all back in
+ * again. Get the raw command line and parse off what we want ourselves.
+ * The command line should be of the form:
+ *
+ * stub16.exe program arg1 arg2 ...
+ */
+
+ cmdLine = strchr(GetCommandLine(), ' ');
+ if (cmdLine == NULL) {
+ return 1;
+ }
+ cmdLine++;
+
+ hStdInput = GetStdHandle(STD_INPUT_HANDLE);
+ hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
+ hStdError = GetStdHandle(STD_ERROR_HANDLE);
+
+ if (GetFileType(hStdInput) == FILE_TYPE_PIPE) {
+ hFileInput = CreateTempFile();
+ if (hFileInput == INVALID_HANDLE_VALUE) {
+ goto cleanup;
+ }
+ while (ReadFile(hStdInput, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
+ if (dwRead == 0) {
+ break;
+ }
+ if (WriteFile(hFileInput, buf, dwRead, &dwWrite, NULL) == FALSE) {
+ goto cleanup;
+ }
+ }
+ SetFilePointer(hFileInput, 0, 0, FILE_BEGIN);
+ SetStdHandle(STD_INPUT_HANDLE, hFileInput);
+ }
+ if (GetFileType(hStdOutput) == FILE_TYPE_PIPE) {
+ hFileOutput = CreateTempFile();
+ if (hFileOutput == INVALID_HANDLE_VALUE) {
+ goto cleanup;
+ }
+ SetStdHandle(STD_OUTPUT_HANDLE, hFileOutput);
+ }
+ if (GetFileType(hStdError) == FILE_TYPE_PIPE) {
+ hFileError = CreateTempFile();
+ if (hFileError == INVALID_HANDLE_VALUE) {
+ goto cleanup;
+ }
+ SetStdHandle(STD_ERROR_HANDLE, hFileError);
+ }
+
+ ZeroMemory(&si, sizeof(si));
+ si.cb = sizeof(si);
+ if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si,
+ &pi) == FALSE) {
+ goto cleanup;
+ }
+
+ WaitForInputIdle(pi.hProcess, 5000);
+ WaitForSingleObject(pi.hProcess, INFINITE);
+ GetExitCodeProcess(pi.hProcess, &result);
+ CloseHandle(pi.hProcess);
+ CloseHandle(pi.hThread);
+
+ if (hFileOutput != INVALID_HANDLE_VALUE) {
+ SetFilePointer(hFileOutput, 0, 0, FILE_BEGIN);
+ while (ReadFile(hFileOutput, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
+ if (dwRead == 0) {
+ break;
+ }
+ if (WriteFile(hStdOutput, buf, dwRead, &dwWrite, NULL) == FALSE) {
+ break;
+ }
+ }
+ }
+ if (hFileError != INVALID_HANDLE_VALUE) {
+ SetFilePointer(hFileError, 0, 0, FILE_BEGIN);
+ while (ReadFile(hFileError, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
+ if (dwRead == 0) {
+ break;
+ }
+ if (WriteFile(hStdError, buf, dwRead, &dwWrite, NULL) == FALSE) {
+ break;
+ }
+ }
+ }
+
+ cleanup:
+ if (hFileInput != INVALID_HANDLE_VALUE) {
+ CloseHandle(hFileInput);
+ }
+ if (hFileOutput != INVALID_HANDLE_VALUE) {
+ CloseHandle(hFileOutput);
+ }
+ if (hFileError != INVALID_HANDLE_VALUE) {
+ CloseHandle(hFileError);
+ }
+ CloseHandle(hStdInput);
+ CloseHandle(hStdOutput);
+ CloseHandle(hStdError);
+ ExitProcess(result);
+ return 1;
+}
+
+static HANDLE
+CreateTempFile(void)
+{
+ char name[MAX_PATH];
+ SECURITY_ATTRIBUTES sa;
+
+ if (GetTempPath(sizeof(name), name) == 0) {
+ return INVALID_HANDLE_VALUE;
+ }
+ if (GetTempFileName(name, "tcl", 0, name) == 0) {
+ return INVALID_HANDLE_VALUE;
+ }
+
+ sa.nLength = sizeof(sa);
+ sa.lpSecurityDescriptor = NULL;
+ sa.bInheritHandle = TRUE;
+ return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa,
+ CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE,
+ NULL);
+}
diff --git a/win/tcl.dsp b/win/tcl.dsp
index 96d5893..68920ad 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -1300,14 +1300,6 @@ SOURCE=..\generic\tclStubLib.c
# End Source File
# Begin Source File
-SOURCE=..\generic\tclOOStubLib.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclTomMathStubLib.c
-# End Source File
-# Begin Source File
-
SOURCE=..\generic\tclTest.c
# End Source File
# Begin Source File
@@ -1460,6 +1452,10 @@ SOURCE=.\rules.vc
# End Source File
# Begin Source File
+SOURCE=.\stub16.c
+# End Source File
+# Begin Source File
+
SOURCE=.\tcl.hpj.in
# End Source File
# Begin Source File
@@ -1560,6 +1556,10 @@ SOURCE=.\tclWinThrd.c
# End Source File
# Begin Source File
+SOURCE=.\tclWinThrd.h
+# End Source File
+# Begin Source File
+
SOURCE=.\tclWinTime.c
# End Source File
# End Group
diff --git a/win/tcl.hpj.in b/win/tcl.hpj.in
index a94cea6..8efff0b 100644
--- a/win/tcl.hpj.in
+++ b/win/tcl.hpj.in
@@ -5,9 +5,9 @@ HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
-CNT=tcl86.cnt
+CNT=tcl85.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
-HLP=tcl86.hlp
+HLP=tcl85.hlp
[FILES]
tcl.rtf
diff --git a/win/tcl.m4 b/win/tcl.m4
index db86f6c..2795086 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -247,7 +247,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [
#
# Results:
#
-# Substitutes the following vars:
+# Subst the following vars:
# TCL_BIN_DIR
# TCL_SRC_DIR
# TCL_LIB_FILE
@@ -401,11 +401,11 @@ AC_DEFUN([SC_ENABLE_SHARED], [
AC_DEFUN([SC_ENABLE_THREADS], [
AC_MSG_CHECKING(for building with threads)
- AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: on)],
- [tcl_ok=$enableval], [tcl_ok=yes])
+ AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: off)],
+ [tcl_ok=$enableval], [tcl_ok=no])
if test "$tcl_ok" = "yes"; then
- AC_MSG_RESULT([yes (default)])
+ AC_MSG_RESULT(yes)
TCL_THREADS=1
AC_DEFINE(TCL_THREADS)
# USE_THREAD_ALLOC tells us to try the special thread-based
@@ -413,7 +413,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [
AC_DEFINE(USE_THREAD_ALLOC)
else
TCL_THREADS=0
- AC_MSG_RESULT(no)
+ AC_MSG_RESULT([no (default)])
fi
AC_SUBST(TCL_THREADS)
])
@@ -557,7 +557,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# Set some defaults (may get changed below)
EXTRA_CFLAGS=""
- AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])
AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)
@@ -572,7 +571,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AC_CACHE_CHECK(for cross-compile version of gcc,
ac_cv_cross,
AC_TRY_COMPILE([
- #ifndef _WIN32
+ #ifndef __WIN32__
#error cross-compiler
#endif
], [],
@@ -639,7 +638,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AC_CACHE_CHECK(for mingw32 version of gcc,
ac_cv_win32,
AC_TRY_COMPILE([
- #ifdef _WIN32
+ #ifdef __WIN32__
#error win32
#endif
], [],
@@ -649,31 +648,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
if test "$ac_cv_win32" != "yes"; then
AC_MSG_ERROR([${CC} cannot produce win32 executables.])
fi
-
- hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
- AC_CACHE_CHECK(for working -municode linker flag,
- ac_cv_municode,
- AC_TRY_LINK([
- #include <windows.h>
- int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
- ],
- [],
- ac_cv_municode=yes,
- ac_cv_municode=no)
- )
- CFLAGS=$hold_cflags
- if test "$ac_cv_municode" = "yes" ; then
- extra_ldflags="$extra_ldflags -municode"
- else
- extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
- fi
fi
AC_MSG_CHECKING([compiler flags])
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
- SHLIB_LD_LIBS='${LIBS}'
- LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
+ SHLIB_LD_LIBS=""
+ LIBS="-lws2_32"
# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
STLIB_LD='${AR} cr'
@@ -692,6 +673,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# static
AC_MSG_RESULT([using static flags])
runtime=
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.a"
+ LIBFLAGSUFFIX="s\${DBGX}"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
else
@@ -705,29 +689,29 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
runtime=
+ # Link with gcc since ld does not link to default libs like
+ # -luser32 and -lmsvcrt by default.
+ SHLIB_LD='${CC} -shared'
+ SHLIB_LD_LIBS='${LIBS}'
# Add SHLIB_LD_LIBS to the Make rule, not here.
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \
+ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)"
+ LIBSUFFIX="\${DBGX}.a"
+ LIBFLAGSUFFIX="\${DBGX}"
EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
fi
- # Link with gcc since ld does not link to default libs like
- # -luser32 and -lmsvcrt by default.
- SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \
- -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.a"
- LIBFLAGSUFFIX="\${DBGX}"
SHLIB_SUFFIX=.dll
EXTRA_CFLAGS="${extra_cflags}"
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
+ CFLAGS_WARNING="-Wall"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
@@ -782,15 +766,23 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# static
AC_MSG_RESULT([using static flags])
runtime=-MT
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.lib"
+ LIBFLAGSUFFIX="s\${DBGX}"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
+ SHLIB_LD_LIBS=""
else
# dynamic
AC_MSG_RESULT([using shared flags])
runtime=-MD
# Add SHLIB_LD_LIBS to the Make rule, not here.
- LIBRARIES="\${SHARED_LIBRARIES}"
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
+ LIBSUFFIX="\${DBGX}.lib"
+ LIBFLAGSUFFIX="\${DBGX}"
EXESUFFIX="\${DBGX}.exe"
+ LIBRARIES="\${SHARED_LIBRARIES}"
+ SHLIB_LD_LIBS='${LIBS}'
case "x`echo \${VisualStudioVersion}`" in
x1[[4-9]]*)
lflags="${lflags} -nodefaultlib:libucrt.lib"
@@ -799,12 +791,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
;;
esac
fi
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
# DLLSUFFIX is separate because it is the building block for
# users of tclConfig.sh that may build shared or static.
DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.lib"
- LIBFLAGSUFFIX="\${DBGX}"
# This is a 2-stage check to make sure we have the 64-bit SDK
# We have to know where the SDK is installed.
@@ -834,7 +823,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
fi
- LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
+ LIBS="user32.lib advapi32.lib ws2_32.lib"
case "x`echo \${VisualStudioVersion}`" in
x1[[4-9]]*)
@@ -968,7 +957,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
- SHLIB_LD_LIBS='${LIBS}'
# link -lib only works when -lib is the first arg
STLIB_LD="${LINKBIN} -lib ${lflags}"
RC_OUT=-fo
@@ -1129,13 +1117,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
#------------------------------------------------------------------------
AC_DEFUN([SC_WITH_TCL], [
- if test -d ../../tcl8.6$1/win; then
- TCL_BIN_DEFAULT=../../tcl8.6$1/win
+ if test -d ../../tcl8.5$1/win; then
+ TCL_BIN_DEFAULT=../../tcl8.5$1/win
else
- TCL_BIN_DEFAULT=../../tcl8.6/win
+ TCL_BIN_DEFAULT=../../tcl8.5/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 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 e06eaf5..251a610 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -2,67 +2,31 @@
* tclAppInit.c --
*
* Provides a default version of the main program and Tcl_AppInit
- * procedure for tclsh and other Tcl-based applications (without Tk).
- * Note that this program must be built in Win32 console mode to work
- * properly.
+ * function for Tcl applications (without Tk). Note that this program
+ * must be built in Win32 console mode to work properly.
*
- * Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 Scriptics Corporation.
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tcl.h"
-#define WIN32_LEAN_AND_MEAN
-#define STRICT /* See MSDN Article Q83456 */
#include <windows.h>
-#undef STRICT
-#undef WIN32_LEAN_AND_MEAN
#include <locale.h>
-#include <stdlib.h>
-#include <tchar.h>
#ifdef TCL_TEST
-extern Tcl_PackageInitProc Tcltest_Init;
-extern Tcl_PackageInitProc Tcltest_SafeInit;
+extern Tcl_PackageInitProc Procbodytest_Init;
+extern Tcl_PackageInitProc Procbodytest_SafeInit;
+extern Tcl_PackageInitProc Tcltest_Init;
+extern Tcl_PackageInitProc TclObjTest_Init;
#endif /* TCL_TEST */
-#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
-extern Tcl_PackageInitProc Registry_Init;
-extern Tcl_PackageInitProc Dde_Init;
-extern Tcl_PackageInitProc Dde_SafeInit;
-#endif
-
-#ifdef TCL_BROKEN_MAINARGS
+#if defined(__GNUC__)
int _CRT_glob = 0;
-static void setargv(int *argcPtr, TCHAR ***argvPtr);
-#endif /* TCL_BROKEN_MAINARGS */
-
-/*
- * The following #if block allows you to change the AppInit function by using
- * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
- * #if checks for that #define and uses Tcl_AppInit if it does not exist.
- */
-
-#ifndef TCL_LOCAL_APPINIT
-#define TCL_LOCAL_APPINIT Tcl_AppInit
-#endif
-#ifndef MODULE_SCOPE
-# define MODULE_SCOPE extern
-#endif
-MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
-
-/*
- * The following #if block allows you to change how Tcl finds the startup
- * script, prime the library or encoding paths, fiddle with the argv, etc.,
- * without needing to rewrite Tcl_Main()
- */
-
-#ifdef TCL_LOCAL_MAIN_HOOK
-MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
-#endif
+static void setargv(int *argcPtr, char ***argvPtr);
+#endif /* __GNUC__ */
/*
*----------------------------------------------------------------------
@@ -72,45 +36,53 @@ MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
* This is the main program for the application.
*
* Results:
- * None: Tcl_Main never returns here, so this procedure never returns
+ * None: Tcl_Main never returns here, so this function never returns
* either.
*
* Side effects:
- * Just about anything, since from here we call arbitrary Tcl code.
+ * Whatever the application does.
*
*----------------------------------------------------------------------
*/
-#ifdef TCL_BROKEN_MAINARGS
int
main(
- int argc, /* Number of command-line arguments. */
- char *dummy[]) /* Not used. */
-{
- TCHAR **argv;
-#else
-int
-_tmain(
- int argc, /* Number of command-line arguments. */
- TCHAR *argv[]) /* Values of command-line arguments. */
+ int argc,
+ char *argv[])
{
+ /*
+ * The following #if block allows you to change the AppInit function by
+ * using a #define of TCL_LOCAL_APPINIT instead of rewriting this entire
+ * file. The #if checks for that #define and uses Tcl_AppInit if it
+ * doesn't exist.
+ */
+
+#ifndef TCL_LOCAL_APPINIT
+#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif
- TCHAR *p;
+ extern int TCL_LOCAL_APPINIT (Tcl_Interp *interp);
/*
- * Set up the default locale to be standard "C" locale so parsing is
- * performed correctly.
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv,
+ * etc., without needing to rewrite Tcl_Main()
*/
- setlocale(LC_ALL, "C");
+#ifdef TCL_LOCAL_MAIN_HOOK
+ extern int TCL_LOCAL_MAIN_HOOK (int *argc, char ***argv);
+#endif
+
+ char *p;
-#ifdef TCL_BROKEN_MAINARGS
/*
- * Get our args from the c-runtime. Ignore command line.
+ * Set up the default locale to be standard "C" locale so parsing is
+ * performed correctly.
*/
- setargv(&argc, &argv);
+#if defined(__GNUC__)
+ setargv( &argc, &argv );
#endif
+ setlocale(LC_ALL, "C");
/*
* Forward slashes substituted for backslashes.
@@ -127,6 +99,7 @@ _tmain(
#endif
Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
+
return 0; /* Needed only to prevent compiler warning. */
}
@@ -135,9 +108,9 @@ _tmain(
*
* Tcl_AppInit --
*
- * This procedure performs application-specific initialization. Most
+ * This function performs application-specific initialization. Most
* applications, especially those that incorporate additional packages,
- * will have their own version of this procedure.
+ * will have their own version of this function.
*
* Results:
* Returns a standard Tcl completion code, and leaves an error message in
@@ -153,44 +126,57 @@ int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
- if ((Tcl_Init)(interp) == TCL_ERROR) {
+ if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
-#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
- if (Registry_Init(interp) == TCL_ERROR) {
+#ifdef TCL_TEST
+ if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
-
- if (Dde_Init(interp) == TCL_ERROR) {
+ Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL);
+ if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
-#endif
-
-#ifdef TCL_TEST
- if (Tcltest_Init(interp) == TCL_ERROR) {
+ if (Procbodytest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
+ Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
+ Procbodytest_SafeInit);
#endif /* TCL_TEST */
+#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
+ {
+ extern Tcl_PackageInitProc Registry_Init;
+ extern Tcl_PackageInitProc Dde_Init;
+ extern Tcl_PackageInitProc Dde_SafeInit;
+
+ if (Registry_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
+
+ if (Dde_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
+ }
+#endif
+
/*
- * Call the init procedures for included packages. Each call should look
+ * Call the init functions for included packages. Each call should look
* like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
- * where "Mod" is the name of the module. (Dynamically-loadable packages
- * should have the same entry-point name.)
+ * where "Mod" is the name of the module.
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if they
- * weren't already created by the init procedures called above.
+ * weren't already created by the init functions called above.
*/
/*
@@ -200,8 +186,7 @@ Tcl_AppInit(
* user-specific startup file will be run under any conditions.
*/
- (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
- Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
return TCL_OK;
}
@@ -232,17 +217,17 @@ Tcl_AppInit(
*--------------------------------------------------------------------------
*/
-#ifdef TCL_BROKEN_MAINARGS
+#if defined(__GNUC__)
static void
setargv(
int *argcPtr, /* Filled with number of argument strings. */
- TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */
+ char ***argvPtr) /* Filled with argument strings (malloc'd). */
{
- TCHAR *cmdLine, *p, *arg, *argSpace;
- TCHAR **argv;
+ char *cmdLine, *p, *arg, *argSpace;
+ char **argv;
int argc, size, inquote, copy, slashes;
- cmdLine = GetCommandLine();
+ cmdLine = GetCommandLine(); /* INTL: BUG */
/*
* Precompute an overly pessimistic guess at the number of arguments in
@@ -261,15 +246,10 @@ setargv(
}
}
}
-
- /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
- #undef Tcl_Alloc
- #undef Tcl_DbCkalloc
-
- argSpace = ckalloc(size * sizeof(char *)
- + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
- argv = (TCHAR **) argSpace;
- argSpace += size * (sizeof(char *)/sizeof(TCHAR));
+ argSpace = (char *) ckalloc(
+ (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
+ argv = (char **) argSpace;
+ argSpace += size * sizeof(char *);
size--;
p = cmdLine;
@@ -327,7 +307,7 @@ setargv(
*argcPtr = argc;
*argvPtr = argv;
}
-#endif /* TCL_BROKEN_MAINARGS */
+#endif /* __GNUC__ */
/*
* Local Variables:
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 688fa8d..e5e5202 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -12,9 +12,30 @@
*/
#include "tclWinInt.h"
-#if defined(HAVE_INTRIN_H)
-# include <intrin.h>
-#endif
+
+#ifndef TCL_NO_STACK_CHECK
+/*
+ * The following functions implement stack depth checking
+ */
+typedef struct ThreadSpecificData {
+ int *stackBound; /* The current stack boundary */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+#endif /* TCL_NO_STACK_CHECK */
+
+/*
+ * The following data structures are used when loading the thunking library
+ * for execing child processes under Win32s.
+ */
+
+typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
+ LPVOID *lpTranslationList);
+
+typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
+ LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,
+ FARPROC UT32Callback, LPVOID Buff);
+
+typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);
/*
* The following variables keep track of information about this DLL on a
@@ -33,14 +54,150 @@ static int platformId; /* Running under NT, or 95/98? */
#define cpuid __asm __emit 0fh __asm __emit 0a2h
#endif
-static Tcl_Encoding winTCharEncoding = NULL;
+/*
+ * The following function tables are used to dispatch to either the
+ * wide-character or multi-byte versions of the operating system calls,
+ * depending on whether the Unicode calls are available.
+ */
+
+static TclWinProcs asciiProcs = {
+ 0,
+
+ (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA,
+ (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA,
+ (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA,
+ (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
+ DWORD, DWORD, HANDLE)) CreateFileA,
+ (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
+ LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
+ LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,
+ (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA,
+ (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA,
+ (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA,
+ (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,
+ (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,
+ (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
+ TCHAR **)) GetFullPathNameA,
+ (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA,
+ (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,
+ (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
+ WCHAR *)) GetTempFileNameA,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA,
+ (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
+ WCHAR *, DWORD)) GetVolumeInformationA,
+ (HINSTANCE (WINAPI *)(CONST TCHAR *, HANDLE, DWORD)) LoadLibraryExA,
+ (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA,
+ (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA,
+ (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
+ WCHAR *, TCHAR **)) SearchPathA,
+ (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
+ (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
+ /*
+ * The three NULL function pointers will only be set when
+ * Tcl_FindExecutable is called. If you don't ever call that function, the
+ * application will crash whenever WinTcl tries to call functions through
+ * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is
+ * mandatory in recent Tcl releases.
+ */
+
+ NULL,
+ NULL,
+ /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, */
+ NULL,
+ NULL,
+ /* getLongPathNameProc */
+ NULL,
+ /* Security SDK - not available on 95,98,ME */
+ NULL, NULL, NULL, NULL, NULL, NULL,
+ /* ReadConsole and WriteConsole */
+ (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleA,
+ (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA,
+ (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameA
+};
+
+static TclWinProcs unicodeProcs = {
+ 1,
+
+ (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW,
+ (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW,
+ (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW,
+ (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
+ DWORD, DWORD, HANDLE)) CreateFileW,
+ (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
+ LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
+ LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,
+ (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW,
+ (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW,
+ (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW,
+ (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,
+ (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,
+ (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
+ TCHAR **)) GetFullPathNameW,
+ (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW,
+ (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,
+ (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
+ WCHAR *)) GetTempFileNameW,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,
+ (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
+ WCHAR *, DWORD)) GetVolumeInformationW,
+ (HINSTANCE (WINAPI *)(CONST TCHAR *, HANDLE, DWORD)) LoadLibraryExW,
+ (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW,
+ (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW,
+ (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
+ WCHAR *, TCHAR **)) SearchPathW,
+ (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
+ (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,
+
+ /*
+ * The three NULL function pointers will only be set when
+ * Tcl_FindExecutable is called. If you don't ever call that function, the
+ * application will crash whenever WinTcl tries to call functions through
+ * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is
+ * mandatory in recent Tcl releases.
+ */
+
+ NULL,
+ NULL,
+ /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, */
+ NULL,
+ NULL,
+ /* getLongPathNameProc */
+ NULL,
+ /* Security SDK - will be filled in on NT,XP,2000,2003 */
+ NULL, NULL, NULL, NULL, NULL, NULL,
+ /* ReadConsole and WriteConsole */
+ (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleW,
+ (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleW,
+ (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameW
+};
+
+TclWinProcs *tclWinProcs;
+static Tcl_Encoding tclWinTCharEncoding;
+
+#ifdef HAVE_NO_SEH
+/*
+ * Need to add noinline flag to DllMain declaration so that gcc -O3 does not
+ * inline asm code into DllEntryPoint and cause a compile time error because
+ * of redefined local labels.
+ */
+
+BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
+ LPVOID reserved) __attribute__ ((noinline));
+#else
/*
* The following declaration is for the VC++ DLL entry point.
*/
BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
LPVOID reserved);
+#endif /* HAVE_NO_SEH */
/*
* The following structure and linked list is to allow us to map between
@@ -49,8 +206,8 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
*/
typedef struct MountPointMap {
- const TCHAR *volumeName; /* Native wide string volume name. */
- TCHAR driveLetter; /* Drive letter corresponding to the volume
+ CONST WCHAR *volumeName; /* Native wide string volume name. */
+ char driveLetter; /* Drive letter corresponding to the volume
* name. */
struct MountPointMap *nextPtr;
/* Pointer to next structure in list, or
@@ -69,7 +226,9 @@ TCL_DECLARE_MUTEX(mountPointMap)
* We will need this below.
*/
-#ifdef _WIN32
+extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
+
+#ifdef __WIN32__
#ifndef STATIC_BUILD
/*
@@ -111,7 +270,10 @@ DllEntryPoint(
* TRUE on sucess, FALSE on failure.
*
* Side effects:
- * Initializes most rudimentary Windows bits.
+ * Establishes 32-to-16 bit thunk and initializes sockets library. This
+ * might call some sycronization functions, but MSDN documentation
+ * states: "Waiting on synchronization objects in DllMain can cause a
+ * deadlock."
*
*----------------------------------------------------------------------
*/
@@ -122,22 +284,111 @@ DllMain(
DWORD reason, /* Reason this function is being called. */
LPVOID reserved) /* Not used. */
{
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
+ TCLEXCEPTION_REGISTRATION registration;
+#endif
+
switch (reason) {
case DLL_PROCESS_ATTACH:
DisableThreadLibraryCalls(hInst);
TclWinInit(hInst);
return TRUE;
+ case DLL_PROCESS_DETACH:
/*
- * DLL_PROCESS_DETACH is unnecessary as the user should call
- * Tcl_Finalize explicitly before unloading Tcl.
+ * Protect the call to Tcl_Finalize. The OS could be unloading us from
+ * an exception handler and the state of the stack might be unstable.
*/
+
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
+ __asm__ __volatile__ (
+
+ /*
+ * Construct an TCLEXCEPTION_REGISTRATION to protect the call to
+ * Tcl_Finalize
+ */
+
+ "leal %[registration], %%edx" "\n\t"
+ "movl %%fs:0, %%eax" "\n\t"
+ "movl %%eax, 0x0(%%edx)" "\n\t" /* link */
+ "leal 1f, %%eax" "\n\t"
+ "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */
+ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */
+ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */
+ "movl %[error], 0x10(%%edx)" "\n\t" /* status */
+
+ /*
+ * Link the TCLEXCEPTION_REGISTRATION on the chain
+ */
+
+ "movl %%edx, %%fs:0" "\n\t"
+
+ /*
+ * Call Tcl_Finalize
+ */
+
+ "call _Tcl_Finalize" "\n\t"
+
+ /*
+ * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION
+ * and store a TCL_OK status
+ */
+
+ "movl %%fs:0, %%edx" "\n\t"
+ "movl %[ok], %%eax" "\n\t"
+ "movl %%eax, 0x10(%%edx)" "\n\t"
+ "jmp 2f" "\n"
+
+ /*
+ * Come here on an exception. Get the TCLEXCEPTION_REGISTRATION that
+ * we previously put on the chain.
+ */
+
+ "1:" "\t"
+ "movl %%fs:0, %%edx" "\n\t"
+ "movl 0x8(%%edx), %%edx" "\n"
+
+
+ /*
+ * Come here however we exited. Restore context from the
+ * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
+ */
+
+ "2:" "\t"
+ "movl 0xc(%%edx), %%esp" "\n\t"
+ "movl 0x8(%%edx), %%ebp" "\n\t"
+ "movl 0x0(%%edx), %%eax" "\n\t"
+ "movl %%eax, %%fs:0" "\n\t"
+
+ :
+ /* No outputs */
+ :
+ [registration] "m" (registration),
+ [ok] "i" (TCL_OK),
+ [error] "i" (TCL_ERROR)
+ :
+ "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
+ );
+
+#else
+#ifndef HAVE_NO_SEH
+ __try {
+#endif
+ Tcl_Finalize();
+#ifndef HAVE_NO_SEH
+ } __except (EXCEPTION_EXECUTE_HANDLER) {
+ /* empty handler body. */
+ }
+#endif
+#endif
+
+ break;
}
return TRUE;
}
#endif /* !STATIC_BUILD */
-#endif /* _WIN32 */
+#endif /* __WIN32__ */
/*
*----------------------------------------------------------------------
@@ -189,18 +440,15 @@ TclWinInit(
platformId = os.dwPlatformId;
/*
- * We no longer support Win32s or Win9x, so just in case someone manages
- * to get a runtime there, make sure they know that.
+ * We no longer support Win32s, so just in case someone manages to get a
+ * runtime there, make sure they know that.
*/
if (platformId == VER_PLATFORM_WIN32s) {
Tcl_Panic("Win32s is not a supported platform");
}
- if (platformId == VER_PLATFORM_WIN32_WINDOWS) {
- Tcl_Panic("Windows 9x is not a supported platform");
- }
- TclWinResetInterfaces();
+ tclWinProcs = &asciiProcs;
}
/*
@@ -213,10 +461,9 @@ TclWinInit(
*
* Results:
* The return value is one of:
- * VER_PLATFORM_WIN32s Win32s on Windows 3.1 (not supported)
- * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME (not supported)
- * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP
- * VER_PLATFORM_WIN32_CE Win32 on Windows CE
+ * VER_PLATFORM_WIN32s Win32s on Windows 3.1. (not supported)
+ * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME.
+ * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP
*
* Side effects:
* None.
@@ -262,11 +509,95 @@ TclWinNoBackslash(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetStackParams --
+ *
+ * Determine the stack params for the current thread: in which
+ * direction does the stack grow, and what is the stack lower (resp.
+ * upper) bound for safe invocation of a new command? This is used to
+ * cache the values needed for an efficient computation of
+ * TclpCheckStackSpace() when the interp is known.
+ *
+ * Results:
+ * Returns 1 if the stack grows down, in which case a stack lower bound
+ * is stored at stackBoundPtr. If the stack grows up, 0 is returned and
+ * an upper bound is stored at stackBoundPtr. If a bound cannot be
+ * determined NULL is stored at stackBoundPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef TCL_NO_STACK_CHECK
+int
+TclpGetCStackParams(
+ int **stackBoundPtr)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ SYSTEM_INFO si; /* The system information, used to
+ * determine the page size */
+ MEMORY_BASIC_INFORMATION mbi;
+ /* The information about the memory
+ * area in which the stack resides */
+
+ if (!tsdPtr->stackBound
+ || ((UINT_PTR)&tsdPtr < (UINT_PTR)tsdPtr->stackBound)) {
+
+ /*
+ * Either we haven't determined the stack bound in this thread,
+ * or else we've overflowed the bound that we previously
+ * determined. We need to find a new stack bound from
+ * Windows.
+ */
+
+ GetSystemInfo(&si);
+ if (VirtualQuery((LPCVOID) &tsdPtr, &mbi, sizeof(mbi)) == 0) {
+
+ /* For some reason, the system didn't let us query the
+ * stack size. Nevertheless, we got here and haven't
+ * blown up yet. Don't update the calculated stack bound.
+ * If there is no calculated stack bound yet, set it to
+ * the base of the current page of stack. */
+
+ if (!tsdPtr->stackBound) {
+ tsdPtr->stackBound =
+ (int*) ((UINT_PTR)(&tsdPtr)
+ & ~ (UINT_PTR)(si.dwPageSize - 1));
+ }
+
+ } else {
+
+ /* The allocation base of the stack segment has to be advanced
+ * by one page (to allow for the guard page maintained in the
+ * C runtime) and then by TCL_WIN_STACK_THRESHOLD (to allow
+ * for the amount of stack that Tcl needs).
+ */
+
+ tsdPtr->stackBound =
+ (int*) ((UINT_PTR)(mbi.AllocationBase)
+ + (UINT_PTR)(si.dwPageSize)
+ + TCL_WIN_STACK_THRESHOLD);
+ }
+ }
+ *stackBoundPtr = tsdPtr->stackBound;
+ return 1;
+}
+#endif
+
+
+/*
*---------------------------------------------------------------------------
*
- * TclpSetInterfaces --
+ * TclWinSetInterfaces --
+ *
+ * A helper proc that allows the test library to change the tclWinProcs
+ * structure to dispatch to either the wide-character or multi-byte
+ * versions of the operating system calls, depending on whether Unicode
+ * is the system encoding.
*
- * A helper proc that initializes winTCharEncoding.
+ * As well as this, we can also try to load in some additional procs
+ * which may/may not be present depending on the current Windows version
+ * (e.g. Win95 will not have the procs below).
*
* Results:
* None.
@@ -278,18 +609,115 @@ TclWinNoBackslash(
*/
void
-TclpSetInterfaces(void)
+TclWinSetInterfaces(
+ int wide) /* Non-zero to use wide interfaces, 0
+ * otherwise. */
{
- TclWinResetInterfaces();
- winTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
+ Tcl_FreeEncoding(tclWinTCharEncoding);
+
+ if (wide) {
+ tclWinProcs = &unicodeProcs;
+ tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
+ if (tclWinProcs->getFileAttributesExProc == NULL) {
+ HINSTANCE hInstance = LoadLibraryA("kernel32");
+ if (hInstance != NULL) {
+ tclWinProcs->getFileAttributesExProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
+ LPVOID)) GetProcAddress(hInstance,
+ "GetFileAttributesExW");
+ tclWinProcs->createHardLinkProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
+ LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
+ "CreateHardLinkW");
+ tclWinProcs->findFirstFileExProc =
+ (HANDLE (WINAPI *)(CONST TCHAR*, UINT, LPVOID, UINT,
+ LPVOID, DWORD)) GetProcAddress(hInstance,
+ "FindFirstFileExW");
+ tclWinProcs->getVolumeNameForVMPProc =
+ (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*,
+ DWORD)) GetProcAddress(hInstance,
+ "GetVolumeNameForVolumeMountPointW");
+ tclWinProcs->getLongPathNameProc =
+ (DWORD (WINAPI *)(CONST TCHAR*, TCHAR*,
+ DWORD)) GetProcAddress(hInstance, "GetLongPathNameW");
+ FreeLibrary(hInstance);
+ }
+ hInstance = LoadLibraryA("advapi32");
+ if (hInstance != NULL) {
+ tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)(
+ LPCTSTR lpFileName,
+ SECURITY_INFORMATION RequestedInformation,
+ PSECURITY_DESCRIPTOR pSecurityDescriptor,
+ DWORD nLength, LPDWORD lpnLengthNeeded))
+ GetProcAddress(hInstance, "GetFileSecurityW");
+ tclWinProcs->impersonateSelfProc = (BOOL (WINAPI *) (
+ SECURITY_IMPERSONATION_LEVEL ImpersonationLevel))
+ GetProcAddress(hInstance, "ImpersonateSelf");
+ tclWinProcs->openThreadTokenProc = (BOOL (WINAPI *) (
+ HANDLE ThreadHandle, DWORD DesiredAccess,
+ BOOL OpenAsSelf, PHANDLE TokenHandle))
+ GetProcAddress(hInstance, "OpenThreadToken");
+ tclWinProcs->revertToSelfProc = (BOOL (WINAPI *) (void))
+ GetProcAddress(hInstance, "RevertToSelf");
+ tclWinProcs->mapGenericMaskProc = (VOID (WINAPI *) (
+ PDWORD AccessMask, PGENERIC_MAPPING GenericMapping))
+ GetProcAddress(hInstance, "MapGenericMask");
+ tclWinProcs->accessCheckProc = (BOOL (WINAPI *)(
+ PSECURITY_DESCRIPTOR pSecurityDescriptor,
+ HANDLE ClientToken, DWORD DesiredAccess,
+ PGENERIC_MAPPING GenericMapping,
+ PPRIVILEGE_SET PrivilegeSet,
+ LPDWORD PrivilegeSetLength, LPDWORD GrantedAccess,
+ LPBOOL AccessStatus)) GetProcAddress(hInstance,
+ "AccessCheck");
+ FreeLibrary(hInstance);
+ }
+ }
+ } else {
+ tclWinProcs = &asciiProcs;
+ tclWinTCharEncoding = NULL;
+ if (tclWinProcs->getFileAttributesExProc == NULL) {
+ HINSTANCE hInstance = LoadLibraryA("kernel32");
+ if (hInstance != NULL) {
+ tclWinProcs->getFileAttributesExProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
+ LPVOID)) GetProcAddress(hInstance,
+ "GetFileAttributesExA");
+ tclWinProcs->createHardLinkProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
+ LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
+ "CreateHardLinkA");
+ tclWinProcs->findFirstFileExProc = NULL;
+ tclWinProcs->getLongPathNameProc = NULL;
+ /*
+ * The 'findFirstFileExProc' function exists on some of
+ * 95/98/ME, but it seems not to work as anticipated.
+ * Therefore we don't set this function pointer. The relevant
+ * code will fall back on a slower approach using the normal
+ * findFirstFileProc.
+ *
+ * (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
+ * LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance,
+ * "FindFirstFileExA");
+ */
+ tclWinProcs->getVolumeNameForVMPProc =
+ (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*,
+ DWORD)) GetProcAddress(hInstance,
+ "GetVolumeNameForVolumeMountPointA");
+ FreeLibrary(hInstance);
+ }
+ }
+ }
}
/*
*---------------------------------------------------------------------------
*
- * TclWinEncodingsCleanup --
+ * TclWinResetInterfaceEncodings --
*
- * Called during finalization to free up any encodings we use.
+ * Called during finalization to free up any encodings we use. The
+ * tclWinProcs-> look up table is still ok to use after this call,
+ * provided no encoding conversion is required.
*
* We also clean up any memory allocated in our mount point map which is
* used to follow certain kinds of symlinks. That code should never be
@@ -305,11 +733,13 @@ TclpSetInterfaces(void)
*/
void
-TclWinEncodingsCleanup(void)
+TclWinResetInterfaceEncodings(void)
{
MountPointMap *dlIter, *dlIter2;
-
- TclWinResetInterfaces();
+ if (tclWinTCharEncoding != NULL) {
+ Tcl_FreeEncoding(tclWinTCharEncoding);
+ tclWinTCharEncoding = NULL;
+ }
/*
* Clean up the mount point map.
@@ -319,8 +749,8 @@ TclWinEncodingsCleanup(void)
dlIter = driveLetterLookup;
while (dlIter != NULL) {
dlIter2 = dlIter->nextPtr;
- ckfree(dlIter->volumeName);
- ckfree(dlIter);
+ ckfree((char*)dlIter->volumeName);
+ ckfree((char*)dlIter);
dlIter = dlIter2;
}
Tcl_MutexUnlock(&mountPointMap);
@@ -332,6 +762,8 @@ TclWinEncodingsCleanup(void)
* TclWinResetInterfaces --
*
* Called during finalization to reset us to a safe state for reuse.
+ * After this call, it is best not to use the tclWinProcs-> look up table
+ * since it is likely to be different to what is expected.
*
* Results:
* None.
@@ -344,10 +776,7 @@ TclWinEncodingsCleanup(void)
void
TclWinResetInterfaces(void)
{
- if (winTCharEncoding != NULL) {
- Tcl_FreeEncoding(winTCharEncoding);
- winTCharEncoding = NULL;
- }
+ tclWinProcs = &asciiProcs;
}
/*
@@ -374,11 +803,11 @@ TclWinResetInterfaces(void)
char
TclWinDriveLetterForVolMountPoint(
- const TCHAR *mountPoint)
+ CONST WCHAR *mountPoint)
{
MountPointMap *dlIter, *dlPtr2;
- TCHAR Target[55]; /* Target of mount at mount point */
- TCHAR drive[4] = TEXT("A:\\");
+ WCHAR Target[55]; /* Target of mount at mount point */
+ WCHAR drive[4] = { L'A', L':', L'\\', L'\0' };
/*
* Detect the volume mounted there. Unfortunately, there is no simple way
@@ -389,28 +818,28 @@ TclWinDriveLetterForVolMountPoint(
Tcl_MutexLock(&mountPointMap);
dlIter = driveLetterLookup;
while (dlIter != NULL) {
- if (_tcscmp(dlIter->volumeName, mountPoint) == 0) {
+ if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
/*
* We need to check whether this information is still valid, since
* either the user or various programs could have adjusted the
* mount points on the fly.
*/
- drive[0] = (TCHAR) dlIter->driveLetter;
+ drive[0] = L'A' + (dlIter->driveLetter - 'A');
/*
* Try to read the volume mount point and see where it points.
*/
- if (GetVolumeNameForVolumeMountPoint(drive,
- Target, 55) != 0) {
- if (_tcscmp(dlIter->volumeName, Target) == 0) {
+ if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
+ (TCHAR*)Target, 55) != 0) {
+ if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
/*
* Nothing has changed.
*/
Tcl_MutexUnlock(&mountPointMap);
- return (char) dlIter->driveLetter;
+ return dlIter->driveLetter;
}
}
@@ -437,8 +866,8 @@ TclWinDriveLetterForVolMountPoint(
* Now dlPtr2 points to the structure to free.
*/
- ckfree(dlPtr2->volumeName);
- ckfree(dlPtr2);
+ ckfree((char*)dlPtr2->volumeName);
+ ckfree((char*)dlPtr2);
/*
* Restart the loop - we could try to be clever and continue half
@@ -461,23 +890,23 @@ TclWinDriveLetterForVolMountPoint(
* Try to read the volume mount point and see where it points.
*/
- if (GetVolumeNameForVolumeMountPoint(drive,
- Target, 55) != 0) {
+ if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
+ (TCHAR*)Target, 55) != 0) {
int alreadyStored = 0;
for (dlIter = driveLetterLookup; dlIter != NULL;
dlIter = dlIter->nextPtr) {
- if (_tcscmp(dlIter->volumeName, Target) == 0) {
+ if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
alreadyStored = 1;
break;
}
}
if (!alreadyStored) {
- dlPtr2 = ckalloc(sizeof(MountPointMap));
+ dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap));
dlPtr2->volumeName = TclNativeDupInternalRep(Target);
- dlPtr2->driveLetter = (char) drive[0];
+ dlPtr2->driveLetter = 'A' + (drive[0] - L'A');
dlPtr2->nextPtr = driveLetterLookup;
- driveLetterLookup = dlPtr2;
+ driveLetterLookup = dlPtr2;
}
}
}
@@ -488,9 +917,9 @@ TclWinDriveLetterForVolMountPoint(
for (dlIter = driveLetterLookup; dlIter != NULL;
dlIter = dlIter->nextPtr) {
- if (_tcscmp(dlIter->volumeName, mountPoint) == 0) {
+ if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
Tcl_MutexUnlock(&mountPointMap);
- return (char) dlIter->driveLetter;
+ return dlIter->driveLetter;
}
}
@@ -499,11 +928,11 @@ TclWinDriveLetterForVolMountPoint(
* that fact and store '-1' so we don't have to look it up each time.
*/
- dlPtr2 = ckalloc(sizeof(MountPointMap));
- dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint);
+ dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
+ dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint);
dlPtr2->driveLetter = -1;
dlPtr2->nextPtr = driveLetterLookup;
- driveLetterLookup = dlPtr2;
+ driveLetterLookup = dlPtr2;
Tcl_MutexUnlock(&mountPointMap);
return -1;
}
@@ -560,27 +989,27 @@ TclWinDriveLetterForVolMountPoint(
TCHAR *
Tcl_WinUtfToTChar(
- const char *string, /* Source string in UTF-8. */
+ CONST char *string, /* Source string in UTF-8. */
int len, /* Source string length in bytes, or < 0 for
* strlen(). */
Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
* converted string is stored. */
{
- return (TCHAR *) Tcl_UtfToExternalDString(winTCharEncoding,
+ return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
string, len, dsPtr);
}
char *
Tcl_WinTCharToUtf(
- const TCHAR *string, /* Source string in Unicode when running NT,
+ CONST TCHAR *string, /* Source string in Unicode when running NT,
* ANSI when running 95. */
int len, /* Source string length in bytes, or < 0 for
* platform-specific string length. */
Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
* converted string is stored. */
{
- return Tcl_ExternalToUtfDString(winTCharEncoding,
- (const char *) string, len, dsPtr);
+ return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
+ (CONST char *) string, len, dsPtr);
}
/*
@@ -608,16 +1037,11 @@ TclWinCPUID(
{
int status = TCL_ERROR;
-#if defined(HAVE_INTRIN_H) && defined(_WIN64)
-
- __cpuid(regsPtr, index);
- status = TCL_OK;
-
-#elif defined(__GNUC__)
+#if defined(__GNUC__)
# if defined(_WIN64)
/*
* Execute the CPUID instruction with the given index, and store results
- * off 'regPtr'.
+ * off 'regsPtr'.
*/
__asm__ __volatile__(
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index cca0dab..a271919 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -83,7 +83,7 @@ static ThreadSpecificData *FileInit(void);
static int FileInputProc(ClientData instanceData, char *buf,
int toRead, int *errorCode);
static int FileOutputProc(ClientData instanceData,
- const char *buf, int toWrite, int *errorCode);
+ CONST char *buf, int toWrite, int *errorCode);
static int FileSeekProc(ClientData instanceData, long offset,
int mode, int *errorCode);
static Tcl_WideInt FileWideSeekProc(ClientData instanceData,
@@ -100,7 +100,7 @@ static int NativeIsComPort(CONST TCHAR *nativeName);
* This structure describes the channel type structure for file based IO.
*/
-static const Tcl_ChannelType fileChannelType = {
+static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
FileCloseProc, /* Close proc. */
@@ -117,7 +117,7 @@ static const Tcl_ChannelType fileChannelType = {
NULL, /* handler proc. */
FileWideSeekProc, /* Wide seek proc. */
FileThreadActionProc, /* Thread action proc. */
- FileTruncateProc /* Truncate proc. */
+ FileTruncateProc, /* Truncate proc. */
};
/*
@@ -257,7 +257,7 @@ FileCheckProc(
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
infoPtr->flags |= FILE_PENDING;
- evPtr = ckalloc(sizeof(FileEvent));
+ evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
evPtr->header.proc = FileEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -340,7 +340,7 @@ FileBlockProc(
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- FileInfo *infoPtr = instanceData;
+ FileInfo *infoPtr = (FileInfo *) instanceData;
/*
* Files on Windows can not be switched between blocking and nonblocking,
@@ -378,7 +378,7 @@ FileCloseProc(
ClientData instanceData, /* Pointer to FileInfo structure. */
Tcl_Interp *interp) /* Not used. */
{
- FileInfo *fileInfoPtr = instanceData;
+ FileInfo *fileInfoPtr = (FileInfo *) instanceData;
FileInfo *infoPtr;
ThreadSpecificData *tsdPtr;
int errorCode = 0;
@@ -424,7 +424,7 @@ FileCloseProc(
break;
}
}
- ckfree(fileInfoPtr);
+ ckfree((char *)fileInfoPtr);
return errorCode;
}
@@ -453,7 +453,7 @@ FileSeekProc(
int mode, /* Relative to where should we seek? */
int *errorCodePtr) /* To store error code. */
{
- FileInfo *infoPtr = instanceData;
+ FileInfo *infoPtr = (FileInfo *) instanceData;
LONG newPos, newPosHigh, oldPos, oldPosHigh;
DWORD moveMethod;
@@ -531,7 +531,7 @@ FileWideSeekProc(
int mode, /* Relative to where should we seek? */
int *errorCodePtr) /* To store error code. */
{
- FileInfo *infoPtr = instanceData;
+ FileInfo *infoPtr = (FileInfo *) instanceData;
DWORD moveMethod;
LONG newPos, newPosHigh;
@@ -580,7 +580,7 @@ FileTruncateProc(
ClientData instanceData, /* File state. */
Tcl_WideInt length) /* Length to truncate at. */
{
- FileInfo *infoPtr = instanceData;
+ FileInfo *infoPtr = (FileInfo *) instanceData;
LONG newPos, newPosHigh, oldPos, oldPosHigh;
/*
@@ -656,16 +656,13 @@ FileInputProc(
int bufSize, /* Num bytes available in buffer. */
int *errorCode) /* Where to store error code. */
{
- FileInfo *infoPtr = instanceData;
+ FileInfo *infoPtr;
DWORD bytesRead;
*errorCode = 0;
+ infoPtr = (FileInfo *) instanceData;
/*
- * TODO: This comment appears to be out of date. We *do* have a
- * console driver, over in tclWinConsole.c. After some Windows
- * developer confirms, this comment should be revised.
- *
* Note that we will block on reads from a console buffer until a full
* line has been entered. The only way I know of to get around this is to
* write a console driver. We should probably do this at some point, but
@@ -707,11 +704,11 @@ FileInputProc(
static int
FileOutputProc(
ClientData instanceData, /* File state. */
- const char *buf, /* The data buffer. */
+ CONST char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
{
- FileInfo *infoPtr = instanceData;
+ FileInfo *infoPtr = (FileInfo *) instanceData;
DWORD bytesWritten;
*errorCode = 0;
@@ -758,7 +755,7 @@ FileWatchProc(
* of TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION. */
{
- FileInfo *infoPtr = instanceData;
+ FileInfo *infoPtr = (FileInfo *) instanceData;
Tcl_Time blockTime = { 0, 0 };
/*
@@ -796,7 +793,7 @@ FileGetHandleProc(
int direction, /* TCL_READABLE or TCL_WRITABLE */
ClientData *handlePtr) /* Where to store the handle. */
{
- FileInfo *infoPtr = instanceData;
+ FileInfo *infoPtr = (FileInfo *) instanceData;
if (direction & infoPtr->validMask) {
*handlePtr = (ClientData) infoPtr->handle;
@@ -836,12 +833,12 @@ TclpOpenFileChannel(
Tcl_Channel channel = 0;
int channelPermissions = 0;
DWORD accessMode = 0, createMode, shareMode, flags;
- const TCHAR *nativeName;
+ CONST TCHAR *nativeName;
HANDLE handle;
char channelName[16 + TCL_INTEGER_SPACE];
TclFile readFile = NULL, writeFile = NULL;
- nativeName = Tcl_FSGetNativePath(pathPtr);
+ nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
if (nativeName == NULL) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "couldn't open \"",
@@ -932,7 +929,7 @@ TclpOpenFileChannel(
flags = FILE_ATTRIBUTE_READONLY;
}
} else {
- flags = GetFileAttributes(nativeName);
+ flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
@@ -948,8 +945,8 @@ TclpOpenFileChannel(
* Now we get to create the file.
*/
- handle = CreateFile(nativeName, accessMode, shareMode,
- NULL, createMode, flags, (HANDLE) NULL);
+ handle = (*tclWinProcs->createFileProc)(nativeName, accessMode,
+ shareMode, NULL, createMode, flags, (HANDLE) NULL);
if (handle == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
@@ -959,9 +956,8 @@ TclpOpenFileChannel(
}
TclWinConvertError(err);
if (interp != (Tcl_Interp *) NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open \"%s\": %s",
- TclGetString(pathPtr), Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
+ "\": ", Tcl_PosixError(interp), NULL);
}
return NULL;
}
@@ -971,7 +967,7 @@ TclpOpenFileChannel(
switch (FileGetType(handle)) {
case FILE_TYPE_SERIAL:
/*
- * Natively named serial ports "com1-9", "\\\\.\\comXX" are
+ * Natively named serial ports "com1-9", "\\\\.\\comXX" are
* already done with the code above.
* Here we handle all other serial port names.
*
@@ -983,9 +979,9 @@ TclpOpenFileChannel(
if (handle == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
if (interp != (Tcl_Interp *) NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't reopen serial \"%s\": %s",
- TclGetString(pathPtr), Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "couldn't reopen serial \"",
+ TclGetString(pathPtr), "\": ",
+ Tcl_PosixError(interp), NULL);
}
return NULL;
}
@@ -1019,11 +1015,8 @@ TclpOpenFileChannel(
*/
channel = NULL;
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open \"%s\": bad file type",
- TclGetString(pathPtr)));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE",
- NULL);
+ Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
+ "\": bad file type", NULL);
break;
}
@@ -1249,8 +1242,8 @@ TclpGetDefaultStdChannel(
Tcl_Channel channel;
HANDLE handle;
int mode = -1;
- const char *bufMode = NULL;
- DWORD handleId = (DWORD) -1;
+ char *bufMode = NULL;
+ DWORD handleId = (DWORD)-1;
/* Standard handle to retrieve. */
switch (type) {
@@ -1349,7 +1342,7 @@ TclWinOpenFileChannel(
}
}
- infoPtr = ckalloc(sizeof(FileInfo));
+ infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
/*
* TIP #218. Removed the code inserting the new structure into the global
@@ -1363,10 +1356,10 @@ TclWinOpenFileChannel(
infoPtr->flags = appendMode;
infoPtr->handle = handle;
infoPtr->dirty = 0;
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr);
infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
- infoPtr, permissions);
+ (ClientData) infoPtr, permissions);
/*
* Files have default translation of AUTO and ^Z eof char, which means
@@ -1440,7 +1433,7 @@ FileThreadActionProc(
int action)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- FileInfo *infoPtr = instanceData;
+ FileInfo *infoPtr = (FileInfo *) instanceData;
if (action == TCL_CHANNEL_THREAD_INSERT) {
infoPtr->nextPtr = tsdPtr->firstFilePtr;
@@ -1525,11 +1518,12 @@ FileGetType(
* NativeIsComPort --
*
* Determines if a path refers to a Windows serial port.
- * A simple and efficient solution is to use a "name hint" to detect
- * COM ports by their filename instead of resorting to a syscall
+ * A simple and efficient solution is to use a "name hint" to detect
+ * COM ports by their filename instead of resorting to a syscall
* to detect serialness after the fact.
* The following patterns cover common serial port names:
- * COM[1-9]
+ * COM[1-9]:?
+ * //./COM[0-9]+
* \\.\COM[0-9]+
*
* Results:
@@ -1542,39 +1536,94 @@ static int
NativeIsComPort(
const TCHAR *nativePath) /* Path of file to access, native encoding. */
{
- const WCHAR *p = (const WCHAR *) nativePath;
- int i, len = wcslen(p);
-
/*
- * 1. Look for com[1-9]:?
+ * Use wide-char or plain character case-insensitive comparison
*/
+ if (tclWinProcs->useWide) {
+ const WCHAR *p = (const WCHAR *) nativePath;
+ int i, len = wcslen(p);
- if ( (len == 4) && (_wcsnicmp(p, L"com", 3) == 0) ) {
/*
- * The 4th character must be a digit 1..9
- */
+ * 1. Look for com[1-9]:?
+ */
+
+ if ( (len >= 4) && (len <= 5)
+ && (_wcsnicmp(p, L"com", 3) == 0) ) {
+ /*
+ * The 4th character must be a digit 1..9 optionally followed by a ":"
+ */
- if ( (p[3] < L'1') || (p[3] > L'9') ) {
- return 0;
+ if ( (p[3] < L'1') || (p[3] > L'9') ) {
+ return 0;
+ }
+ if ( (len == 5) && (p[4] != L':') ) {
+ return 0;
+ }
+ return 1;
}
- return 1;
- }
- /*
- * 2. Look for \\.\com[0-9]+
- */
+ /*
+ * 2. Look for //./com[0-9]+ or \\.\com[0-9]+
+ */
+
+ if ( (len >= 8) && (
+ (_wcsnicmp(p, L"//./com", 7) == 0)
+ || (_wcsnicmp(p, L"\\\\.\\com", 7) == 0) ) )
+ {
+ /*
+ * Charaters 8..end must be a digits 0..9
+ */
+
+ for ( i=7; i<len; i++ ) {
+ if ( (p[i] < '0') || (p[i] > '9') ) {
+ return 0;
+ }
+ }
+ return 1;
+ }
+
+ } else {
+ const char *p = (const char *) nativePath;
+ int i, len = strlen(p);
- if ((len >= 8) && (_wcsnicmp(p, L"\\\\.\\com", 7) == 0)) {
/*
- * Charaters 8..end must be a digits 0..9
- */
+ * 1. Look for com[1-9]:?
+ */
- for ( i=7; i<len; i++ ) {
- if ( (p[i] < '0') || (p[i] > '9') ) {
+ if ( (len >= 4) && (len <= 5)
+ && (strnicmp(p, "com", 3) == 0) ) {
+ /*
+ * The 4th character must be a digit 1..9 optionally followed by a ":"
+ */
+
+ if ( (p[3] < '1') || (p[3] > '9') ) {
return 0;
}
+ if ( (len == 5) && (p[4] != ':') ) {
+ return 0;
+ }
+ return 1;
+ }
+
+ /*
+ * 2. Look for //./com[0-9]+ or \\.\com[0-9]+
+ */
+
+ if ( (len >= 8) && (
+ (strnicmp(p, "//./com", 7) == 0)
+ || (strnicmp(p, "\\\\.\\com", 7) == 0) ) )
+ {
+ /*
+ * Charaters 8..end must be a digits 0..9
+ */
+
+ for ( i=7; i<len; i++ ) {
+ if ( (p[i] < '0') || (p[i] > '9') ) {
+ return 0;
+ }
+ }
+ return 1;
}
- return 1;
}
return 0;
}
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index ab55035..361fb3d 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -12,6 +12,9 @@
#include "tclWinInt.h"
+#include <fcntl.h>
+#include <io.h>
+
/*
* The following variable is used to tell whether this module has been
* initialized.
@@ -45,23 +48,6 @@ TCL_DECLARE_MUTEX(consoleMutex)
#define CONSOLE_BUFFER_SIZE (8*1024)
/*
- * Structure containing handles associated with one of the special console
- * threads.
- */
-
-typedef struct ConsoleThreadInfo {
- HANDLE thread; /* Handle to reader or writer thread. */
- HANDLE readyEvent; /* Manual-reset event to signal _to_ the main
- * thread when the worker thread has finished
- * waiting for its normal work to happen. */
- HANDLE startEvent; /* Auto-reset event used by the main thread to
- * signal when the thread should attempt to do
- * its normal work. */
- HANDLE stopEvent; /* Auto-reset event used by the main thread to
- * signal when the thread should exit. */
-} ConsoleThreadInfo;
-
-/*
* This structure describes per-instance data for a console based channel.
*/
@@ -80,18 +66,24 @@ typedef struct ConsoleInfo {
Tcl_ThreadId threadId; /* Thread to which events should be reported.
* This value is used by the reader/writer
* threads. */
- ConsoleThreadInfo writer; /* A specialized thread for handling
- * asynchronous writes to the console; the
- * waiting starts when a start event is sent,
- * and a reset event is sent back to the main
- * thread when the write is done. A stop event
- * is used to terminate the thread. */
- ConsoleThreadInfo reader; /* A specialized thread for handling
- * asynchronous reads from the console; the
- * waiting starts when a start event is sent,
- * and a reset event is sent back to the main
- * thread when input is available. A stop
- * event is used to terminate the thread. */
+ HANDLE writeThread; /* Handle to writer thread. */
+ HANDLE readThread; /* Handle to reader thread. */
+ HANDLE writable; /* Manual-reset event to signal when the
+ * writer thread has finished waiting for the
+ * current buffer to be written. */
+ HANDLE readable; /* Manual-reset event to signal when the
+ * reader thread has finished waiting for
+ * input. */
+ HANDLE startWriter; /* Auto-reset event used by the main thread to
+ * signal when the writer thread should
+ * attempt to write to the console. */
+ HANDLE stopWriter; /* Auto-reset event used by the main thread to
+ * signal when the writer thread should exit */
+ HANDLE startReader; /* Auto-reset event used by the main thread to
+ * signal when the reader thread should
+ * attempt to read from the console. */
+ HANDLE stopReader; /* Auto-reset event used by the main thread to
+ * signal when the reader thread should exit */
DWORD writeError; /* An error caused by the last background
* write. Set to 0 if no error has been
* detected. This word is shared with the
@@ -106,8 +98,8 @@ typedef struct ConsoleInfo {
int readFlags; /* Flags that are shared with the reader
* thread. Access is synchronized with the
* readable object. */
- int bytesRead; /* Number of bytes in the buffer. */
- int offset; /* Number of bytes read out of the buffer. */
+ int bytesRead; /* number of bytes in the buffer */
+ int offset; /* number of bytes read out of the buffer */
char buffer[CONSOLE_BUFFER_SIZE];
/* Data consumed by reader thread. */
} ConsoleInfo;
@@ -141,8 +133,7 @@ typedef struct ConsoleEvent {
* Declarations for functions used only in this file.
*/
-static int ConsoleBlockModeProc(ClientData instanceData,
- int mode);
+static int ConsoleBlockModeProc(ClientData instanceData,int mode);
static void ConsoleCheckProc(ClientData clientData, int flags);
static int ConsoleCloseProc(ClientData instanceData,
Tcl_Interp *interp);
@@ -154,7 +145,7 @@ static void ConsoleInit(void);
static int ConsoleInputProc(ClientData instanceData, char *buf,
int toRead, int *errorCode);
static int ConsoleOutputProc(ClientData instanceData,
- const char *buf, int toWrite, int *errorCode);
+ CONST char *buf, int toWrite, int *errorCode);
static DWORD WINAPI ConsoleReaderThread(LPVOID arg);
static void ConsoleSetupProc(ClientData clientData, int flags);
static void ConsoleWatchProc(ClientData instanceData, int mask);
@@ -163,22 +154,13 @@ static void ProcExitHandler(ClientData clientData);
static int WaitForRead(ConsoleInfo *infoPtr, int blocking);
static void ConsoleThreadActionProc(ClientData instanceData,
int action);
-static BOOL ReadConsoleBytes(HANDLE hConsole, LPVOID lpBuffer,
- DWORD nbytes, LPDWORD nbytesread);
-static BOOL WriteConsoleBytes(HANDLE hConsole,
- const void *lpBuffer, DWORD nbytes,
- LPDWORD nbyteswritten);
-static void StartChannelThread(ConsoleInfo *infoPtr,
- ConsoleThreadInfo *threadInfoPtr,
- LPTHREAD_START_ROUTINE threadProc);
-static void StopChannelThread(ConsoleThreadInfo *threadInfoPtr);
/*
* This structure describes the channel type structure for command console
* based IO.
*/
-static const Tcl_ChannelType consoleChannelType = {
+static Tcl_ChannelType consoleChannelType = {
"console", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
ConsoleCloseProc, /* Close proc. */
@@ -190,27 +172,23 @@ static const Tcl_ChannelType consoleChannelType = {
ConsoleWatchProc, /* Set up notifier to watch the channel. */
ConsoleGetHandleProc, /* Get an OS handle from channel. */
NULL, /* close2proc. */
- ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */
- NULL, /* Flush proc. */
- NULL, /* Handler proc. */
- NULL, /* Wide seek proc. */
- ConsoleThreadActionProc, /* Thread action proc. */
- NULL /* Truncation proc. */
+ ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
+ NULL, /* wide seek proc */
+ ConsoleThreadActionProc, /* thread action proc */
+ NULL, /* truncation */
};
/*
*----------------------------------------------------------------------
*
- * ReadConsoleBytes, WriteConsoleBytes --
- *
- * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes
- * instead of number of TCHARS.
- *
- *----------------------------------------------------------------------
+ * readConsoleBytes, writeConsoleBytes --
+ * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes
+ * instead of number of TCHARS
*/
-
static BOOL
-ReadConsoleBytes(
+readConsoleBytes(
HANDLE hConsole,
LPVOID lpBuffer,
DWORD nbytes,
@@ -218,44 +196,30 @@ ReadConsoleBytes(
{
DWORD ntchars;
BOOL result;
- int tcharsize = sizeof(TCHAR);
-
- /*
- * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return
- * success with ntchars == 0 and GetLastError() will be
- * ERROR_OPERATION_ABORTED. We do not want to treat this case
- * as EOF so we will loop around again. If no Ctrl signal handlers
- * have been established, the default signal OS handler in a separate
- * thread will terminate the program. If a Ctrl signal handler
- * has been established (through an extension for example), it
- * will run and take whatever action it deems appropriate.
- */
- do {
- result = ReadConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars,
- NULL);
- } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED);
- if (nbytesread != NULL) {
- *nbytesread = ntchars * tcharsize;
- }
+ int tcharsize;
+ tcharsize = tclWinProcs->useWide? 2 : 1;
+ result = tclWinProcs->readConsoleProc(
+ hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL);
+ if (nbytesread)
+ *nbytesread = (ntchars*tcharsize);
return result;
}
static BOOL
-WriteConsoleBytes(
+writeConsoleBytes(
HANDLE hConsole,
- const void *lpBuffer,
+ const VOID *lpBuffer,
DWORD nbytes,
LPDWORD nbyteswritten)
{
DWORD ntchars;
BOOL result;
- int tcharsize = sizeof(TCHAR);
-
- result = WriteConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars,
- NULL);
- if (nbyteswritten != NULL) {
- *nbyteswritten = ntchars * tcharsize;
- }
+ int tcharsize;
+ tcharsize = tclWinProcs->useWide? 2 : 1;
+ result = tclWinProcs->writeConsoleProc(
+ hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL);
+ if (nbyteswritten)
+ *nbyteswritten = (ntchars*tcharsize);
return result;
}
@@ -278,6 +242,8 @@ WriteConsoleBytes(
static void
ConsoleInit(void)
{
+ ThreadSpecificData *tsdPtr;
+
/*
* Check the initialized flag first, then check again in the mutex. This
* is a speed enhancement.
@@ -292,9 +258,9 @@ ConsoleInit(void)
Tcl_MutexUnlock(&consoleMutex);
}
- if (TclThreadDataKeyGet(&dataKey) == NULL) {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
+ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
tsdPtr->firstConsolePtr = NULL;
Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
@@ -320,7 +286,7 @@ ConsoleInit(void)
static void
ConsoleExitHandler(
- ClientData clientData) /* Old window proc. */
+ ClientData clientData) /* Old window proc */
{
Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
}
@@ -344,7 +310,7 @@ ConsoleExitHandler(
static void
ProcExitHandler(
- ClientData clientData) /* Old window proc. */
+ ClientData clientData) /* Old window proc */
{
Tcl_MutexLock(&consoleMutex);
initialized = 0;
@@ -389,8 +355,7 @@ ConsoleSetupProc(
for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writer.readyEvent,
- 0) != WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
block = 0;
}
}
@@ -428,6 +393,7 @@ ConsoleCheckProc(
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
ConsoleInfo *infoPtr;
+ ConsoleEvent *evPtr;
int needEvent;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -452,8 +418,7 @@ ConsoleCheckProc(
needEvent = 0;
if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writer.readyEvent,
- 0) != WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
needEvent = 1;
}
}
@@ -465,9 +430,8 @@ ConsoleCheckProc(
}
if (needEvent) {
- ConsoleEvent *evPtr = ckalloc(sizeof(ConsoleEvent));
-
infoPtr->flags |= CONSOLE_PENDING;
+ evPtr = (ConsoleEvent *) ckalloc(sizeof(ConsoleEvent));
evPtr->header.proc = ConsoleEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -475,6 +439,7 @@ ConsoleCheckProc(
}
}
+
/*
*----------------------------------------------------------------------
*
@@ -497,7 +462,7 @@ ConsoleBlockModeProc(
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- ConsoleInfo *infoPtr = instanceData;
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
/*
* Consoles on Windows can not be switched between blocking and
@@ -510,7 +475,7 @@ ConsoleBlockModeProc(
if (mode == TCL_MODE_NONBLOCKING) {
infoPtr->flags |= CONSOLE_ASYNC;
} else {
- infoPtr->flags &= ~CONSOLE_ASYNC;
+ infoPtr->flags &= ~(CONSOLE_ASYNC);
}
return 0;
}
@@ -518,84 +483,6 @@ ConsoleBlockModeProc(
/*
*----------------------------------------------------------------------
*
- * StartChannelThread, StopChannelThread --
- *
- * Helpers that codify how to ask one of the console service threads to
- * start and stop.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-StartChannelThread(
- ConsoleInfo *infoPtr,
- ConsoleThreadInfo *threadInfoPtr,
- LPTHREAD_START_ROUTINE threadProc)
-{
- DWORD id;
-
- threadInfoPtr->readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL);
- threadInfoPtr->startEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
- threadInfoPtr->stopEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
- threadInfoPtr->thread = CreateThread(NULL, 256, threadProc, infoPtr, 0,
- &id);
- SetThreadPriority(threadInfoPtr->thread, THREAD_PRIORITY_HIGHEST);
-}
-
-static void
-StopChannelThread(
- ConsoleThreadInfo *threadInfoPtr)
-{
- DWORD exitCode = 0;
-
- /*
- * The thread may already have closed on it's own. Check it's exit
- * code.
- */
-
- GetExitCodeThread(threadInfoPtr->thread, &exitCode);
- if (exitCode == STILL_ACTIVE) {
- /*
- * Set the stop event so that if the reader thread is blocked in
- * ConsoleReaderThread on WaitForMultipleEvents, it will exit cleanly.
- */
-
- SetEvent(threadInfoPtr->stopEvent);
-
- /*
- * Wait at most 20 milliseconds for the reader thread to close.
- */
-
- if (WaitForSingleObject(threadInfoPtr->thread, 20) == WAIT_TIMEOUT) {
- /*
- * Forcibly terminate the background thread as a last resort.
- * Note that we need to guard against terminating the thread while
- * it is in the middle of Tcl_ThreadAlert because it won't be able
- * to release the notifier lock.
- */
-
- Tcl_MutexLock(&consoleMutex);
- /* BUG: this leaks memory. */
- TerminateThread(threadInfoPtr->thread, 0);
- Tcl_MutexUnlock(&consoleMutex);
- }
- }
-
- /*
- * Close all the handles associated with the thread, and set the thread
- * handle field to NULL to mark that the thread has been cleaned up.
- */
-
- CloseHandle(threadInfoPtr->thread);
- CloseHandle(threadInfoPtr->readyEvent);
- CloseHandle(threadInfoPtr->startEvent);
- CloseHandle(threadInfoPtr->stopEvent);
- threadInfoPtr->thread = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* ConsoleCloseProc --
*
* Closes a console based IO channel.
@@ -614,10 +501,13 @@ ConsoleCloseProc(
ClientData instanceData, /* Pointer to ConsoleInfo structure. */
Tcl_Interp *interp) /* For error reporting. */
{
- ConsoleInfo *consolePtr = instanceData;
- int errorCode = 0;
+ ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData;
+ int errorCode;
ConsoleInfo *infoPtr, **nextPtrPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ DWORD exitCode;
+
+ errorCode = 0;
/*
* Clean up the background thread if necessary. Note that this must be
@@ -625,8 +515,49 @@ ConsoleCloseProc(
* trying to read from the console.
*/
- if (consolePtr->reader.thread) {
- StopChannelThread(&consolePtr->reader);
+ if (consolePtr->readThread) {
+ /*
+ * The thread may already have closed on it's own. Check it's exit
+ * code.
+ */
+
+ GetExitCodeThread(consolePtr->readThread, &exitCode);
+
+ if (exitCode == STILL_ACTIVE) {
+ /*
+ * Set the stop event so that if the reader thread is blocked in
+ * ConsoleReaderThread on WaitForMultipleEvents, it will exit
+ * cleanly.
+ */
+
+ SetEvent(consolePtr->stopReader);
+
+ /*
+ * Wait at most 20 milliseconds for the reader thread to close.
+ */
+
+ if (WaitForSingleObject(consolePtr->readThread, 20)
+ == WAIT_TIMEOUT) {
+ /*
+ * Forcibly terminate the background thread as a last resort.
+ * Note that we need to guard against terminating the thread
+ * while it is in the middle of Tcl_ThreadAlert because it
+ * won't be able to release the notifier lock.
+ */
+
+ Tcl_MutexLock(&consoleMutex);
+
+ /* BUG: this leaks memory. */
+ TerminateThread(consolePtr->readThread, 0);
+ Tcl_MutexUnlock(&consoleMutex);
+ }
+ }
+
+ CloseHandle(consolePtr->readThread);
+ CloseHandle(consolePtr->readable);
+ CloseHandle(consolePtr->startReader);
+ CloseHandle(consolePtr->stopReader);
+ consolePtr->readThread = NULL;
}
consolePtr->validMask &= ~TCL_READABLE;
@@ -636,20 +567,62 @@ ConsoleCloseProc(
* should be no pending write operations.
*/
- if (consolePtr->writer.thread) {
+ if (consolePtr->writeThread) {
if (consolePtr->toWrite) {
/*
* We only need to wait if there is something to write. This may
- * prevent infinite wait on exit. [Python Bug 216289]
+ * prevent infinite wait on exit. [python bug 216289]
+ */
+
+ WaitForSingleObject(consolePtr->writable, INFINITE);
+ }
+
+ /*
+ * The thread may already have closed on it's own. Check it's exit
+ * code.
+ */
+
+ GetExitCodeThread(consolePtr->writeThread, &exitCode);
+
+ if (exitCode == STILL_ACTIVE) {
+ /*
+ * Set the stop event so that if the reader thread is blocked in
+ * ConsoleWriterThread on WaitForMultipleEvents, it will exit
+ * cleanly.
+ */
+
+ SetEvent(consolePtr->stopWriter);
+
+ /*
+ * Wait at most 20 milliseconds for the writer thread to close.
*/
- WaitForSingleObject(consolePtr->writer.readyEvent, INFINITE);
+ if (WaitForSingleObject(consolePtr->writeThread, 20)
+ == WAIT_TIMEOUT) {
+ /*
+ * Forcibly terminate the background thread as a last resort.
+ * Note that we need to guard against terminating the thread
+ * while it is in the middle of Tcl_ThreadAlert because it
+ * won't be able to release the notifier lock.
+ */
+
+ Tcl_MutexLock(&consoleMutex);
+
+ /* BUG: this leaks memory. */
+ TerminateThread(consolePtr->writeThread, 0);
+ Tcl_MutexUnlock(&consoleMutex);
+ }
}
- StopChannelThread(&consolePtr->writer);
+ CloseHandle(consolePtr->writeThread);
+ CloseHandle(consolePtr->writable);
+ CloseHandle(consolePtr->startWriter);
+ CloseHandle(consolePtr->stopWriter);
+ consolePtr->writeThread = NULL;
}
consolePtr->validMask &= ~TCL_WRITABLE;
+
/*
* Don't close the Win32 handle if the handle is a standard channel during
* the thread exit process. Otherwise, one thread may kill the stdio of
@@ -675,7 +648,7 @@ ConsoleCloseProc(
for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr;
infoPtr != NULL;
nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
- if (infoPtr == (ConsoleInfo *) consolePtr) {
+ if (infoPtr == (ConsoleInfo *)consolePtr) {
*nextPtrPtr = infoPtr->nextPtr;
break;
}
@@ -684,7 +657,7 @@ ConsoleCloseProc(
ckfree(consolePtr->writeBuf);
consolePtr->writeBuf = 0;
}
- ckfree(consolePtr);
+ ckfree((char*) consolePtr);
return errorCode;
}
@@ -715,7 +688,7 @@ ConsoleInputProc(
* buffer? */
int *errorCode) /* Where to store error code. */
{
- ConsoleInfo *infoPtr = instanceData;
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
DWORD count, bytesRead = 0;
int result;
@@ -750,7 +723,7 @@ ConsoleInputProc(
bytesRead = infoPtr->bytesRead - infoPtr->offset;
/*
- * Reset the buffer.
+ * Reset the buffer
*/
infoPtr->readFlags &= ~CONSOLE_BUFFERED;
@@ -766,15 +739,8 @@ ConsoleInputProc(
* byte is available or an EOF occurs.
*/
- if (ReadConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize,
- &count) == TRUE) {
- /*
- * TODO: This potentially writes beyond the limits specified
- * by the caller. In practice this is harmless, since all writes
- * are into ChannelBuffers, and those have padding, but still
- * ought to remove this, unless some Windows wizard can give
- * a reason not to.
- */
+ if (readConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count)
+ == TRUE) {
buf[count] = '\0';
return count;
}
@@ -803,23 +769,22 @@ ConsoleInputProc(
static int
ConsoleOutputProc(
ClientData instanceData, /* Console state. */
- const char *buf, /* The data buffer. */
+ CONST char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
{
- ConsoleInfo *infoPtr = instanceData;
- ConsoleThreadInfo *threadInfo = &infoPtr->reader;
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
DWORD bytesWritten, timeout;
*errorCode = 0;
timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE;
- if (WaitForSingleObject(threadInfo->readyEvent,timeout) == WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
/*
* The writer thread is blocked waiting for a write to complete and
* the channel is in non-blocking mode.
*/
- errno = EWOULDBLOCK;
+ errno = EAGAIN;
goto error;
}
@@ -848,12 +813,12 @@ ConsoleOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc(toWrite);
+ infoPtr->writeBuf = ckalloc((size_t)toWrite);
}
- memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
+ memcpy(infoPtr->writeBuf, buf, (size_t)toWrite);
infoPtr->toWrite = toWrite;
- ResetEvent(threadInfo->readyEvent);
- SetEvent(threadInfo->startEvent);
+ ResetEvent(infoPtr->writable);
+ SetEvent(infoPtr->startWriter);
bytesWritten = toWrite;
} else {
/*
@@ -861,8 +826,9 @@ ConsoleOutputProc(
* avoids an unnecessary copy.
*/
- if (WriteConsoleBytes(infoPtr->handle, buf, (DWORD) toWrite,
- &bytesWritten) == FALSE) {
+ if (writeConsoleBytes(infoPtr->handle, buf, (DWORD)toWrite,
+ &bytesWritten)
+ == FALSE) {
TclWinConvertError(GetLastError());
goto error;
}
@@ -901,7 +867,7 @@ ConsoleEventProc(
int flags) /* Flags that indicate what events to handle,
* such as TCL_FILE_EVENTS. */
{
- ConsoleEvent *consoleEvPtr = (ConsoleEvent *) evPtr;
+ ConsoleEvent *consoleEvPtr = (ConsoleEvent *)evPtr;
ConsoleInfo *infoPtr;
int mask;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -920,7 +886,7 @@ ConsoleEventProc(
for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (consoleEvPtr->infoPtr == infoPtr) {
- infoPtr->flags &= ~CONSOLE_PENDING;
+ infoPtr->flags &= ~(CONSOLE_PENDING);
break;
}
}
@@ -941,8 +907,7 @@ ConsoleEventProc(
mask = 0;
if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writer.readyEvent,
- 0) != WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
mask = TCL_WRITABLE;
}
}
@@ -989,7 +954,7 @@ ConsoleWatchProc(
* TCL_EXCEPTION. */
{
ConsoleInfo **nextPtrPtr, *ptr;
- ConsoleInfo *infoPtr = instanceData;
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
int oldMask = infoPtr->watchMask;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -1001,7 +966,6 @@ ConsoleWatchProc(
infoPtr->watchMask = mask & infoPtr->validMask;
if (infoPtr->watchMask) {
Tcl_Time blockTime = { 0, 0 };
-
if (!oldMask) {
infoPtr->nextPtr = tsdPtr->firstConsolePtr;
tsdPtr->firstConsolePtr = infoPtr;
@@ -1044,12 +1008,12 @@ ConsoleWatchProc(
static int
ConsoleGetHandleProc(
ClientData instanceData, /* The console state. */
- int direction, /* TCL_READABLE or TCL_WRITABLE. */
+ int direction, /* TCL_READABLE or TCL_WRITABLE */
ClientData *handlePtr) /* Where to store the handle. */
{
- ConsoleInfo *infoPtr = instanceData;
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
- *handlePtr = infoPtr->handle;
+ *handlePtr = (ClientData) infoPtr->handle;
return TCL_OK;
}
@@ -1082,7 +1046,6 @@ WaitForRead(
{
DWORD timeout, count;
HANDLE *handle = infoPtr->handle;
- ConsoleThreadInfo *threadInfo = &infoPtr->reader;
INPUT_RECORD input;
while (1) {
@@ -1091,14 +1054,13 @@ WaitForRead(
*/
timeout = blocking ? INFINITE : 0;
- if (WaitForSingleObject(threadInfo->readyEvent,
- timeout) == WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
/*
* The reader thread is blocked waiting for data and the channel
* is in non-blocking mode.
*/
- errno = EWOULDBLOCK;
+ errno = EAGAIN;
return -1;
}
@@ -1151,8 +1113,8 @@ WaitForRead(
* There wasn't any data available, so reset the thread and try again.
*/
- ResetEvent(threadInfo->readyEvent);
- SetEvent(threadInfo->startEvent);
+ ResetEvent(infoPtr->readable);
+ SetEvent(infoPtr->startReader);
}
}
@@ -1179,18 +1141,14 @@ static DWORD WINAPI
ConsoleReaderThread(
LPVOID arg)
{
- ConsoleInfo *infoPtr = arg;
+ ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
HANDLE *handle = infoPtr->handle;
- ConsoleThreadInfo *threadInfo = &infoPtr->reader;
DWORD waitResult;
HANDLE wEvents[2];
- /*
- * The first event takes precedence.
- */
-
- wEvents[0] = threadInfo->stopEvent;
- wEvents[1] = threadInfo->startEvent;
+ /* The first event takes precedence. */
+ wEvents[0] = infoPtr->stopReader;
+ wEvents[1] = infoPtr->startReader;
for (;;) {
/*
@@ -1213,7 +1171,7 @@ ConsoleReaderThread(
* not KEY_EVENTs.
*/
- if (ReadConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
+ if (readConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
(LPDWORD) &infoPtr->bytesRead) != FALSE) {
/*
* Data was stored in the buffer.
@@ -1221,9 +1179,10 @@ ConsoleReaderThread(
infoPtr->readFlags |= CONSOLE_BUFFERED;
} else {
- DWORD err = GetLastError();
+ DWORD err;
+ err = GetLastError();
- if (err == (DWORD) EOF) {
+ if (err == (DWORD)EOF) {
infoPtr->readFlags = CONSOLE_EOF;
}
}
@@ -1233,7 +1192,7 @@ ConsoleReaderThread(
* waking up the notifier thread.
*/
- SetEvent(threadInfo->readyEvent);
+ SetEvent(infoPtr->readable);
/*
* Alert the foreground thread. Note that we need to treat this like a
@@ -1247,7 +1206,6 @@ ConsoleReaderThread(
* TIP #218. When in flight ignore the event, no one will receive
* it anyway.
*/
-
Tcl_ThreadAlert(infoPtr->threadId);
}
Tcl_MutexUnlock(&consoleMutex);
@@ -1279,19 +1237,16 @@ static DWORD WINAPI
ConsoleWriterThread(
LPVOID arg)
{
- ConsoleInfo *infoPtr = arg;
+
+ ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
HANDLE *handle = infoPtr->handle;
- ConsoleThreadInfo *threadInfo = &infoPtr->writer;
DWORD count, toWrite, waitResult;
char *buf;
HANDLE wEvents[2];
- /*
- * The first event takes precedence.
- */
-
- wEvents[0] = threadInfo->stopEvent;
- wEvents[1] = threadInfo->startEvent;
+ /* The first event takes precedence. */
+ wEvents[0] = infoPtr->stopWriter;
+ wEvents[1] = infoPtr->startWriter;
for (;;) {
/*
@@ -1317,13 +1272,14 @@ ConsoleWriterThread(
*/
while (toWrite > 0) {
- if (WriteConsoleBytes(handle, buf, (DWORD) toWrite,
- &count) == FALSE) {
+ if (writeConsoleBytes(handle, buf, (DWORD)toWrite,
+ &count) == FALSE) {
infoPtr->writeError = GetLastError();
break;
+ } else {
+ toWrite -= count;
+ buf += count;
}
- toWrite -= count;
- buf += count;
}
/*
@@ -1331,7 +1287,7 @@ ConsoleWriterThread(
* waking up the notifier thread.
*/
- SetEvent(threadInfo->readyEvent);
+ SetEvent(infoPtr->writable);
/*
* Alert the foreground thread. Note that we need to treat this like a
@@ -1367,7 +1323,7 @@ ConsoleWriterThread(
* Returns the new channel, or NULL.
*
* Side effects:
- * May open the channel.
+ * May open the channel
*
*----------------------------------------------------------------------
*/
@@ -1380,7 +1336,7 @@ TclWinOpenConsoleChannel(
{
char encoding[4 + TCL_INTEGER_SPACE];
ConsoleInfo *infoPtr;
- DWORD modes;
+ DWORD id, modes;
ConsoleInit();
@@ -1388,7 +1344,7 @@ TclWinOpenConsoleChannel(
* See if a channel with this handle already exists.
*/
- infoPtr = ckalloc(sizeof(ConsoleInfo));
+ infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo));
memset(infoPtr, 0, sizeof(ConsoleInfo));
infoPtr->validMask = permissions;
@@ -1405,10 +1361,10 @@ TclWinOpenConsoleChannel(
* for instance).
*/
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr);
infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
- infoPtr, permissions);
+ (ClientData) infoPtr, permissions);
if (permissions & TCL_READABLE) {
/*
@@ -1421,11 +1377,22 @@ TclWinOpenConsoleChannel(
modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT);
modes |= ENABLE_LINE_INPUT;
SetConsoleMode(infoPtr->handle, modes);
- StartChannelThread(infoPtr, &infoPtr->reader, ConsoleReaderThread);
+
+ infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->stopReader = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->readThread = CreateThread(NULL, 256, ConsoleReaderThread,
+ infoPtr, 0, &id);
+ SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
}
if (permissions & TCL_WRITABLE) {
- StartChannelThread(infoPtr, &infoPtr->writer, ConsoleWriterThread);
+ infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->stopWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->writeThread = CreateThread(NULL, 256, ConsoleWriterThread,
+ infoPtr, 0, &id);
+ SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
}
/*
@@ -1435,11 +1402,11 @@ TclWinOpenConsoleChannel(
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
-#ifdef UNICODE
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode");
-#else
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
-#endif
+ if (tclWinProcs->useWide)
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode");
+ else
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
+
return infoPtr->channel;
}
@@ -1464,10 +1431,9 @@ ConsoleThreadActionProc(
ClientData instanceData,
int action)
{
- ConsoleInfo *infoPtr = instanceData;
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
- /*
- * We do not access firstConsolePtr in the thread structures. This is not
+ /* We do not access firstConsolePtr in the thread structures. This is not
* for all serials managed by the thread, but only those we are watching.
* Removal of the filevent handlers before transfer thus takes care of
* this structure.
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index ce0b413..eef5caa 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -10,29 +10,11 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#undef STATIC_BUILD
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
#include "tclInt.h"
+#include "tclPort.h"
#include <dde.h>
#include <ddeml.h>
-#ifndef UNICODE
-# undef CP_WINUNICODE
-# define CP_WINUNICODE CP_WINANSI
-# undef Tcl_WinTCharToUtf
-# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
-# undef Tcl_WinUtfToTChar
-# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
-#endif
-
-#if !defined(NDEBUG)
- /* test POKE server Implemented for debug mode only */
-# undef CBF_FAIL_POKES
-# define CBF_FAIL_POKES 0
-#endif
-
/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init
* declaration is in the source file itself, which is only accessed when we
@@ -52,7 +34,7 @@ typedef struct RegisteredInterp {
struct RegisteredInterp *nextPtr;
/* The next interp this application knows
* about. */
- TCHAR *name; /* Interpreter's name (malloc-ed). */
+ char *name; /* Interpreter's name (malloc-ed). */
Tcl_Obj *handlerPtr; /* The server handler command */
Tcl_Interp *interp; /* The interpreter attached to this name. */
} RegisteredInterp;
@@ -97,10 +79,9 @@ static DWORD ddeInstance; /* The application instance handle given to us
* by DdeInitialize. */
static int ddeIsServer = 0;
-#define TCL_DDE_VERSION "1.4.0"
#define TCL_DDE_PACKAGE_NAME "dde"
-#define TCL_DDE_SERVICE_NAME TEXT("TclEval")
-#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT")
+#define TCL_DDE_SERVICE_NAME "TclEval"
+#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT"
#define DDE_FLAG_ASYNC 1
#define DDE_FLAG_BINARY 2
@@ -119,7 +100,7 @@ static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget,
LPARAM lParam);
static void DdeExitProc(ClientData clientData);
static int DdeGetServicesList(Tcl_Interp *interp,
- const TCHAR *serviceName, const TCHAR *topicName);
+ const char *serviceName, const char *topicName);
static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv,
HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData,
DWORD dwData1, DWORD dwData2);
@@ -129,7 +110,7 @@ static void DeleteProc(ClientData clientData);
static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr,
Tcl_Obj *ddeObjectPtr);
static int MakeDdeConnection(Tcl_Interp *interp,
- const TCHAR *name, HCONV *ddeConvPtr);
+ const char *name, HCONV *ddeConvPtr);
static void SetDdeError(Tcl_Interp *interp);
static int DdeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -162,16 +143,9 @@ Dde_Init(
return TCL_ERROR;
}
-#ifdef UNICODE
- if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "Win32s and Windows 9x are not supported platforms", -1));
- return TCL_ERROR;
- }
-#endif
Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
Tcl_CreateExitHandler(DdeExitProc, NULL);
- return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
+ return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, "1.3.3");
}
/*
@@ -255,7 +229,7 @@ Initialize(void)
ddeIsServer = 1;
Tcl_CreateExitHandler(DdeExitProc, NULL);
ddeServiceGlobal = DdeCreateStringHandle(ddeInstance,
- TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
+ TCL_DDE_SERVICE_NAME, 0);
DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
} else {
ddeIsServer = 0;
@@ -289,10 +263,10 @@ Initialize(void)
*----------------------------------------------------------------------
*/
-static const TCHAR *
+static const char *
DdeSetServerName(
Tcl_Interp *interp,
- const TCHAR *name, /* The name that will be used to refer to the
+ const char *name, /* The name that will be used to refer to the
* interpreter in later "send" commands. Must
* be globally unique. */
int flags, /* DDE_FLAG_FORCE or 0 */
@@ -302,7 +276,7 @@ DdeSetServerName(
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
- const TCHAR *actualName;
+ const char *actualName;
Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL;
int n, srvCount = 0, lastSuffix, r = TCL_OK;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -340,7 +314,7 @@ DdeSetServerName(
* current interp, but it doesn't have a name.
*/
- return TEXT("");
+ return "";
}
/*
@@ -361,9 +335,7 @@ DdeSetServerName(
&srvPtrPtr);
}
if (r != TCL_OK) {
- Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString);
- OutputDebugString((TCHAR *) Tcl_DStringValue(&dString));
- Tcl_DStringFree(&dString);
+ OutputDebugString(Tcl_GetStringResult(interp));
return NULL;
}
@@ -380,14 +352,13 @@ DdeSetServerName(
lastSuffix = suffix;
if (suffix > 1) {
if (suffix == 2) {
- Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR));
- Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR));
+ Tcl_DStringAppend(&dString, name, -1);
+ Tcl_DStringAppend(&dString, " #", 2);
offset = Tcl_DStringLength(&dString);
- Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE);
- actualName = (TCHAR *) Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE);
+ actualName = Tcl_DStringValue(&dString);
}
- _sntprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset),
- TCL_INTEGER_SPACE, TEXT("%d"), suffix);
+ sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix);
}
/*
@@ -396,41 +367,39 @@ DdeSetServerName(
for (n = 0; n < srvCount; ++n) {
Tcl_Obj* namePtr;
- Tcl_DString ds;
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
- Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds);
- if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) {
+ if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) {
suffix++;
- Tcl_DStringFree(&ds);
break;
}
- Tcl_DStringFree(&ds);
}
}
+ Tcl_DStringSetLength(&dString,
+ offset + (int)strlen(Tcl_DStringValue(&dString)+offset));
}
/*
* We have found a unique name. Now add it to the registry.
*/
- riPtr = ckalloc(sizeof(RegisteredInterp));
+ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
- riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
+ riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1);
riPtr->nextPtr = tsdPtr->interpListPtr;
riPtr->handlerPtr = handlerPtr;
if (riPtr->handlerPtr != NULL) {
Tcl_IncrRefCount(riPtr->handlerPtr);
}
tsdPtr->interpListPtr = riPtr;
- _tcscpy(riPtr->name, actualName);
+ strcpy(riPtr->name, actualName);
if (Tcl_IsSafe(interp)) {
Tcl_ExposeCommand(interp, "dde", "dde");
}
Tcl_CreateObjCommand(interp, "dde", DdeObjCmd,
- riPtr, DeleteProc);
+ (ClientData) riPtr, DeleteProc);
if (Tcl_IsSafe(interp)) {
Tcl_HideCommand(interp, "dde", "dde");
}
@@ -559,7 +528,6 @@ ExecuteRemoteObject(
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
"a handler procedure must be defined for use in a safe "
"interp", -1));
- Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL);
result = TCL_ERROR;
}
@@ -639,7 +607,7 @@ DdeServerProc(
Tcl_DString dString;
int len;
DWORD dlen;
- TCHAR *utilString;
+ char *utilString;
Tcl_Obj *ddeObjectPtr;
HDDEDATA ddeReturn = NULL;
RegisteredInterp *riPtr;
@@ -653,16 +621,16 @@ DdeServerProc(
* sure we have a valid topic.
*/
- len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE);
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
- utilString = (TCHAR *) Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINUNICODE);
+ CP_WINANSI);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (_tcsicmp(utilString, riPtr->name) == 0) {
+ if (stricmp(utilString, riPtr->name) == 0) {
Tcl_DStringFree(&dString);
return (HDDEDATA) TRUE;
}
@@ -678,16 +646,16 @@ DdeServerProc(
* result to return in an XTYP_REQUEST.
*/
- len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE);
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
- utilString = (TCHAR *) Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINUNICODE);
+ CP_WINANSI);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (_tcsicmp(riPtr->name, utilString) == 0) {
- convPtr = ckalloc(sizeof(Conversation));
+ if (stricmp(riPtr->name, utilString) == 0) {
+ convPtr = (Conversation *) ckalloc(sizeof(Conversation));
convPtr->nextPtr = tsdPtr->currentConversations;
convPtr->returnPackagePtr = NULL;
convPtr->hConv = hConv;
@@ -717,7 +685,7 @@ DdeServerProc(
if (convPtr->returnPackagePtr != NULL) {
Tcl_DecrRefCount(convPtr->returnPackagePtr);
}
- ckfree(convPtr);
+ ckfree((char *) convPtr);
break;
}
}
@@ -745,20 +713,20 @@ DdeServerProc(
if (convPtr != NULL) {
char *returnString;
- len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
+ len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
- utilString = (TCHAR *) Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
- CP_WINUNICODE);
- if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
+ CP_WINANSI);
+ if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
if (uFmt == CF_TEXT) {
returnString =
Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
} else {
returnString = (char *)
Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
- len = sizeof(TCHAR) * len + 1;
+ len = 2 * len + 1;
}
ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
(DWORD) len+1, 0, ddeItem, uFmt, 0);
@@ -766,11 +734,8 @@ DdeServerProc(
if (Tcl_IsSafe(convPtr->riPtr->interp)) {
ddeReturn = NULL;
} else {
- Tcl_DString ds;
- Tcl_Obj *variableObjPtr;
- Tcl_WinTCharToUtf(utilString, -1, &ds);
- variableObjPtr = Tcl_GetVar2Ex(
- convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
+ Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
+ convPtr->riPtr->interp, utilString, NULL,
TCL_GLOBAL_ONLY);
if (variableObjPtr != NULL) {
if (uFmt == CF_TEXT) {
@@ -779,7 +744,7 @@ DdeServerProc(
} else {
returnString = (char *) Tcl_GetUnicodeFromObj(
variableObjPtr, &len);
- len = sizeof(TCHAR) * len + 1;
+ len = 2 * len + 1;
}
ddeReturn = DdeCreateDataHandle(ddeInstance,
(BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
@@ -787,60 +752,12 @@ DdeServerProc(
} else {
ddeReturn = NULL;
}
- Tcl_DStringFree(&ds);
}
}
Tcl_DStringFree(&dString);
}
return ddeReturn;
-#if !CBF_FAIL_POKES
- case XTYP_POKE:
- /*
- * This is a poke for a Tcl variable, only implemented in
- * debug/UNICODE mode.
- */
- ddeReturn = DDE_FNOTPROCESSED;
-
- if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) {
- return ddeReturn;
- }
-
- for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
- && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
- /*
- * Empty loop body.
- */
- }
-
- if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) {
- Tcl_DString ds;
- Tcl_Obj *variableObjPtr;
-
- len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
- Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
- utilString = (TCHAR *) Tcl_DStringValue(&dString);
- DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
- CP_WINUNICODE);
- Tcl_WinTCharToUtf(utilString, -1, &ds);
- utilString = (TCHAR *) DdeAccessData(hData, &dlen);
- if (uFmt == CF_TEXT) {
- variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
- } else {
- variableObjPtr = Tcl_NewUnicodeObj(utilString, -1);
- }
-
- Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
- variableObjPtr, TCL_GLOBAL_ONLY);
-
- Tcl_DStringFree(&ds);
- Tcl_DStringFree(&dString);
- ddeReturn = (HDDEDATA) DDE_FACK;
- }
- return ddeReturn;
-
-#endif
case XTYP_EXECUTE: {
/*
* Execute this script. The results will be saved into a list object
@@ -848,7 +765,7 @@ DdeServerProc(
*/
Tcl_Obj *returnPackagePtr;
- char *string;
+ Tcl_UniChar *uniStr;
for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
@@ -861,21 +778,21 @@ DdeServerProc(
return (HDDEDATA) DDE_FNOTPROCESSED;
}
- utilString = (TCHAR *) DdeAccessData(hData, &dlen);
- string = (char *) utilString;
+ utilString = (char *) DdeAccessData(hData, &dlen);
+ uniStr = (Tcl_UniChar *) utilString;
if (!dlen) {
/* Empty binary array. */
ddeObjectPtr = Tcl_NewObj();
- } else if ((dlen & 1) || utilString[(dlen>>1)-1]) {
+ } else if ((dlen & 1) || uniStr[(dlen>>1)-1]) {
/* Cannot be unicode, so assume utf-8 */
- if (!string[dlen-1]) {
+ if (!utilString[dlen-1]) {
dlen--;
}
- ddeObjectPtr = Tcl_NewStringObj(string, dlen);
+ ddeObjectPtr = Tcl_NewStringObj(utilString, dlen);
} else {
/* unicode */
dlen >>= 1;
- ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1);
+ ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen - 1);
}
Tcl_IncrRefCount(ddeObjectPtr);
DdeUnaccessData(hData);
@@ -928,9 +845,9 @@ DdeServerProc(
for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
i++, riPtr = riPtr->nextPtr) {
returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance,
- TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
+ TCL_DDE_SERVICE_NAME, CP_WINANSI);
returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance,
- riPtr->name, CP_WINUNICODE);
+ riPtr->name, CP_WINANSI);
}
returnPtr[i].hszSvc = NULL;
returnPtr[i].hszTopic = NULL;
@@ -988,14 +905,14 @@ DdeExitProc(
static int
MakeDdeConnection(
Tcl_Interp *interp, /* Used to report errors. */
- const TCHAR *name, /* The connection to use. */
+ const char *name, /* The connection to use. */
HCONV *ddeConvPtr)
{
HSZ ddeTopic, ddeService;
HCONV ddeConv;
- ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
- ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE);
+ ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0);
+ ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
@@ -1003,13 +920,8 @@ MakeDdeConnection(
if (ddeConv == (HCONV) NULL) {
if (interp != NULL) {
- Tcl_DString dString;
-
- Tcl_WinTCharToUtf(name, -1, &dString);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "no registered server named \"%s\"", Tcl_DStringValue(&dString)));
- Tcl_DStringFree(&dString);
- Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
+ Tcl_AppendResult(interp, "no registered server named \"",
+ name, "\"", NULL);
}
return TCL_ERROR;
}
@@ -1043,8 +955,8 @@ DdeCreateClient(
struct DdeEnumServices *es)
{
WNDCLASSEX wc;
- static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
- static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window");
+ static const char *szDdeClientClassName = "TclEval client class";
+ static const char *szDdeClientWindowName = "TclEval client window";
memset(&wc, 0, sizeof(wc));
wc.cbSize = sizeof(wc);
@@ -1099,8 +1011,7 @@ DdeServicesOnAck(
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
struct DdeEnumServices *es;
- TCHAR sz[255];
- Tcl_DString dString;
+ char sz[255];
#ifdef _WIN64
es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
@@ -1114,13 +1025,9 @@ DdeServicesOnAck(
Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
GlobalGetAtomName(service, sz, 255);
- Tcl_WinTCharToUtf(sz, -1, &dString);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
- Tcl_DStringFree(&dString);
+ Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
GlobalGetAtomName(topic, sz, 255);
- Tcl_WinTCharToUtf(sz, -1, &dString);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
- Tcl_DStringFree(&dString);
+ Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
/*
* Adding the hwnd as a third list element provides a unique
@@ -1167,8 +1074,8 @@ DdeEnumWindowsCallback(
static int
DdeGetServicesList(
Tcl_Interp *interp,
- const TCHAR *serviceName,
- const TCHAR *topicName)
+ const char *serviceName,
+ const char *topicName)
{
struct DdeEnumServices es;
@@ -1215,30 +1122,25 @@ static void
SetDdeError(
Tcl_Interp *interp) /* The interp to put the message in. */
{
- const char *errorMessage, *errorCode;
+ const char *errorMessage;
switch (DdeGetLastError(ddeInstance)) {
case DMLERR_DATAACKTIMEOUT:
case DMLERR_EXECACKTIMEOUT:
case DMLERR_POKEACKTIMEOUT:
errorMessage = "remote interpreter did not respond";
- errorCode = "TIMEOUT";
break;
case DMLERR_BUSY:
errorMessage = "remote server is busy";
- errorCode = "BUSY";
break;
case DMLERR_NOTPROCESSED:
errorMessage = "remote server cannot handle this command";
- errorCode = "NOCANDO";
break;
default:
errorMessage = "dde command failed";
- errorCode = "FAILED";
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL);
}
/*
@@ -1265,29 +1167,23 @@ DdeObjCmd(
int objc, /* Number of arguments */
Tcl_Obj *const *objv) /* The arguments */
{
- static const char *const ddeCommands[] = {
+ static const char *ddeCommands[] = {
"servername", "execute", "poke", "request", "services", "eval",
(char *) NULL};
enum DdeSubcommands {
DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES,
DDE_EVAL
};
- static const char *const ddeSrvOptions[] = {
+ static const char *ddeSrvOptions[] = {
"-force", "-handler", "--", NULL
};
enum DdeSrvOptions {
DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
};
- static const char *const ddeExecOptions[] = {
- "-async", "-binary", NULL
- };
- enum DdeExecOptions {
- DDE_EXEC_ASYNC, DDE_EXEC_BINARY
- };
- static const char *const ddeEvalOptions[] = {
+ static const char *ddeExecOptions[] = {
"-async", NULL
};
- static const char *const ddeReqOptions[] = {
+ static const char *ddeReqOptions[] = {
"-binary", NULL
};
@@ -1296,8 +1192,7 @@ DdeObjCmd(
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
HCONV hConv = NULL;
- const TCHAR *serviceName = NULL, *topicName = NULL;
- const char *string;
+ const char *serviceName = NULL, *topicName = NULL, *string;
DWORD ddeResult;
Tcl_Obj *objPtr, *handlerPtr = NULL;
@@ -1364,53 +1259,38 @@ DdeObjCmd(
if (objc == 5) {
firstArg = 2;
break;
- } else if (objc >= 6 && objc <= 7) {
- firstArg = objc - 3;
- for (i = 2; i < firstArg; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
- "option", 0, &argIndex) != TCL_OK) {
- goto wrongDdeExecuteArgs;
- }
- if (argIndex == DDE_EXEC_ASYNC) {
- flags |= DDE_FLAG_ASYNC;
- } else {
- flags |= DDE_FLAG_BINARY;
- }
+ } else if (objc == 6) {
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0,
+ &argIndex) == TCL_OK) {
+ flags |= DDE_FLAG_ASYNC;
+ firstArg = 3;
+ break;
}
- break;
}
/* otherwise... */
- wrongDdeExecuteArgs:
Tcl_WrongNumArgs(interp, 2, objv,
- "?-async? ?-binary? serviceName topicName value");
+ "?-async? serviceName topicName value");
return TCL_ERROR;
case DDE_POKE:
- if (objc == 6) {
- firstArg = 2;
- break;
- } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2],
- ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
- flags |= DDE_FLAG_BINARY;
- firstArg = 3;
- break;
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "serviceName topicName item value");
+ return TCL_ERROR;
}
-
- /*
- * Otherwise...
- */
-
- Tcl_WrongNumArgs(interp, 2, objv,
- "?-binary? serviceName topicName item value");
- return TCL_ERROR;
+ firstArg = 2;
+ break;
case DDE_REQUEST:
if (objc == 5) {
firstArg = 2;
break;
- } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2],
- ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
- flags |= DDE_FLAG_BINARY;
- firstArg = 3;
- break;
+ } else if (objc == 6) {
+ int dummy;
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
+ &dummy) == TCL_OK) {
+ flags |= DDE_FLAG_BINARY;
+ firstArg = 3;
+ break;
+ }
}
/*
@@ -1434,7 +1314,7 @@ DdeObjCmd(
return TCL_ERROR;
} else {
firstArg = 2;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option",
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option",
0, &argIndex) == TCL_OK) {
if (objc < 5) {
goto wrongDdeEvalArgs;
@@ -1449,11 +1329,7 @@ DdeObjCmd(
Initialize();
if (firstArg != 1) {
-#ifdef UNICODE
- serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length);
-#else
serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
-#endif
} else {
length = 0;
}
@@ -1462,20 +1338,16 @@ DdeObjCmd(
serviceName = NULL;
} else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName,
- CP_WINUNICODE);
+ CP_WINANSI);
}
if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
-#ifdef UNICODE
- topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length);
-#else
topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
-#endif
if (length == 0) {
topicName = NULL;
} else {
ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName,
- CP_WINUNICODE);
+ CP_WINANSI);
}
}
@@ -1484,11 +1356,7 @@ DdeObjCmd(
serviceName = DdeSetServerName(interp, serviceName, flags,
handlerPtr);
if (serviceName != NULL) {
-#ifdef UNICODE
- Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1));
-#else
Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
-#endif
} else {
Tcl_ResetResult(interp);
}
@@ -1496,21 +1364,12 @@ DdeObjCmd(
case DDE_EXECUTE: {
int dataLength;
- const Tcl_UniChar *dataString;
+ BYTE *dataString = (BYTE *) Tcl_GetStringFromObj(
+ objv[firstArg + 2], &dataLength);
- if (flags & DDE_FLAG_BINARY) {
- dataString = (const Tcl_UniChar *)
- Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
- } else {
- dataString =
- Tcl_GetUnicodeFromObj(objv[firstArg + 2], &dataLength);
- dataLength = (dataLength + 1) * sizeof(Tcl_UniChar);
- }
-
- if (dataLength <= 0) {
+ if (dataLength == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot execute null data", -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
break;
}
@@ -1524,16 +1383,16 @@ DdeObjCmd(
break;
}
- ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString,
- (DWORD) dataLength, 0, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, 0);
+ ddeData = DdeCreateDataHandle(ddeInstance, dataString,
+ (DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
if (ddeData != NULL) {
if (flags & DDE_FLAG_ASYNC) {
DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
- (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+ CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
} else {
ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
- hConv, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL);
+ hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeReturn == 0) {
SetDdeError(interp);
result = TCL_ERROR;
@@ -1547,18 +1406,12 @@ DdeObjCmd(
break;
}
case DDE_REQUEST: {
-#ifdef UNICODE
- const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
- &length);
-#else
- const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
+ const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
&length);
-#endif
if (length == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot request value of null data", -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
goto cleanup;
}
@@ -1571,27 +1424,26 @@ DdeObjCmd(
result = TCL_ERROR;
} else {
Tcl_Obj *returnObjPtr;
- ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
- CP_WINUNICODE);
+ ddeItem = DdeCreateStringHandle(ddeInstance, (void *)itemString,
+ CP_WINANSI);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
- (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL);
+ CF_TEXT, XTYP_REQUEST, 5000, NULL);
if (ddeData == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
} else {
DWORD tmp;
- const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp);
+ const char *dataString = (const char *) DdeAccessData(ddeData, &tmp);
if (flags & DDE_FLAG_BINARY) {
returnObjPtr =
Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
} else {
- tmp >>= 1;
- if (tmp && !dataString[(tmp-1)]) {
+ if (tmp && !dataString[tmp-1]) {
--tmp;
}
- returnObjPtr = Tcl_NewUnicodeObj(dataString,
+ returnObjPtr = Tcl_NewStringObj(dataString,
(int) tmp);
}
DdeUnaccessData(ddeData);
@@ -1607,30 +1459,18 @@ DdeObjCmd(
break;
}
case DDE_POKE: {
-#ifdef UNICODE
- const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
- &length);
-#else
- const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
+ const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
&length);
-#endif
BYTE *dataString;
if (length == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot have a null item", -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
goto cleanup;
}
- if (flags & DDE_FLAG_BINARY) {
- dataString = (BYTE *)
- Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
- } else {
- dataString = (BYTE *)
- Tcl_GetUnicodeFromObj(objv[firstArg + 3], &length);
- length = 2 * length + 1;
- }
+ dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3],
+ &length);
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
@@ -1641,10 +1481,10 @@ DdeObjCmd(
result = TCL_ERROR;
} else {
ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
- CP_WINUNICODE);
+ CP_WINANSI);
if (ddeItem != NULL) {
- ddeData = DdeClientTransaction(dataString, (DWORD) length,
- hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL);
+ ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
+ hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
if (ddeData == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
@@ -1668,7 +1508,6 @@ DdeObjCmd(
if (serviceName == NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("invalid service name \"\"", -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
result = TCL_ERROR;
goto cleanup;
}
@@ -1687,7 +1526,7 @@ DdeObjCmd(
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (_tcsicmp(serviceName, riPtr->name) == 0) {
+ if (stricmp(serviceName, riPtr->name) == 0) {
break;
}
}
@@ -1700,9 +1539,9 @@ DdeObjCmd(
* server.
*/
- Tcl_Preserve(riPtr);
+ Tcl_Preserve((ClientData) riPtr);
sendInterp = riPtr->interp;
- Tcl_Preserve(sendInterp);
+ Tcl_Preserve((ClientData) sendInterp);
/*
* Don't exchange objects between interps. The target interp would
@@ -1713,11 +1552,9 @@ DdeObjCmd(
*/
if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) {
- Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
- "permission denied: a handler procedure must be"
- " defined for use in a safe interp", -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
- NULL);
+ Tcl_SetResult(riPtr->interp, "permission denied: "
+ "a handler procedure must be defined for use in "
+ "a safe interp", TCL_STATIC);
result = TCL_ERROR;
}
@@ -1769,8 +1606,8 @@ DdeObjCmd(
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
}
- Tcl_Release(riPtr);
- Tcl_Release(sendInterp);
+ Tcl_Release((ClientData) riPtr);
+ Tcl_Release((ClientData) sendInterp);
} else {
/*
* This is a non-local request. Send the script to the server and
@@ -1780,31 +1617,31 @@ DdeObjCmd(
if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
invalidServerResponse:
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("invalid data returned from server", -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
+ Tcl_NewStringObj("invalid data returned from server",
+ -1));
result = TCL_ERROR;
goto cleanup;
}
objPtr = Tcl_ConcatObj(objc, objv);
- string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(objPtr, &length);
ddeItemData = DdeCreateDataHandle(ddeInstance,
- (BYTE *) string, (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0);
+ (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
if (flags & DDE_FLAG_ASYNC) {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
0xFFFFFFFF, hConv, 0,
- CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+ CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
} else {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
0xFFFFFFFF, hConv, 0,
- CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL);
+ CF_TEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeData != 0) {
ddeCookie = DdeCreateStringHandle(ddeInstance,
- TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE);
+ TCL_DDE_EXECUTE_RESULT, CP_WINANSI);
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
- CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL);
+ CF_TEXT, XTYP_REQUEST, 30000, NULL);
}
}
@@ -1813,12 +1650,10 @@ DdeObjCmd(
if (ddeData == 0) {
SetDdeError(interp);
result = TCL_ERROR;
- goto cleanup;
}
if (!(flags & DDE_FLAG_ASYNC)) {
Tcl_Obj *resultPtr;
- Tcl_UniChar *ddeDataString;
/*
* The return handle has a two or four element list in it. The
@@ -1831,11 +1666,10 @@ DdeObjCmd(
resultPtr = Tcl_NewObj();
length = DdeGetData(ddeData, NULL, 0, 0);
- ddeDataString = ckalloc(length);
- DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
- length = (length >> 1) - 1;
- resultPtr = Tcl_NewUnicodeObj(ddeDataString, length);
- ckfree(ddeDataString);
+ Tcl_SetObjLength(resultPtr, length);
+ string = Tcl_GetString(resultPtr);
+ DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0);
+ Tcl_SetObjLength(resultPtr, (int) strlen(string));
if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
diff --git a/win/tclWinError.c b/win/tclWinError.c
index 30079b9..a74d2e2 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -11,11 +11,13 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
+
/*
* The following table contains the mapping from Win32 errors to errno errors.
*/
-static const unsigned char errorTable[] = {
+static CONST unsigned char errorTable[] = {
0,
EINVAL, /* ERROR_INVALID_FUNCTION 1 */
ENOENT, /* ERROR_FILE_NOT_FOUND 2 */
@@ -291,7 +293,7 @@ static const unsigned char errorTable[] = {
* errno errors.
*/
-static const unsigned char wsaErrorTable[] = {
+static CONST int wsaErrorTable[] = {
EWOULDBLOCK, /* WSAEWOULDBLOCK */
EINPROGRESS, /* WSAEINPROGRESS */
EALREADY, /* WSAEALREADY */
@@ -362,62 +364,39 @@ TclWinConvertError(
Tcl_SetErrno(errorTable[errCode]);
}
}
-
-#ifdef __CYGWIN__
+
/*
*----------------------------------------------------------------------
*
- * tclWinDebugPanic --
+ * TclWinConvertWSAError --
*
- * Display a message. If a debugger is present, present it directly to
- * the debugger, otherwise send it to stderr.
+ * This routine converts a WinSock error into an errno value.
*
* Results:
* None.
*
* Side effects:
- * None.
+ * Sets the errno global variable.
*
*----------------------------------------------------------------------
*/
-TCL_NORETURN void
-tclWinDebugPanic(
- const char *format, ...)
+void
+TclWinConvertWSAError(
+ DWORD errCode) /* Win32 error code. */
{
-#define TCL_MAX_WARN_LEN 1024
- va_list argList;
- va_start(argList, format);
-
- if (IsDebuggerPresent()) {
- WCHAR msgString[TCL_MAX_WARN_LEN];
- char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
-
- vsnprintf(buf, sizeof(buf), format, argList);
- msgString[TCL_MAX_WARN_LEN-1] = L'\0';
- MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN);
-
- /*
- * Truncate MessageBox string if it is too long to not overflow the buffer.
- */
-
- if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
- memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
+ if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
+ errCode -= WSAEWOULDBLOCK;
+ if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
+ Tcl_SetErrno(errorTable[1]);
+ } else {
+ Tcl_SetErrno(wsaErrorTable[errCode]);
}
- OutputDebugStringW(msgString);
} else {
- vfprintf(stderr, format, argList);
- fprintf(stderr, "\n");
- fflush(stderr);
+ Tcl_SetErrno(errorTable[errCode]);
}
-# if defined(__GNUC__)
- __builtin_trap();
-# else
- DebugBreak();
-# endif
- abort();
}
-#endif
+
/*
* Local Variables:
* mode: c
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 52ea8c6..441337e 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -54,12 +54,12 @@ static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDD
0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
-const char *const tclpFileAttrStrings[] = {
+CONST char *tclpFileAttrStrings[] = {
"-archive", "-hidden", "-longname", "-readonly",
"-shortname", "-system", (char *) NULL
};
-const TclFileAttrProcs tclpFileAttrProcs[] = {
+CONST TclFileAttrProcs tclpFileAttrProcs[] = {
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileLongName, CannotSetAttribute},
@@ -71,7 +71,7 @@ const TclFileAttrProcs tclpFileAttrProcs[] = {
* Prototype for the TraverseWinTree callback function.
*/
-typedef int (TraversalProc)(const TCHAR *srcPtr, const TCHAR *dstPtr,
+typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
/*
@@ -82,18 +82,18 @@ static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName);
static int ConvertFileNameFormat(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName, int longShort,
Tcl_Obj **attributePtrPtr);
-static int DoCopyFile(const TCHAR *srcPtr, const TCHAR *dstPtr);
-static int DoCreateDirectory(const TCHAR *pathPtr);
-static int DoRemoveJustDirectory(const TCHAR *nativeSrc,
+static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr);
+static int DoCreateDirectory(CONST TCHAR *pathPtr);
+static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc,
int ignoreError, Tcl_DString *errorPtr);
static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
Tcl_DString *errorPtr);
-static int DoRenameFile(const TCHAR *nativeSrc,
- const TCHAR *dstPtr);
-static int TraversalCopy(const TCHAR *srcPtr, const TCHAR *dstPtr,
+static int DoRenameFile(CONST TCHAR *nativeSrc,
+ CONST TCHAR *dstPtr);
+static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
-static int TraversalDelete(const TCHAR *srcPtr,
- const TCHAR *dstPtr, int type,
+static int TraversalDelete(CONST TCHAR *srcPtr,
+ CONST TCHAR *dstPtr, int type,
Tcl_DString *errorPtr);
static int TraverseWinTree(TraversalProc *traverseProc,
Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
@@ -151,9 +151,9 @@ TclpObjRenameFile(
static int
DoRenameFile(
- const TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
+ CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
* (native). */
- const TCHAR *nativeDst) /* New pathname for file or directory
+ CONST TCHAR *nativeDst) /* New pathname for file or directory
* (native). */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
@@ -256,7 +256,7 @@ DoRenameFile(
[registration] "m" (registration),
[nativeDst] "m" (nativeDst),
[nativeSrc] "m" (nativeSrc),
- [moveFile] "r" (MoveFile)
+ [moveFile] "r" (tclWinProcs->moveFileProc)
:
"%eax", "%ebx", "%ecx", "%edx", "memory"
);
@@ -267,7 +267,7 @@ DoRenameFile(
#ifndef HAVE_NO_SEH
__try {
#endif
- if ((*MoveFile)(nativeSrc, nativeDst) != FALSE) {
+ if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
retval = TCL_OK;
}
#ifndef HAVE_NO_SEH
@@ -281,10 +281,10 @@ DoRenameFile(
TclWinConvertError(GetLastError());
- srcAttr = GetFileAttributes(nativeSrc);
- dstAttr = GetFileAttributes(nativeDst);
+ srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
+ dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
if (srcAttr == 0xffffffff) {
- if (GetFullPathName(nativeSrc, 0, NULL,
+ if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL,
NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
@@ -292,7 +292,7 @@ DoRenameFile(
srcAttr = 0;
}
if (dstAttr == 0xffffffff) {
- if (GetFullPathName(nativeDst, 0, NULL,
+ if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL,
NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
@@ -308,28 +308,28 @@ DoRenameFile(
decode:
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
TCHAR *nativeSrcRest, *nativeDstRest;
- const char **srcArgv, **dstArgv;
+ CONST char **srcArgv, **dstArgv;
int size, srcArgc, dstArgc;
- TCHAR nativeSrcPath[MAX_PATH];
- TCHAR nativeDstPath[MAX_PATH];
+ WCHAR nativeSrcPath[MAX_PATH];
+ WCHAR nativeDstPath[MAX_PATH];
Tcl_DString srcString, dstString;
- const char *src, *dst;
+ CONST char *src, *dst;
- size = GetFullPathName(nativeSrc, MAX_PATH,
+ size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
nativeSrcPath, &nativeSrcRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- size = GetFullPathName(nativeDst, MAX_PATH,
+ size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
nativeDstPath, &nativeDstRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- CharLower(nativeSrcPath);
- CharLower(nativeDstPath);
+ (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
+ (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);
- src = Tcl_WinTCharToUtf(nativeSrcPath, -1, &srcString);
- dst = Tcl_WinTCharToUtf(nativeDstPath, -1, &dstString);
+ src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
+ dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
/*
* Check whether the destination path is actually inside the
@@ -376,8 +376,8 @@ DoRenameFile(
Tcl_SetErrno(EXDEV);
}
- ckfree(srcArgv);
- ckfree(dstArgv);
+ ckfree((char *) srcArgv);
+ ckfree((char *) dstArgv);
}
/*
@@ -408,7 +408,7 @@ DoRenameFile(
* directory back, for completeness.
*/
- if (MoveFile(nativeSrc,
+ if ((*tclWinProcs->moveFileProc)(nativeSrc,
nativeDst) != FALSE) {
return TCL_OK;
}
@@ -419,8 +419,8 @@ DoRenameFile(
*/
TclWinConvertError(GetLastError());
- CreateDirectory(nativeDst, NULL);
- SetFileAttributes(nativeDst, dstAttr);
+ (*tclWinProcs->createDirectoryProc)(nativeDst, NULL);
+ (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
@@ -447,20 +447,22 @@ DoRenameFile(
TCHAR *nativeRest, *nativeTmp, *nativePrefix;
int result, size;
- TCHAR tempBuf[MAX_PATH];
+ WCHAR tempBuf[MAX_PATH];
- size = GetFullPathName(nativeDst, MAX_PATH,
+ size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
tempBuf, &nativeRest);
if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
return TCL_ERROR;
}
nativeTmp = (TCHAR *) tempBuf;
- nativeRest[0] = L'\0';
+ ((char *) nativeRest)[0] = '\0';
+ ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */
result = TCL_ERROR;
- nativePrefix = (TCHAR *) L"tclr";
- if (GetTempFileName(nativeTmp, nativePrefix,
- 0, tempBuf) != 0) {
+ nativePrefix = (tclWinProcs->useWide)
+ ? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
+ if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
+ nativePrefix, 0, tempBuf) != 0) {
/*
* Strictly speaking, need the following DeleteFile and
* MoveFile to be joined as an atomic operation so no
@@ -468,16 +470,19 @@ DoRenameFile(
* same temp file.
*/
- nativeTmp = tempBuf;
- DeleteFile(nativeTmp);
- if (MoveFile(nativeDst, nativeTmp) != FALSE) {
- if (MoveFile(nativeSrc, nativeDst) != FALSE) {
- SetFileAttributes(nativeTmp, FILE_ATTRIBUTE_NORMAL);
- DeleteFile(nativeTmp);
+ nativeTmp = (TCHAR *) tempBuf;
+ (*tclWinProcs->deleteFileProc)(nativeTmp);
+ if ((*tclWinProcs->moveFileProc)(nativeDst,
+ nativeTmp) != FALSE) {
+ if ((*tclWinProcs->moveFileProc)(nativeSrc,
+ nativeDst) != FALSE) {
+ (*tclWinProcs->setFileAttributesProc)(nativeTmp,
+ FILE_ATTRIBUTE_NORMAL);
+ (*tclWinProcs->deleteFileProc)(nativeTmp);
return TCL_OK;
} else {
- DeleteFile(nativeDst);
- MoveFile(nativeTmp, nativeDst);
+ (*tclWinProcs->deleteFileProc)(nativeDst);
+ (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);
}
}
@@ -540,8 +545,8 @@ TclpObjCopyFile(
static int
DoCopyFile(
- const TCHAR *nativeSrc, /* Pathname of file to be copied (native). */
- const TCHAR *nativeDst) /* Pathname of file to copy to (native). */
+ CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */
+ CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
TCLEXCEPTION_REGISTRATION registration;
@@ -644,7 +649,7 @@ DoCopyFile(
[registration] "m" (registration),
[nativeDst] "m" (nativeDst),
[nativeSrc] "m" (nativeSrc),
- [copyFile] "r" (CopyFile)
+ [copyFile] "r" (tclWinProcs->copyFileProc)
:
"%eax", "%ebx", "%ecx", "%edx", "memory"
);
@@ -655,7 +660,7 @@ DoCopyFile(
#ifndef HAVE_NO_SEH
__try {
#endif
- if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) {
+ if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
retval = TCL_OK;
}
#ifndef HAVE_NO_SEH
@@ -675,8 +680,8 @@ DoCopyFile(
if (Tcl_GetErrno() == EACCES) {
DWORD srcAttr, dstAttr;
- srcAttr = GetFileAttributes(nativeSrc);
- dstAttr = GetFileAttributes(nativeDst);
+ srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
+ dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
if (srcAttr != 0xffffffff) {
if (dstAttr == 0xffffffff) {
dstAttr = 0;
@@ -692,9 +697,9 @@ DoCopyFile(
Tcl_SetErrno(EISDIR);
}
if (dstAttr & FILE_ATTRIBUTE_READONLY) {
- SetFileAttributes(nativeDst,
+ (*tclWinProcs->setFileAttributesProc)(nativeDst,
dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
- if (CopyFile(nativeSrc, nativeDst,
+ if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst,
0) != FALSE) {
return TCL_OK;
}
@@ -705,7 +710,7 @@ DoCopyFile(
*/
TclWinConvertError(GetLastError());
- SetFileAttributes(nativeDst, dstAttr);
+ (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
}
}
}
@@ -746,35 +751,34 @@ TclpObjDeleteFile(
int
TclpDeleteFile(
- const void *nativePath) /* Pathname of file to be removed (native). */
+ CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */
{
DWORD attr;
- const TCHAR *path = nativePath;
/*
* The DeleteFile API acts differently under Win95/98 and NT WRT NULL and
* "". Avoid passing these values.
*/
- if (path == NULL || path[0] == '\0') {
+ if (nativePath == NULL || nativePath[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
- if (DeleteFile(path) != FALSE) {
+ if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- attr = GetFileAttributes(path);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
/*
* It is a symbolic link - remove it.
*/
- if (TclWinSymLinkDelete(path, 0) == 0) {
+ if (TclWinSymLinkDelete(nativePath, 0) == 0) {
return TCL_OK;
}
}
@@ -788,21 +792,21 @@ TclpDeleteFile(
Tcl_SetErrno(EISDIR);
} else if (attr & FILE_ATTRIBUTE_READONLY) {
- int res = SetFileAttributes(path,
- attr & ~((DWORD) FILE_ATTRIBUTE_READONLY));
+ int res = (*tclWinProcs->setFileAttributesProc)(nativePath,
+ attr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
- if ((res != 0) &&
- (DeleteFile(path) != FALSE)) {
+ if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath)
+ != FALSE)) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
if (res != 0) {
- SetFileAttributes(path, attr);
+ (*tclWinProcs->setFileAttributesProc)(nativePath, attr);
}
}
}
} else if (Tcl_GetErrno() == ENOENT) {
- attr = GetFileAttributes(path);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
@@ -859,11 +863,11 @@ TclpObjCreateDirectory(
static int
DoCreateDirectory(
- const TCHAR *nativePath) /* Pathname of directory to create (native). */
+ CONST TCHAR *nativePath) /* Pathname of directory to create (native). */
{
- if (CreateDirectory(nativePath, NULL) == 0) {
- DWORD error = GetLastError();
-
+ DWORD error;
+ if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
+ error = GetLastError();
TclWinConvertError(error);
return TCL_ERROR;
}
@@ -992,12 +996,13 @@ TclpObjRemoveDirectory(
}
if (ret != TCL_OK) {
- if (Tcl_DStringLength(&ds) > 0) {
+ int len = Tcl_DStringLength(&ds);
+ if (len > 0) {
if (normPtr != NULL &&
!strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
*errorPtr = pathPtr;
} else {
- *errorPtr = TclDStringToObj(&ds);
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
}
Tcl_IncrRefCount(*errorPtr);
}
@@ -1009,7 +1014,7 @@ TclpObjRemoveDirectory(
static int
DoRemoveJustDirectory(
- const TCHAR *nativePath, /* Pathname of directory to be removed
+ CONST TCHAR *nativePath, /* Pathname of directory to be removed
* (native). */
int ignoreError, /* If non-zero, don't initialize the errorPtr
* under some circumstances on return. */
@@ -1029,7 +1034,7 @@ DoRemoveJustDirectory(
goto end;
}
- attr = GetFileAttributes(nativePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
/*
@@ -1043,7 +1048,7 @@ DoRemoveJustDirectory(
* Ordinary directory.
*/
- if (RemoveDirectory(nativePath) != FALSE) {
+ if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
}
@@ -1051,7 +1056,7 @@ DoRemoveJustDirectory(
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- attr = GetFileAttributes(nativePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
@@ -1075,17 +1080,60 @@ DoRemoveJustDirectory(
if (attr & FILE_ATTRIBUTE_READONLY) {
attr &= ~FILE_ATTRIBUTE_READONLY;
- if (SetFileAttributes(nativePath,
+ if ((*tclWinProcs->setFileAttributesProc)(nativePath,
attr) == FALSE) {
goto end;
}
- if (RemoveDirectory(nativePath) != FALSE) {
+ if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- SetFileAttributes(nativePath,
+ (*tclWinProcs->setFileAttributesProc)(nativePath,
attr | FILE_ATTRIBUTE_READONLY);
}
+
+ /*
+ * Windows 95 and Win32s report removing a non-empty directory as
+ * EACCES, not EEXIST. If the directory is not empty, change errno
+ * so caller knows what's going on.
+ */
+
+ if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
+ CONST char *path, *find;
+ HANDLE handle;
+ WIN32_FIND_DATAA data;
+ Tcl_DString buffer;
+ int len;
+
+ path = (CONST char *) nativePath;
+
+ Tcl_DStringInit(&buffer);
+ len = strlen(path);
+ find = Tcl_DStringAppend(&buffer, path, len);
+ if ((len > 0) && (find[len - 1] != '\\')) {
+ Tcl_DStringAppend(&buffer, "\\", 1);
+ }
+ find = Tcl_DStringAppend(&buffer, "*.*", 3);
+ handle = FindFirstFileA(find, &data);
+ if (handle != INVALID_HANDLE_VALUE) {
+ while (1) {
+ if ((strcmp(data.cFileName, ".") != 0)
+ && (strcmp(data.cFileName, "..") != 0)) {
+ /*
+ * Found something in this directory.
+ */
+
+ Tcl_SetErrno(EEXIST);
+ break;
+ }
+ if (FindNextFileA(handle, &data) == FALSE) {
+ break;
+ }
+ }
+ FindClose(handle);
+ }
+ Tcl_DStringFree(&buffer);
+ }
}
}
@@ -1130,7 +1178,7 @@ DoRemoveDirectory(
* filled with UTF-8 name of file causing
* error. */
{
- int res = DoRemoveJustDirectory((const TCHAR *)Tcl_DStringValue(pathPtr), recursive,
+ int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive,
errorPtr);
if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
@@ -1184,7 +1232,7 @@ TraverseWinTree(
TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen;
HANDLE handle;
- WIN32_FIND_DATA data;
+ WIN32_FIND_DATAT data;
nativeErrfile = NULL;
result = TCL_OK;
@@ -1195,7 +1243,7 @@ TraverseWinTree(
(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));
oldSourceLen = Tcl_DStringLength(sourcePtr);
- sourceAttr = GetFileAttributes(nativeSource);
+ sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
if (sourceAttr == 0xffffffff) {
nativeErrfile = nativeSource;
goto end;
@@ -1206,7 +1254,7 @@ TraverseWinTree(
* Process the symbolic link
*/
- return traverseProc(nativeSource, nativeTarget, DOTREE_LINK,
+ return (*traverseProc)(nativeSource, nativeTarget, DOTREE_LINK,
errorPtr);
}
@@ -1215,14 +1263,18 @@ TraverseWinTree(
* Process the regular file
*/
- return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr);
+ return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr);
}
- Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\*.*"), 4 * sizeof(TCHAR) + 1);
- Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
+ if (tclWinProcs->useWide) {
+ Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
+ Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
+ } else {
+ Tcl_DStringAppend(sourcePtr, "\\*.*", 4);
+ }
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
- handle = FindFirstFile(nativeSource, &data);
+ handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* Can't read directory.
@@ -1233,44 +1285,67 @@ TraverseWinTree(
goto end;
}
- Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
+ nativeSource[oldSourceLen + 1] = '\0';
Tcl_DStringSetLength(sourcePtr, oldSourceLen);
- result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED,
+ result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED,
errorPtr);
if (result != TCL_OK) {
FindClose(handle);
return result;
}
- sourceLen = oldSourceLen + sizeof(TCHAR);
- Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1);
- Tcl_DStringSetLength(sourcePtr, sourceLen);
+ sourceLen = oldSourceLen;
+
+ if (tclWinProcs->useWide) {
+ sourceLen += sizeof(WCHAR);
+ Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
+ Tcl_DStringSetLength(sourcePtr, sourceLen);
+ } else {
+ sourceLen += 1;
+ Tcl_DStringAppend(sourcePtr, "\\", 1);
+ }
if (targetPtr != NULL) {
oldTargetLen = Tcl_DStringLength(targetPtr);
targetLen = oldTargetLen;
- targetLen += sizeof(TCHAR);
- Tcl_DStringAppend(targetPtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1);
- Tcl_DStringSetLength(targetPtr, targetLen);
+ if (tclWinProcs->useWide) {
+ targetLen += sizeof(WCHAR);
+ Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);
+ Tcl_DStringSetLength(targetPtr, targetLen);
+ } else {
+ targetLen += 1;
+ Tcl_DStringAppend(targetPtr, "\\", 1);
+ }
}
found = 1;
- for (; found; found = FindNextFile(handle, &data)) {
+ for (; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
TCHAR *nativeName;
int len;
- TCHAR *wp = data.cFileName;
- if (*wp == '.') {
- wp++;
+ if (tclWinProcs->useWide) {
+ WCHAR *wp;
+
+ wp = data.w.cFileName;
if (*wp == '.') {
wp++;
+ if (*wp == '.') {
+ wp++;
+ }
+ if (*wp == '\0') {
+ continue;
+ }
}
- if (*wp == '\0') {
+ nativeName = (TCHAR *) data.w.cFileName;
+ len = wcslen(data.w.cFileName) * sizeof(WCHAR);
+ } else {
+ if ((strcmp(data.a.cFileName, ".") == 0)
+ || (strcmp(data.a.cFileName, "..") == 0)) {
continue;
}
+ nativeName = (TCHAR *) data.a.cFileName;
+ len = strlen(data.a.cFileName);
}
- nativeName = (TCHAR *) data.cFileName;
- len = _tcslen(data.cFileName) * sizeof(TCHAR);
/*
* Append name after slash, and recurse on the file.
@@ -1315,8 +1390,8 @@ TraverseWinTree(
* files in that directory.
*/
- result = traverseProc((const TCHAR *)Tcl_DStringValue(sourcePtr),
- (const TCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
+ result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
+ (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
DOTREE_POSTD, errorPtr);
}
@@ -1351,8 +1426,8 @@ TraverseWinTree(
static int
TraversalCopy(
- const TCHAR *nativeSrc, /* Source pathname to copy. */
- const TCHAR *nativeDst, /* Destination pathname of copy. */
+ CONST TCHAR *nativeSrc, /* Source pathname to copy. */
+ CONST TCHAR *nativeDst, /* Destination pathname of copy. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
@@ -1370,9 +1445,9 @@ TraversalCopy(
break;
case DOTREE_PRED:
if (DoCreateDirectory(nativeDst) == TCL_OK) {
- DWORD attr = GetFileAttributes(nativeSrc);
+ DWORD attr = (tclWinProcs->getFileAttributesProc)(nativeSrc);
- if (SetFileAttributes(nativeDst,
+ if ((tclWinProcs->setFileAttributesProc)(nativeDst,
attr) != FALSE) {
return TCL_OK;
}
@@ -1417,8 +1492,8 @@ TraversalCopy(
static int
TraversalDelete(
- const TCHAR *nativeSrc, /* Source pathname to delete. */
- const TCHAR *dstPtr, /* Not used. */
+ CONST TCHAR *nativeSrc, /* Source pathname to delete. */
+ CONST TCHAR *dstPtr, /* Not used. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
@@ -1473,8 +1548,8 @@ StatError(
* error. */
{
TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
- TclGetString(fileName), Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
}
/*
@@ -1504,11 +1579,11 @@ GetWinFileAttributes(
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
DWORD result;
- const TCHAR *nativeName;
+ CONST TCHAR *nativeName;
int attr;
nativeName = Tcl_FSGetNativePath(fileName);
- result = GetFileAttributes(nativeName);
+ result = (*tclWinProcs->getFileAttributesProc)(nativeName);
if (result == 0xffffffff) {
StatError(interp, fileName);
@@ -1526,7 +1601,7 @@ GetWinFileAttributes(
*/
int len;
- const char *str = Tcl_GetStringFromObj(fileName,&len);
+ char *str = Tcl_GetStringFromObj(fileName,&len);
if (len < 4) {
if (len == 0) {
@@ -1592,11 +1667,9 @@ ConvertFileNameFormat(
if (splitPath == NULL || pathc == 0) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "could not read \"%s\": no such file or directory",
- Tcl_GetString(fileName)));
- errno = ENOENT;
- Tcl_PosixError(interp);
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": no such file or directory",
+ (char *) NULL);
}
goto cleanup;
}
@@ -1637,10 +1710,10 @@ ConvertFileNameFormat(
Tcl_Obj *tempPath;
Tcl_DString ds;
Tcl_DString dsTemp;
- const TCHAR *nativeName;
- const char *tempString;
+ TCHAR *nativeName;
+ char *tempString;
int tempLen;
- WIN32_FIND_DATA data;
+ WIN32_FIND_DATAT data;
HANDLE handle;
DWORD attr;
@@ -1656,7 +1729,7 @@ ConvertFileNameFormat(
tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
Tcl_DecrRefCount(tempPath);
- handle = FindFirstFile(nativeName, &data);
+ handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* FindFirstFile() doesn't like root directories. We would
@@ -1665,7 +1738,7 @@ ConvertFileNameFormat(
* root directory
*/
- attr = GetFileAttributes(nativeName);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
goto simple;
@@ -1679,14 +1752,27 @@ ConvertFileNameFormat(
}
goto cleanup;
}
- nativeName = data.cAlternateFileName;
- if (longShort) {
- if (data.cFileName[0] != '\0') {
- nativeName = data.cFileName;
+ if (tclWinProcs->useWide) {
+ nativeName = (TCHAR *) data.w.cAlternateFileName;
+ if (longShort) {
+ if (data.w.cFileName[0] != '\0') {
+ nativeName = (TCHAR *) data.w.cFileName;
+ }
+ } else {
+ if (data.w.cAlternateFileName[0] == '\0') {
+ nativeName = (TCHAR *) data.w.cFileName;
+ }
}
} else {
- if (data.cAlternateFileName[0] == '\0') {
- nativeName = (TCHAR *) data.cFileName;
+ nativeName = (TCHAR *) data.a.cAlternateFileName;
+ if (longShort) {
+ if (data.a.cFileName[0] != '\0') {
+ nativeName = (TCHAR *) data.a.cFileName;
+ }
+ } else {
+ if (data.a.cAlternateFileName[0] == '\0') {
+ nativeName = (TCHAR *) data.a.cFileName;
+ }
}
}
@@ -1704,21 +1790,22 @@ ConvertFileNameFormat(
Tcl_DStringInit(&dsTemp);
Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
- Tcl_DStringFree(&ds);
/*
* Deal with issues of tildes being absolute.
*/
if (Tcl_DStringValue(&dsTemp)[0] == '~') {
- TclNewLiteralStringObj(tempPath, "./");
+ tempPath = Tcl_NewStringObj("./",2);
Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
Tcl_DStringLength(&dsTemp));
- Tcl_DStringFree(&dsTemp);
} else {
- tempPath = TclDStringToObj(&dsTemp);
+ tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ Tcl_DStringLength(&dsTemp));
}
Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
+ Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&dsTemp);
FindClose(handle);
}
}
@@ -1830,12 +1917,13 @@ SetWinFileAttributes(
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
- DWORD fileAttributes, old;
- int yesNo, result;
- const TCHAR *nativeName;
+ DWORD fileAttributes;
+ int yesNo;
+ int result;
+ CONST TCHAR *nativeName;
nativeName = Tcl_FSGetNativePath(fileName);
- fileAttributes = old = GetFileAttributes(nativeName);
+ fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);
if (fileAttributes == 0xffffffff) {
StatError(interp, fileName);
@@ -1853,8 +1941,7 @@ SetWinFileAttributes(
fileAttributes &= ~(attributeArray[objIndex]);
}
- if ((fileAttributes != old)
- && !SetFileAttributes(nativeName, fileAttributes)) {
+ if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
StatError(interp, fileName);
return TCL_ERROR;
}
@@ -1885,13 +1972,13 @@ CannotSetAttribute(
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
- tclpFileAttrStrings[objIndex], Tcl_GetString(fileName)));
- errno = EINVAL;
- Tcl_PosixError(interp);
+ Tcl_AppendResult(interp, "cannot set attribute \"",
+ tclpFileAttrStrings[objIndex], "\" for file \"",
+ Tcl_GetString(fileName), "\": attribute is readonly",
+ (char *) NULL);
return TCL_ERROR;
}
+
/*
*---------------------------------------------------------------------------
@@ -1909,7 +1996,7 @@ CannotSetAttribute(
*---------------------------------------------------------------------------
*/
-Tcl_Obj *
+Tcl_Obj*
TclpObjListVolumes(void)
{
Tcl_Obj *resultPtr, *elemPtr;
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 25c6ea4..41de4a8 100755
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -16,12 +16,9 @@
#include "tclFileSystem.h"
#include <winioctl.h>
#include <shlobj.h>
-#include <lm.h> /* For TclpGetUserHome(). */
+#include <lmaccess.h> /* For TclpGetUserHome(). */
#include <userenv.h> /* For TclpGetUserHome(). */
-#ifdef _MSC_VER
-# pragma comment(lib, "userenv.lib")
-#endif
/*
* The number of 100-ns intervals between the Windows system epoch (1601-01-01
* on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01).
@@ -144,6 +141,28 @@ typedef struct {
WCHAR dummyBuf[MAX_PATH * 3];
} DUMMY_REPARSE_BUFFER;
+#if defined(_MSC_VER) && (_MSC_VER <= 1100)
+#undef HAVE_NO_FINDEX_ENUMS
+#define HAVE_NO_FINDEX_ENUMS
+#elif !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0400)
+#undef HAVE_NO_FINDEX_ENUMS
+#define HAVE_NO_FINDEX_ENUMS
+#endif
+
+#ifdef HAVE_NO_FINDEX_ENUMS
+/* These two aren't in VC++ 5.2 headers */
+typedef enum _FINDEX_INFO_LEVELS {
+ FindExInfoStandard,
+ FindExInfoMaxInfoLevel
+} FINDEX_INFO_LEVELS;
+typedef enum _FINDEX_SEARCH_OPS {
+ FindExSearchNameMatch,
+ FindExSearchLimitToDirectories,
+ FindExSearchLimitToDevices,
+ FindExSearchMaxSearchOp
+} FINDEX_SEARCH_OPS;
+#endif /* HAVE_NO_FINDEX_ENUMS */
+
/*
* Other typedefs required by this code.
*/
@@ -151,6 +170,18 @@ typedef struct {
static time_t ToCTime(FILETIME fileTime);
static void FromCTime(time_t posixTime, FILETIME *fileTime);
+typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC(
+ LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr);
+
+typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC(LPVOID Buffer);
+
+typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC(
+ LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);
+
+typedef BOOL WINAPI GETPROFILESDIRECTORYPROC(
+ LPWSTR lpProfilesDir, LPDWORD lpcchSize
+);
+
/*
* Declarations for local functions defined in this file:
*/
@@ -176,7 +207,6 @@ static int WinLink(const TCHAR *LinkSource,
const TCHAR *LinkTarget, int linkAction);
static int WinSymLinkDirectory(const TCHAR *LinkDirectory,
const TCHAR *LinkTarget);
-MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...);
/*
*--------------------------------------------------------------------
@@ -194,7 +224,7 @@ WinLink(
const TCHAR *linkTargetPath,
int linkAction)
{
- TCHAR tempFileName[MAX_PATH];
+ WCHAR tempFileName[MAX_PATH];
TCHAR *tempFilePart;
DWORD attr;
@@ -202,8 +232,8 @@ WinLink(
* Get the full path referenced by the target.
*/
- if (!GetFullPathName(linkTargetPath, MAX_PATH, tempFileName,
- &tempFilePart)) {
+ if (!(*tclWinProcs->getFullPathNameProc)(linkTargetPath, MAX_PATH,
+ tempFileName, &tempFilePart)) {
/*
* Invalid file.
*/
@@ -216,7 +246,7 @@ WinLink(
* Make sure source file doesn't exist.
*/
- attr = GetFileAttributes(linkSourcePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath);
if (attr != INVALID_FILE_ATTRIBUTES) {
Tcl_SetErrno(EEXIST);
return -1;
@@ -226,8 +256,8 @@ WinLink(
* Get the full path referenced by the source file/directory.
*/
- if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName,
- &tempFilePart)) {
+ if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH,
+ tempFileName, &tempFilePart)) {
/*
* Invalid file.
*/
@@ -240,36 +270,43 @@ WinLink(
* Check the target.
*/
- attr = GetFileAttributes(linkTargetPath);
+ attr = (*tclWinProcs->getFileAttributesProc)(linkTargetPath);
if (attr == INVALID_FILE_ATTRIBUTES) {
/*
* The target doesn't exist.
*/
TclWinConvertError(GetLastError());
+ return -1;
+
} else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* It is a file.
*/
- if (linkAction & TCL_CREATE_HARD_LINK) {
- if (CreateHardLink(linkSourcePath, linkTargetPath, NULL)) {
- /*
- * Success!
- */
+ if (tclWinProcs->createHardLinkProc == NULL) {
+ Tcl_SetErrno(ENOTDIR);
+ return -1;
+ }
- return 0;
+ if (linkAction & TCL_CREATE_HARD_LINK) {
+ if (!(*tclWinProcs->createHardLinkProc)(linkSourcePath,
+ linkTargetPath, NULL)) {
+ TclWinConvertError(GetLastError());
+ return -1;
}
+ return 0;
- TclWinConvertError(GetLastError());
} else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
/*
* Can't symlink files.
*/
Tcl_SetErrno(ENOTDIR);
+ return -1;
} else {
Tcl_SetErrno(ENODEV);
+ return -1;
}
} else {
/*
@@ -286,11 +323,12 @@ WinLink(
*/
Tcl_SetErrno(EISDIR);
+ return -1;
} else {
Tcl_SetErrno(ENODEV);
+ return -1;
}
}
- return -1;
}
/*
@@ -307,7 +345,7 @@ static Tcl_Obj *
WinReadLink(
const TCHAR *linkSourcePath)
{
- TCHAR tempFileName[MAX_PATH];
+ WCHAR tempFileName[MAX_PATH];
TCHAR *tempFilePart;
DWORD attr;
@@ -315,8 +353,8 @@ WinReadLink(
* Get the full path referenced by the target.
*/
- if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName,
- &tempFilePart)) {
+ if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH,
+ tempFileName, &tempFilePart)) {
/*
* Invalid file.
*/
@@ -329,7 +367,7 @@ WinReadLink(
* Make sure source file does exist.
*/
- attr = GetFileAttributes(linkSourcePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath);
if (attr == INVALID_FILE_ATTRIBUTES) {
/*
* The source doesn't exist.
@@ -345,9 +383,9 @@ WinReadLink(
Tcl_SetErrno(ENOTDIR);
return NULL;
+ } else {
+ return WinReadLinkDirectory(linkSourcePath);
}
-
- return WinReadLinkDirectory(linkSourcePath);
}
/*
@@ -486,8 +524,9 @@ TclWinSymLinkDelete(
memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
- hFile = CreateFile(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ hFile = (*tclWinProcs->createFileProc)(linkOrigPath, GENERIC_WRITE, 0,
+ NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile != INVALID_HANDLE_VALUE) {
if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
@@ -501,7 +540,7 @@ TclWinSymLinkDelete(
} else {
CloseHandle(hFile);
if (!linkOnly) {
- RemoveDirectory(linkOrigPath);
+ (*tclWinProcs->removeDirectoryProc)(linkOrigPath);
}
return 0;
}
@@ -541,7 +580,7 @@ WinReadLinkDirectory(
Tcl_DString ds;
const char *copy;
- attr = GetFileAttributes(linkDirPath);
+ attr = (*tclWinProcs->getFileAttributesProc)(linkDirPath);
if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
goto invalidError;
}
@@ -566,7 +605,6 @@ WinReadLinkDirectory(
*/
offset = 0;
-#ifdef UNICODE
if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') {
/*
* Check whether this is a mounted volume.
@@ -628,9 +666,8 @@ WinReadLinkDirectory(
offset = 4;
}
}
-#endif /* UNICODE */
- Tcl_WinTCharToUtf((const TCHAR *)
+ Tcl_WinTCharToUtf((const char *)
reparseBuffer->MountPointReparseBuffer.PathBuffer,
(int) reparseBuffer->MountPointReparseBuffer
.SubstituteNameLength, &ds);
@@ -672,8 +709,9 @@ NativeReadReparse(
HANDLE hFile;
DWORD returnedLength;
- hFile = CreateFile(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ hFile = (*tclWinProcs->createFileProc)(linkDirPath, desiredAccess, FILE_SHARE_READ,
+ NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
/*
@@ -731,7 +769,7 @@ NativeWriteReparse(
* Create the directory - it must not already exist.
*/
- if (CreateDirectory(linkDirPath, NULL) == 0) {
+ if ((*tclWinProcs->createDirectoryProc)(linkDirPath, NULL) == 0) {
/*
* Error creating directory.
*/
@@ -739,9 +777,9 @@ NativeWriteReparse(
TclWinConvertError(GetLastError());
return -1;
}
- hFile = CreateFile(linkDirPath, GENERIC_WRITE, 0, NULL,
- OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT
- | FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_WRITE, 0,
+ NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
/*
* Error creating directory.
@@ -764,7 +802,7 @@ NativeWriteReparse(
TclWinConvertError(GetLastError());
CloseHandle(hFile);
- RemoveDirectory(linkDirPath);
+ (*tclWinProcs->removeDirectoryProc)(linkDirPath);
return -1;
}
CloseHandle(hFile);
@@ -777,65 +815,6 @@ NativeWriteReparse(
}
/*
- *----------------------------------------------------------------------
- *
- * tclWinDebugPanic --
- *
- * Display a message. If a debugger is present, present it directly to
- * the debugger, otherwise use a MessageBox.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-TCL_NORETURN void
-tclWinDebugPanic(
- const char *format, ...)
-{
-#define TCL_MAX_WARN_LEN 1024
- va_list argList;
- char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
- WCHAR msgString[TCL_MAX_WARN_LEN];
-
- va_start(argList, format);
- vsnprintf(buf, sizeof(buf), format, argList);
-
- msgString[TCL_MAX_WARN_LEN-1] = L'\0';
- MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN);
-
- /*
- * Truncate MessageBox string if it is too long to not overflow the screen
- * and cause possible oversized window error.
- */
-
- if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
- memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
- }
- if (IsDebuggerPresent()) {
- OutputDebugStringW(msgString);
- } else {
- MessageBeep(MB_ICONEXCLAMATION);
- 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)
- _asm {int 3}
-#else
- DebugBreak();
-#endif
- abort();
-}
-
-/*
*---------------------------------------------------------------------------
*
* TclpFindExecutable --
@@ -854,33 +833,28 @@ tclWinDebugPanic(
void
TclpFindExecutable(
- const char *argv0) /* If NULL, install PanicMessageBox, otherwise
- * ignore. */
+ const char *argv0) /* The value of the application's argv[0]
+ * (native). */
{
WCHAR wName[MAX_PATH];
char name[MAX_PATH * TCL_UTF_MAX];
/*
* 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.
+ * create this process.
*/
- if (argv0 == NULL) {
- Tcl_SetPanicProc(tclWinDebugPanic);
- }
+ if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) {
+ GetModuleFileNameA(NULL, name, sizeof(name));
-#ifdef UNICODE
- GetModuleFileNameW(NULL, wName, MAX_PATH);
-#else
- GetModuleFileNameA(NULL, name, sizeof(name));
+ /*
+ * Convert to WCHAR to get out of ANSI codepage
+ */
- /*
- * Convert to WCHAR to get out of ANSI codepage
- */
+ MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
+ }
- MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
-#endif
- WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
+ WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL,NULL);
TclWinNoBackslash(name);
TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
}
@@ -926,7 +900,6 @@ TclpMatchInDirectory(
if (pattern == NULL || (*pattern == '\0')) {
Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
-
if (norm != NULL) {
/*
* Match a single file directly.
@@ -934,16 +907,23 @@ TclpMatchInDirectory(
int len;
DWORD attr;
- WIN32_FILE_ATTRIBUTE_DATA data;
const char *str = Tcl_GetStringFromObj(norm,&len);
- native = Tcl_FSGetNativePath(pathPtr);
+ native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
- if (GetFileAttributesEx(native,
- GetFileExInfoStandard, &data) != TRUE) {
- return TCL_OK;
+ if (tclWinProcs->getFileAttributesExProc == NULL) {
+ attr = (*tclWinProcs->getFileAttributesProc)(native);
+ if (attr == 0xffffffff) {
+ return TCL_OK;
+ }
+ } else {
+ WIN32_FILE_ATTRIBUTE_DATA data;
+ if ((*tclWinProcs->getFileAttributesExProc)(native,
+ GetFileExInfoStandard, &data) != TRUE) {
+ return TCL_OK;
+ }
+ attr = data.dwFileAttributes;
}
- attr = data.dwFileAttributes;
if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
@@ -953,7 +933,7 @@ TclpMatchInDirectory(
} else {
DWORD attr;
HANDLE handle;
- WIN32_FIND_DATA data;
+ WIN32_FIND_DATAT data;
const char *dirName; /* UTF-8 dir name, later with pattern
* appended. */
int dirLength;
@@ -982,10 +962,9 @@ TclpMatchInDirectory(
if (native == NULL) {
return TCL_OK;
}
- attr = GetFileAttributes(native);
+ attr = (*tclWinProcs->getFileAttributesProc)(native);
- if ((attr == INVALID_FILE_ATTRIBUTES)
- || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
+ if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
return TCL_OK;
}
@@ -1000,7 +979,7 @@ TclpMatchInDirectory(
lastChar = dirName[dirLength -1];
if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
- TclDStringAppendLiteral(&dsOrig, "/");
+ Tcl_DStringAppend(&dsOrig, "/", 1);
dirLength++;
}
dirName = Tcl_DStringValue(&dsOrig);
@@ -1020,25 +999,25 @@ TclpMatchInDirectory(
dirName = Tcl_DStringAppend(&dsOrig, pattern, -1);
} else {
- dirName = TclDStringAppendLiteral(&dsOrig, "*.*");
+ dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3);
}
native = Tcl_WinUtfToTChar(dirName, -1, &ds);
- if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) {
- handle = FindFirstFile(native, &data);
+ if (tclWinProcs->findFirstFileExProc == NULL || (types == NULL)
+ || (types->type != TCL_GLOB_TYPE_DIR)) {
+ handle = (*tclWinProcs->findFirstFileProc)(native, &data);
} else {
/*
* We can be more efficient, for pure directory requests.
*/
- handle = FindFirstFileEx(native,
+ handle = (*tclWinProcs->findFirstFileExProc)(native,
FindExInfoStandard, &data,
FindExSearchLimitToDirectories, NULL, 0);
}
if (handle == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
-
Tcl_DStringFree(&ds);
if (err == ERROR_FILE_NOT_FOUND) {
/*
@@ -1052,9 +1031,10 @@ TclpMatchInDirectory(
TclWinConvertError(err);
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't read directory \"%s\": %s",
- Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't read directory \"",
+ Tcl_DStringValue(&dsOrig), "\": ",
+ Tcl_PosixError(interp), NULL);
}
Tcl_DStringFree(&dsOrig);
return TCL_ERROR;
@@ -1094,8 +1074,14 @@ TclpMatchInDirectory(
int checkDrive = 0, isDrive;
DWORD attr;
- native = data.cFileName;
- attr = data.dwFileAttributes;
+ if (tclWinProcs->useWide) {
+ native = (const TCHAR *) data.w.cFileName;
+ attr = data.w.dwFileAttributes;
+ } else {
+ native = (const TCHAR *) data.a.cFileName;
+ attr = data.a.dwFileAttributes;
+ }
+
utfname = Tcl_WinTCharToUtf(native, -1, &ds);
if (!matchSpecialDots) {
@@ -1138,7 +1124,6 @@ TclpMatchInDirectory(
if (checkDrive) {
const char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
Tcl_DStringLength(&ds));
-
isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
Tcl_DStringSetLength(&dsOrig, dirLength);
} else {
@@ -1156,7 +1141,7 @@ TclpMatchInDirectory(
*/
Tcl_DStringFree(&ds);
- } while (FindNextFile(handle, &data) == TRUE);
+ } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE);
FindClose(handle);
Tcl_DStringFree(&dsOrig);
@@ -1329,80 +1314,81 @@ NativeMatchType(
* If invisible, don't return the file.
*/
- return !(attr & FILE_ATTRIBUTE_HIDDEN && !isDrive);
- }
-
- if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
- /*
- * If invisible.
- */
-
- if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
return 0;
}
} else {
- /*
- * Visible.
- */
+ if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
+ /*
+ * If invisible.
+ */
- if (types->perm & TCL_GLOB_PERM_HIDDEN) {
- return 0;
- }
- }
+ if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ return 0;
+ }
+ } else {
+ /*
+ * Visible.
+ */
- if (types->perm != 0) {
- if (((types->perm & TCL_GLOB_PERM_RONLY) &&
- !(attr & FILE_ATTRIBUTE_READONLY)) ||
- ((types->perm & TCL_GLOB_PERM_R) &&
- (0 /* File exists => R_OK on Windows */)) ||
- ((types->perm & TCL_GLOB_PERM_W) &&
- (attr & FILE_ATTRIBUTE_READONLY)) ||
- ((types->perm & TCL_GLOB_PERM_X) &&
- (!(attr & FILE_ATTRIBUTE_DIRECTORY)
- && !NativeIsExec(nativeName)))) {
- return 0;
+ if (types->perm & TCL_GLOB_PERM_HIDDEN) {
+ return 0;
+ }
}
- }
- if ((types->type & TCL_GLOB_TYPE_DIR)
- && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
- /*
- * Quicker test for directory, which is a common case.
- */
+ if (types->perm != 0) {
+ if (((types->perm & TCL_GLOB_PERM_RONLY) &&
+ !(attr & FILE_ATTRIBUTE_READONLY)) ||
+ ((types->perm & TCL_GLOB_PERM_R) &&
+ (0 /* File exists => R_OK on Windows */)) ||
+ ((types->perm & TCL_GLOB_PERM_W) &&
+ (attr & FILE_ATTRIBUTE_READONLY)) ||
+ ((types->perm & TCL_GLOB_PERM_X) &&
+ (!(attr & FILE_ATTRIBUTE_DIRECTORY)
+ && !NativeIsExec(nativeName)))) {
+ return 0;
+ }
+ }
+ if ((types->type & TCL_GLOB_TYPE_DIR)
+ && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
+ /*
+ * Quicker test for directory, which is a common case.
+ */
- return 1;
+ return 1;
- } else if (types->type != 0) {
- unsigned short st_mode;
- int isExec = NativeIsExec(nativeName);
+ } else if (types->type != 0) {
+ unsigned short st_mode;
+ int isExec = NativeIsExec(nativeName);
- st_mode = NativeStatMode(attr, 0, isExec);
+ st_mode = NativeStatMode(attr, 0, isExec);
- /*
- * In order bcdpfls as in 'find -t'
- */
+ /*
+ * In order bcdpfls as in 'find -t'
+ */
- if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) ||
- ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) ||
- ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) ||
- ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) ||
+ if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) ||
+ ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) ||
+ ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) ||
+ ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) ||
#ifdef S_ISSOCK
- ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) ||
+ ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) ||
#endif
- ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) {
- /*
- * Do nothing - this file is ok.
- */
- } else {
+ ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) {
+ /*
+ * Do nothing - this file is ok.
+ */
+ } else {
#ifdef S_ISLNK
- if (types->type & TCL_GLOB_TYPE_LINK) {
- st_mode = NativeStatMode(attr, 1, isExec);
- if (S_ISLNK(st_mode)) {
- return 1;
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ st_mode = NativeStatMode(attr, 1, isExec);
+ if (S_ISLNK(st_mode)) {
+ return 1;
+ }
}
+#endif
+ return 0;
}
-#endif /* S_ISLNK */
- return 0;
}
}
return 1;
@@ -1429,60 +1415,90 @@ NativeMatchType(
*----------------------------------------------------------------------
*/
-const char *
+char *
TclpGetUserHome(
const char *name, /* User name for desired home directory. */
Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
* name of user's home directory. */
{
- const char *result = NULL;
- USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr;
- Tcl_DString ds;
- int nameLen = -1;
- int badDomain = 0;
- char *domain;
- WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain;
- WCHAR buf[MAX_PATH];
+ char *result;
+ HINSTANCE netapiInst;
+ HINSTANCE userenvInst;
+ result = NULL;
Tcl_DStringInit(bufferPtr);
- wDomain = NULL;
- domain = strchr(name, '@');
- if (domain != NULL) {
- Tcl_DStringInit(&ds);
- wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
- badDomain = NetGetDCName(NULL, wName, (LPBYTE *) wDomainPtr);
- Tcl_DStringFree(&ds);
- nameLen = domain - name;
- }
- if (badDomain == 0) {
- Tcl_DStringInit(&ds);
- wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
- if (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) uiPtrPtr) == 0) {
- wHomeDir = uiPtr->usri1_home_dir;
- if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
- Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
- bufferPtr);
- } else {
- /*
- * User exists but has no home dir. Return
- * "{GetProfilesDirectory}/<user>".
- */
- DWORD i, size = MAX_PATH;
- GetProfilesDirectoryW(buf, &size);
- for (i = 0; i < size; ++i){
- if (buf[i] == '\\') buf[i] = '/';
+
+ netapiInst = LoadLibraryA("netapi32.dll");
+ userenvInst = LoadLibraryA("userenv.dll");
+ if (netapiInst != NULL && userenvInst != NULL) {
+ NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
+ NETGETDCNAMEPROC *netGetDCNameProc;
+ NETUSERGETINFOPROC *netUserGetInfoProc;
+ GETPROFILESDIRECTORYPROC *getProfilesDirectoryProc;
+
+ netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
+ GetProcAddress(netapiInst, "NetApiBufferFree");
+ netGetDCNameProc = (NETGETDCNAMEPROC *)
+ GetProcAddress(netapiInst, "NetGetDCName");
+ netUserGetInfoProc = (NETUSERGETINFOPROC *)
+ GetProcAddress(netapiInst, "NetUserGetInfo");
+ getProfilesDirectoryProc = (GETPROFILESDIRECTORYPROC *)
+ GetProcAddress(userenvInst, "GetProfilesDirectoryW");
+ if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
+ && (netApiBufferFreeProc != NULL) && (getProfilesDirectoryProc != NULL)) {
+ USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr;
+ Tcl_DString ds;
+ int nameLen, badDomain;
+ char *domain;
+ WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain;
+ WCHAR buf[MAX_PATH];
+
+ badDomain = 0;
+ nameLen = -1;
+ wDomain = NULL;
+ domain = strchr(name, '@');
+ if (domain != NULL) {
+ Tcl_DStringInit(&ds);
+ wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
+ badDomain = (netGetDCNameProc)(NULL, wName,
+ (LPBYTE *) wDomainPtr);
+ Tcl_DStringFree(&ds);
+ nameLen = domain - name;
+ }
+ if (badDomain == 0) {
+ Tcl_DStringInit(&ds);
+ wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
+ if ((netUserGetInfoProc)(wDomain, wName, 1,
+ (LPBYTE *) uiPtrPtr) == 0) {
+ wHomeDir = uiPtr->usri1_home_dir;
+ if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
+ Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
+ bufferPtr);
+ } else {
+ /*
+ * User exists but has no home dir. Return
+ * "{GetProfilesDirectory}/<user>".
+ */
+ DWORD i, size = MAX_PATH;
+ getProfilesDirectoryProc(buf, &size);
+ for (i = 0; i < size; ++i){
+ if (buf[i] == '\\') buf[i] = '/';
+ }
+ Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
+ Tcl_DStringAppend(bufferPtr, "/", -1);
+ Tcl_DStringAppend(bufferPtr, name, -1);
+ }
+ result = Tcl_DStringValue(bufferPtr);
+ (*netApiBufferFreeProc)((void *) uiPtr);
}
- Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
- Tcl_DStringAppend(bufferPtr, "/", -1);
- Tcl_DStringAppend(bufferPtr, name, -1);
+ Tcl_DStringFree(&ds);
+ }
+ if (wDomain != NULL) {
+ (*netApiBufferFreeProc)((void *) wDomain);
}
- result = Tcl_DStringValue(bufferPtr);
- NetApiBufferFree((void *) uiPtr);
}
- Tcl_DStringFree(&ds);
- }
- if (wDomain != NULL) {
- NetApiBufferFree((void *) wDomain);
+ FreeLibrary(userenvInst);
+ FreeLibrary(netapiInst);
}
if (result == NULL) {
/*
@@ -1538,9 +1554,9 @@ NativeAccess(
{
DWORD attr;
- attr = GetFileAttributes(nativePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
- if (attr == INVALID_FILE_ATTRIBUTES) {
+ if (attr == 0xffffffff) {
/*
* File might not exist.
*/
@@ -1596,8 +1612,7 @@ NativeAccess(
* what permissions the OS has set for a file.
*/
-#ifdef UNICODE
- {
+ if (tclWinProcs->getFileSecurityProc != NULL) {
SECURITY_DESCRIPTOR *sdPtr = NULL;
unsigned long size;
PSID pSid = 0;
@@ -1612,11 +1627,11 @@ NativeAccess(
int error;
/*
- * First find out how big the buffer needs to be.
+ * First find out how big the buffer needs to be
*/
size = 0;
- GetFileSecurity(nativePath,
+ (*tclWinProcs->getFileSecurityProc)(nativePath,
OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION,
0, 0, &size);
@@ -1650,7 +1665,7 @@ NativeAccess(
* Call GetFileSecurity() for real.
*/
- if (!GetFileSecurity(nativePath,
+ if (!(*tclWinProcs->getFileSecurityProc)(nativePath,
OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION,
sdPtr, size, &size)) {
@@ -1686,14 +1701,14 @@ NativeAccess(
* thread token.
*/
- if (!ImpersonateSelf(SecurityImpersonation)) {
+ if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) {
/*
* Unable to perform security impersonation.
*/
goto accessError;
}
- if (!OpenThreadToken(GetCurrentThread(),
+ if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread(),
TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) {
/*
* Unable to get current thread's token.
@@ -1702,7 +1717,7 @@ NativeAccess(
goto accessError;
}
- RevertToSelf();
+ (*tclWinProcs->revertToSelfProc)();
/*
* Setup desiredAccess according to the access priveleges we are
@@ -1729,7 +1744,7 @@ NativeAccess(
* Perform access check using the token.
*/
- if (!AccessCheck(sdPtr, hToken, desiredAccess,
+ if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess,
&genMap, &privSet, &privSetSize, &grantedAccess,
&accessYesNo)) {
/*
@@ -1759,7 +1774,6 @@ NativeAccess(
}
}
-#endif /* !UNICODE */
return 0;
}
@@ -1779,22 +1793,55 @@ NativeAccess(
static int
NativeIsExec(
- const TCHAR *path)
+ const TCHAR *nativePath)
{
- int len = _tcslen(path);
+ if (tclWinProcs->useWide) {
+ const WCHAR *path = (const WCHAR *) nativePath;
+ int len = wcslen(path);
- if (len < 5) {
- return 0;
- }
+ if (len < 5) {
+ return 0;
+ }
- if (path[len-4] != '.') {
- return 0;
- }
+ if (path[len-4] != L'.') {
+ return 0;
+ }
+
+ /*
+ * Use wide-char case-insensitive comparison
+ */
+
+ if ((_wcsicmp(path+len-3, L"exe") == 0)
+ || (_wcsicmp(path+len-3, L"com") == 0)
+ || (_wcsicmp(path+len-3, L"bat") == 0)) {
+ return 1;
+ }
+ } else {
+ const char *p;
+
+ /*
+ * We are only looking for pure ascii.
+ */
+
+ p = strrchr((const char *) nativePath, '.');
+ if (p != NULL) {
+ p++;
+
+ /*
+ * Note: in the old code, stat considered '.pif' files as
+ * executable, whereas access did not.
+ */
+
+ if ((strcasecmp(p, "exe") == 0)
+ || (strcasecmp(p, "com") == 0)
+ || (strcasecmp(p, "bat") == 0)) {
+ /*
+ * File that ends with .exe, .com, or .bat is executable.
+ */
- if ((_tcsicmp(path+len-3, TEXT("exe")) == 0)
- || (_tcsicmp(path+len-3, TEXT("com")) == 0)
- || (_tcsicmp(path+len-3, TEXT("bat")) == 0)) {
- return 1;
+ return 1;
+ }
+ }
}
return 0;
}
@@ -1822,12 +1869,12 @@ TclpObjChdir(
int result;
const TCHAR *nativePath;
- nativePath = Tcl_FSGetNativePath(pathPtr);
+ nativePath = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
if (!nativePath) {
return -1;
}
- result = SetCurrentDirectory(nativePath);
+ result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
if (result == 0) {
TclWinConvertError(GetLastError());
@@ -1864,16 +1911,14 @@ TclpGetCwd(
Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
* name of current directory. */
{
- TCHAR buffer[MAX_PATH];
+ WCHAR buffer[MAX_PATH];
char *p;
- WCHAR *native;
- if (GetCurrentDirectory(MAX_PATH, buffer) == 0) {
+ if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
TclWinConvertError(GetLastError());
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "error getting working directory name: %s",
- Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "error getting working directory name: ",
+ Tcl_PosixError(interp), NULL);
}
return NULL;
}
@@ -1882,12 +1927,25 @@ TclpGetCwd(
* Watch for the weird Windows c:\\UNC syntax.
*/
- native = (WCHAR *) buffer;
- if ((native[0] != '\0') && (native[1] == ':')
- && (native[2] == '\\') && (native[3] == '\\')) {
- native += 2;
+ if (tclWinProcs->useWide) {
+ WCHAR *native;
+
+ native = (WCHAR *) buffer;
+ if ((native[0] != '\0') && (native[1] == ':')
+ && (native[2] == '\\') && (native[3] == '\\')) {
+ native += 2;
+ }
+ Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
+ } else {
+ char *native;
+
+ native = (char *) buffer;
+ if ((native[0] != '\0') && (native[1] == ':')
+ && (native[2] == '\\') && (native[3] == '\\')) {
+ native += 2;
+ }
+ Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
}
- Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
/*
* Convert to forward slashes for easier use in scripts.
@@ -1914,7 +1972,8 @@ TclpObjStat(
TclWinFlushDirtyChannels();
- return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 0);
+ return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr),
+ statPtr, 0);
}
/*
@@ -1960,7 +2019,7 @@ NativeStat(
* simpler routines.
*/
- fileHandle = CreateFile(nativePath, GENERIC_READ,
+ fileHandle = (tclWinProcs->createFileProc)(nativePath, GENERIC_READ,
FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
@@ -1999,24 +2058,24 @@ NativeStat(
*/
inode = data.nFileIndexHigh | data.nFileIndexLow;
- } else {
+ } else if (tclWinProcs->getFileAttributesExProc != NULL) {
/*
* Fall back on the less capable routines. This means no nlink or ino.
*/
WIN32_FILE_ATTRIBUTE_DATA data;
- if (GetFileAttributesEx(nativePath,
+ if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
GetFileExInfoStandard, &data) != TRUE) {
HANDLE hFind;
- WIN32_FIND_DATA ffd;
+ WIN32_FIND_DATAT ffd;
DWORD lasterror = GetLastError();
if (lasterror != ERROR_SHARING_VIOLATION) {
TclWinConvertError(lasterror);
return -1;
}
- hFind = FindFirstFile(nativePath, &ffd);
+ hFind = (*tclWinProcs->findFirstFileProc)(nativePath, &ffd);
if (hFind == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
return -1;
@@ -2032,6 +2091,46 @@ NativeStat(
statPtr->st_atime = ToCTime(data.ftLastAccessTime);
statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
statPtr->st_ctime = ToCTime(data.ftCreationTime);
+ } else {
+ /*
+ * We don't have the faster attributes proc, so we're probably running
+ * on Win95.
+ */
+
+ WIN32_FIND_DATAT data;
+ HANDLE handle;
+
+ handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
+ if (handle == INVALID_HANDLE_VALUE) {
+ /*
+ * FindFirstFile() doesn't work on root directories, so call
+ * GetFileAttributes() to see if the specified file exists.
+ */
+
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr == INVALID_FILE_ATTRIBUTES) {
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
+
+ /*
+ * Make up some fake information for this file. It has the correct
+ * file attributes and a time of 0.
+ */
+
+ memset(&data, 0, sizeof(data));
+ data.a.dwFileAttributes = attr;
+ } else {
+ FindClose(handle);
+ }
+
+ attr = data.a.dwFileAttributes;
+
+ statPtr->st_size = ((Tcl_WideInt) data.a.nFileSizeLow) |
+ (((Tcl_WideInt) data.a.nFileSizeHigh) << 32);
+ statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
+ statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
+ statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
}
dev = NativeDev(nativePath);
@@ -2063,12 +2162,14 @@ NativeDev(
{
int dev;
Tcl_DString ds;
- TCHAR nativeFullPath[MAX_PATH];
+ WCHAR nativeFullPath[MAX_PATH];
TCHAR *nativePart;
const char *fullPath;
- GetFullPathName(nativePath, MAX_PATH, nativeFullPath, &nativePart);
- fullPath = Tcl_WinTCharToUtf(nativeFullPath, -1, &ds);
+ (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH,
+ nativeFullPath, &nativePart);
+
+ fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
const char *p;
@@ -2084,14 +2185,15 @@ NativeDev(
* won't work.
*/
- fullPath = TclDStringAppendLiteral(&ds, "\\");
+ fullPath = Tcl_DStringAppend(&ds, "\\", 1);
p = fullPath + Tcl_DStringLength(&ds);
} else {
p++;
}
nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
dw = (DWORD) -1;
- GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0);
+ (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
+ NULL, NULL, NULL, 0);
/*
* GetFullPathName() turns special devices like "NUL" into "\\.\NUL",
@@ -2203,9 +2305,8 @@ FromCTime(
FILETIME *fileTime) /* UTC Time */
{
LARGE_INTEGER convertedTime;
-
convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000
- + POSIX_EPOCH_AS_FILETIME;
+ + POSIX_EPOCH_AS_FILETIME;
fileTime->dwLowDateTime = convertedTime.LowPart;
fileTime->dwHighDateTime = convertedTime.HighPart;
}
@@ -2235,20 +2336,34 @@ ClientData
TclpGetNativeCwd(
ClientData clientData)
{
- TCHAR buffer[MAX_PATH];
+ WCHAR buffer[MAX_PATH];
- if (GetCurrentDirectory(MAX_PATH, buffer) == 0) {
+ if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
TclWinConvertError(GetLastError());
return NULL;
}
if (clientData != NULL) {
- if (_tcscmp((const TCHAR*)clientData, buffer) == 0) {
- return clientData;
+ if (tclWinProcs->useWide) {
+ /*
+ * Unicode representation when running on NT/2K/XP.
+ */
+
+ if (wcscmp((const WCHAR*)clientData, (const WCHAR*)buffer) == 0) {
+ return clientData;
+ }
+ } else {
+ /*
+ * ANSI representation when running on 95/98/ME.
+ */
+
+ if (strcmp((const char*) clientData, (const char*) buffer) == 0) {
+ return clientData;
+ }
}
}
- return TclNativeDupInternalRep(buffer);
+ return TclNativeDupInternalRep((ClientData) buffer);
}
int
@@ -2256,7 +2371,7 @@ TclpObjAccess(
Tcl_Obj *pathPtr,
int mode)
{
- return NativeAccess(Tcl_FSGetNativePath(pathPtr), mode);
+ return NativeAccess((const TCHAR *) Tcl_FSGetNativePath(pathPtr), mode);
}
int
@@ -2272,7 +2387,8 @@ TclpObjLstat(
TclWinFlushDirtyChannels();
- return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 1);
+ return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr),
+ statPtr, 1);
}
#ifdef S_IFLNK
@@ -2284,15 +2400,15 @@ TclpObjLink(
{
if (toPtr != NULL) {
int res;
- const TCHAR *LinkTarget;
- const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr);
+ TCHAR *LinkTarget;
+ TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr);
Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr);
if (normalizedToPtr == NULL) {
return NULL;
}
- LinkTarget = Tcl_FSGetNativePath(normalizedToPtr);
+ LinkTarget = (TCHAR *) Tcl_FSGetNativePath(normalizedToPtr);
if (LinkSource == NULL || LinkTarget == NULL) {
return NULL;
@@ -2304,7 +2420,7 @@ TclpObjLink(
return NULL;
}
} else {
- const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr);
+ TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr);
if (LinkSource == NULL) {
return NULL;
@@ -2312,7 +2428,7 @@ TclpObjLink(
return WinReadLink(LinkSource);
}
}
-#endif /* S_IFLNK */
+#endif
/*
*---------------------------------------------------------------------------
@@ -2338,7 +2454,7 @@ TclpFilesystemPathType(
{
#define VOL_BUF_SIZE 32
int found;
- TCHAR volType[VOL_BUF_SIZE];
+ WCHAR volType[VOL_BUF_SIZE];
char *firstSeparator;
const char *path;
Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
@@ -2353,14 +2469,16 @@ TclpFilesystemPathType(
firstSeparator = strchr(path, '/');
if (firstSeparator == NULL) {
- found = GetVolumeInformation(Tcl_FSGetNativePath(pathPtr),
- NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
+ found = tclWinProcs->getVolumeInformationProc(
+ Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL,
+ (WCHAR *) volType, VOL_BUF_SIZE);
} else {
Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
Tcl_IncrRefCount(driveName);
- found = GetVolumeInformation(Tcl_FSGetNativePath(driveName),
- NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
+ found = tclWinProcs->getVolumeInformationProc(
+ Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL,
+ (WCHAR *) volType, VOL_BUF_SIZE);
Tcl_DecrRefCount(driveName);
}
@@ -2368,9 +2486,13 @@ TclpFilesystemPathType(
return NULL;
} else {
Tcl_DString ds;
+ Tcl_Obj *objPtr;
- Tcl_WinTCharToUtf(volType, -1, &ds);
- return TclDStringToObj(&ds);
+ Tcl_WinTCharToUtf((const char *) volType, -1, &ds);
+ objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ return objPtr;
}
#undef VOL_BUF_SIZE
}
@@ -2420,219 +2542,377 @@ TclpObjNormalizePath(
Tcl_DString dsNorm; /* This will hold the normalized string. */
char *path, *currentPathEndPosition;
Tcl_Obj *temp = NULL;
- int isDrive = 1;
- Tcl_DString ds; /* Some workspace. */
Tcl_DStringInit(&dsNorm);
path = Tcl_GetString(pathPtr);
- currentPathEndPosition = path + nextCheckpoint;
- if (*currentPathEndPosition == '/') {
- currentPathEndPosition++;
- }
- while (1) {
- char cur = *currentPathEndPosition;
+ if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
+ /*
+ * We're on Win95, 98 or ME. There are two assumptions in this block
+ * of code. First that the native (NULL) encoding is basically ascii,
+ * and second that symbolic links are not possible. Both of these
+ * assumptions appear to be true of these operating systems.
+ */
- if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) {
- /*
- * Reached directory separator, or end of string.
- */
+ int isDrive = 1;
+ Tcl_DString ds;
+
+ currentPathEndPosition = path + nextCheckpoint;
+ if (*currentPathEndPosition == '/') {
+ currentPathEndPosition++;
+ }
+
+ while (1) {
+ char cur = *currentPathEndPosition;
+
+ if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) {
+ /*
+ * Reached directory separator, or end of string.
+ */
- WIN32_FILE_ATTRIBUTE_DATA data;
- const TCHAR *nativePath = Tcl_WinUtfToTChar(path,
- currentPathEndPosition - path, &ds);
+ const char *nativePath = Tcl_UtfToExternalDString(NULL, path,
+ currentPathEndPosition - path, &ds);
- if (GetFileAttributesEx(nativePath,
- GetFileExInfoStandard, &data) != TRUE) {
/*
- * File doesn't exist.
+ * Now we convert the tail of the current path to its 'long
+ * form', and append it to 'dsNorm' which holds the current
+ * normalized path, if the file exists.
*/
if (isDrive) {
- int len = WinIsReserved(path);
+ if (GetFileAttributesA(nativePath)
+ == INVALID_FILE_ATTRIBUTES) {
+ /*
+ * File doesn't exist.
+ */
- if (len > 0) {
+ if (isDrive) {
+ int len = WinIsReserved(path);
+
+ if (len > 0) {
+ /*
+ * Actually it does exist - COM1, etc.
+ */
+
+ int i;
+
+ for (i=0 ; i<len ; i++) {
+ if (nativePath[i] >= 'a') {
+ ((char *) nativePath)[i] -= ('a'-'A');
+ }
+ }
+ Tcl_DStringAppend(&dsNorm, nativePath, len);
+ lastValidPathEnd = currentPathEndPosition;
+ } else if (nextCheckpoint == 0) {
+ /* Path starts with a drive designation
+ * that's not actually on the system.
+ * We still must normalize up past the
+ * first separator. [Bug 3603434] */
+ currentPathEndPosition++;
+ }
+ }
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ if (nativePath[0] >= 'a') {
+ ((char *) nativePath)[0] -= ('a' - 'A');
+ }
+ Tcl_DStringAppend(&dsNorm, nativePath,
+ Tcl_DStringLength(&ds));
+ } else {
+ char *checkDots = NULL;
+
+ if (lastValidPathEnd[1] == '.') {
+ checkDots = lastValidPathEnd + 1;
+ while (checkDots < currentPathEndPosition) {
+ if (*checkDots != '.') {
+ checkDots = NULL;
+ break;
+ }
+ checkDots++;
+ }
+ }
+ if (checkDots != NULL) {
+ int dotLen = currentPathEndPosition-lastValidPathEnd;
+
+ /*
+ * Path is just dots. We shouldn't really ever see a
+ * path like that. However, to be nice we at least
+ * don't mangle the path - we just add the dots as a
+ * path segment and continue
+ */
+
+ Tcl_DStringAppend(&dsNorm, (TCHAR *)
+ (nativePath + Tcl_DStringLength(&ds)-dotLen),
+ dotLen);
+ } else {
/*
- * Actually it does exist - COM1, etc.
+ * Normal path.
*/
- int i;
+ WIN32_FIND_DATA fData;
+ HANDLE handle;
- for (i=0 ; i<len ; i++) {
- WCHAR wc = ((WCHAR *) nativePath)[i];
+ handle = FindFirstFileA(nativePath, &fData);
+ if (handle == INVALID_HANDLE_VALUE) {
+ if (GetFileAttributesA(nativePath)
+ == INVALID_FILE_ATTRIBUTES) {
+ /*
+ * File doesn't exist.
+ */
- if (wc >= L'a') {
- wc -= (L'a' - L'A');
- ((WCHAR *) nativePath)[i] = wc;
+ Tcl_DStringFree(&ds);
+ break;
}
+
+ /*
+ * This is usually the '/' in 'c:/' at end of
+ * string.
+ */
+
+ Tcl_DStringAppend(&dsNorm,"/", 1);
+ } else {
+ char *nativeName;
+
+ if (fData.cFileName[0] != '\0') {
+ nativeName = fData.cFileName;
+ } else {
+ nativeName = fData.cAlternateFileName;
+ }
+ FindClose(handle);
+ Tcl_DStringAppend(&dsNorm,"/", 1);
+ Tcl_DStringAppend(&dsNorm,nativeName,-1);
}
- Tcl_DStringAppend(&dsNorm,
- (const char *)nativePath,
- (int)(sizeof(WCHAR) * len));
- lastValidPathEnd = currentPathEndPosition;
- } else if (nextCheckpoint == 0) {
- /* Path starts with a drive designation
- * that's not actually on the system.
- * We still must normalize up past the
- * first separator. [Bug 3603434] */
- currentPathEndPosition++;
}
}
Tcl_DStringFree(&ds);
- break;
+ lastValidPathEnd = currentPathEndPosition;
+ if (cur == 0) {
+ break;
+ }
+
+ /*
+ * If we get here, we've got past one directory delimiter, so
+ * we know it is no longer a drive.
+ */
+
+ isDrive = 0;
}
+ currentPathEndPosition++;
+ }
+ } else {
+ /*
+ * We're on WinNT (or 2000 or XP; something with an NT core).
+ */
- /*
- * File 'nativePath' does exist if we get here. We now want to
- * check if it is a symlink and otherwise continue with the
- * rest of the path.
- */
+ int isDrive = 1;
+ Tcl_DString ds;
- /*
- * Check for symlinks, except at last component of path (we
- * don't follow final symlinks). Also a drive (C:/) for
- * example, may sometimes have the reparse flag set for some
- * reason I don't understand. We therefore don't perform this
- * check for drives.
- */
+ currentPathEndPosition = path + nextCheckpoint;
+ if (*currentPathEndPosition == '/') {
+ currentPathEndPosition++;
+ }
+ while (1) {
+ char cur = *currentPathEndPosition;
+
+ if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) {
+ /*
+ * Reached directory separator, or end of string.
+ */
- if (cur != 0 && !isDrive &&
- data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){
- Tcl_Obj *to = WinReadLinkDirectory(nativePath);
+ WIN32_FILE_ATTRIBUTE_DATA data;
+ const char *nativePath = Tcl_WinUtfToTChar(path,
+ currentPathEndPosition - path, &ds);
- if (to != NULL) {
+ if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
+ GetFileExInfoStandard, &data) != TRUE) {
/*
- * Read the reparse point ok. Now, reparse points need
- * not be normalized, otherwise we could use:
- *
- * Tcl_GetStringFromObj(to, &pathLen);
- * nextCheckpoint = pathLen;
- *
- * So, instead we have to start from the beginning.
+ * File doesn't exist.
*/
- nextCheckpoint = 0;
- Tcl_AppendToObj(to, currentPathEndPosition, -1);
+ if (isDrive) {
+ int len = WinIsReserved(path);
- /*
- * Convert link to forward slashes.
- */
+ if (len > 0) {
+ /*
+ * Actually it does exist - COM1, etc.
+ */
- for (path = Tcl_GetString(to); *path != 0; path++) {
- if (*path == '\\') {
- *path = '/';
- }
- }
- path = Tcl_GetString(to);
- currentPathEndPosition = path + nextCheckpoint;
- if (temp != NULL) {
- Tcl_DecrRefCount(temp);
- }
- temp = to;
+ int i;
- /*
- * Reset variables so we can restart normalization.
- */
+ for (i=0 ; i<len ; i++) {
+ WCHAR wc = ((WCHAR *) nativePath)[i];
- isDrive = 1;
- Tcl_DStringFree(&dsNorm);
+ if (wc >= L'a') {
+ wc -= (L'a' - L'A');
+ ((WCHAR *) nativePath)[i] = wc;
+ }
+ }
+ Tcl_DStringAppend(&dsNorm, nativePath,
+ (int)(sizeof(WCHAR) * len));
+ lastValidPathEnd = currentPathEndPosition;
+ } else if (nextCheckpoint == 0) {
+ /* Path starts with a drive designation
+ * that's not actually on the system.
+ * We still must normalize up past the
+ * first separator. [Bug 3603434] */
+ currentPathEndPosition++;
+ }
+ }
Tcl_DStringFree(&ds);
- continue;
+ break;
}
- }
-#ifndef TclNORM_LONG_PATH
- /*
- * Now we convert the tail of the current path to its 'long
- * form', and append it to 'dsNorm' which holds the current
- * normalized path
- */
+ /*
+ * File 'nativePath' does exist if we get here. We now want to
+ * check if it is a symlink and otherwise continue with the
+ * rest of the path.
+ */
- if (isDrive) {
- WCHAR drive = ((WCHAR *) nativePath)[0];
+ /*
+ * Check for symlinks, except at last component of path (we
+ * don't follow final symlinks). Also a drive (C:/) for
+ * example, may sometimes have the reparse flag set for some
+ * reason I don't understand. We therefore don't perform this
+ * check for drives.
+ */
- if (drive >= L'a') {
- drive -= (L'a' - L'A');
- ((WCHAR *) nativePath)[0] = drive;
- }
- Tcl_DStringAppend(&dsNorm, (const char *)nativePath,
- Tcl_DStringLength(&ds));
- } else {
- char *checkDots = NULL;
-
- if (lastValidPathEnd[1] == '.') {
- checkDots = lastValidPathEnd + 1;
- while (checkDots < currentPathEndPosition) {
- if (*checkDots != '.') {
- checkDots = NULL;
- break;
+ if (cur != 0 && !isDrive &&
+ data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){
+ Tcl_Obj *to = WinReadLinkDirectory(nativePath);
+
+ if (to != NULL) {
+ /*
+ * Read the reparse point ok. Now, reparse points need
+ * not be normalized, otherwise we could use:
+ *
+ * Tcl_GetStringFromObj(to, &pathLen);
+ * nextCheckpoint = pathLen
+ *
+ * So, instead we have to start from the beginning.
+ */
+
+ nextCheckpoint = 0;
+ Tcl_AppendToObj(to, currentPathEndPosition, -1);
+
+ /*
+ * Convert link to forward slashes.
+ */
+
+ for (path = Tcl_GetString(to); *path != 0; path++) {
+ if (*path == '\\') {
+ *path = '/';
+ }
+ }
+ path = Tcl_GetString(to);
+ currentPathEndPosition = path + nextCheckpoint;
+ if (temp != NULL) {
+ Tcl_DecrRefCount(temp);
}
- checkDots++;
+ temp = to;
+
+ /*
+ * Reset variables so we can restart normalization.
+ */
+
+ isDrive = 1;
+ Tcl_DStringFree(&dsNorm);
+ Tcl_DStringInit(&dsNorm);
+ Tcl_DStringFree(&ds);
+ continue;
}
}
- if (checkDots != NULL) {
- int dotLen = currentPathEndPosition-lastValidPathEnd;
- /*
- * Path is just dots. We shouldn't really ever see a
- * path like that. However, to be nice we at least
- * don't mangle the path - we just add the dots as a
- * path segment and continue.
- */
+#ifndef TclNORM_LONG_PATH
+ /*
+ * Now we convert the tail of the current path to its 'long
+ * form', and append it to 'dsNorm' which holds the current
+ * normalized path
+ */
- Tcl_DStringAppend(&dsNorm, ((const char *)nativePath)
- + Tcl_DStringLength(&ds)
- - (dotLen * sizeof(TCHAR)),
- (int)(dotLen * sizeof(TCHAR)));
+ if (isDrive) {
+ WCHAR drive = ((WCHAR *) nativePath)[0];
+ if (drive >= L'a') {
+ drive -= (L'a' - L'A');
+ ((WCHAR *) nativePath)[0] = drive;
+ }
+ Tcl_DStringAppend(&dsNorm, nativePath,
+ Tcl_DStringLength(&ds));
} else {
- /*
- * Normal path.
- */
-
- WIN32_FIND_DATAW fData;
- HANDLE handle;
+ char *checkDots = NULL;
+
+ if (lastValidPathEnd[1] == '.') {
+ checkDots = lastValidPathEnd + 1;
+ while (checkDots < currentPathEndPosition) {
+ if (*checkDots != '.') {
+ checkDots = NULL;
+ break;
+ }
+ checkDots++;
+ }
+ }
+ if (checkDots != NULL) {
+ int dotLen = currentPathEndPosition-lastValidPathEnd;
- handle = FindFirstFileW((WCHAR *) nativePath, &fData);
- if (handle == INVALID_HANDLE_VALUE) {
/*
- * This is usually the '/' in 'c:/' at end of
- * string.
+ * Path is just dots. We shouldn't really ever see a
+ * path like that. However, to be nice we at least
+ * don't mangle the path - we just add the dots as a
+ * path segment and continue.
*/
- Tcl_DStringAppend(&dsNorm, (const char *) L"/",
- sizeof(WCHAR));
+ Tcl_DStringAppend(&dsNorm, (TCHAR *)
+ ((WCHAR*)(nativePath + Tcl_DStringLength(&ds))
+ - dotLen), (int)(dotLen * sizeof(WCHAR)));
} else {
- WCHAR *nativeName;
+ /*
+ * Normal path.
+ */
+
+ WIN32_FIND_DATAW fData;
+ HANDLE handle;
- if (fData.cFileName[0] != '\0') {
- nativeName = fData.cFileName;
+ handle = FindFirstFileW((WCHAR *) nativePath, &fData);
+ if (handle == INVALID_HANDLE_VALUE) {
+ /*
+ * This is usually the '/' in 'c:/' at end of
+ * string.
+ */
+
+ Tcl_DStringAppend(&dsNorm, (const char *) L"/",
+ sizeof(WCHAR));
} else {
- nativeName = fData.cAlternateFileName;
+ WCHAR *nativeName;
+
+ if (fData.cFileName[0] != '\0') {
+ nativeName = fData.cFileName;
+ } else {
+ nativeName = fData.cAlternateFileName;
+ }
+ FindClose(handle);
+ Tcl_DStringAppend(&dsNorm, (const char *) L"/",
+ sizeof(WCHAR));
+ Tcl_DStringAppend(&dsNorm, (TCHAR *) nativeName,
+ (int) (wcslen(nativeName)*sizeof(WCHAR)));
}
- FindClose(handle);
- Tcl_DStringAppend(&dsNorm, (const char *) L"/",
- sizeof(WCHAR));
- Tcl_DStringAppend(&dsNorm,
- (const char *) nativeName,
- (int) (wcslen(nativeName)*sizeof(WCHAR)));
}
}
- }
-#endif /* !TclNORM_LONG_PATH */
- Tcl_DStringFree(&ds);
- lastValidPathEnd = currentPathEndPosition;
- if (cur == 0) {
- break;
- }
+#endif
+ Tcl_DStringFree(&ds);
+ lastValidPathEnd = currentPathEndPosition;
+ if (cur == 0) {
+ break;
+ }
- /*
- * If we get here, we've got past one directory delimiter, so
- * we know it is no longer a drive.
- */
+ /*
+ * If we get here, we've got past one directory delimiter, so
+ * we know it is no longer a drive.
+ */
- isDrive = 0;
+ isDrive = 0;
+ }
+ currentPathEndPosition++;
}
- currentPathEndPosition++;
#ifdef TclNORM_LONG_PATH
/*
@@ -2641,10 +2921,10 @@ TclpObjNormalizePath(
if (1) {
WCHAR wpath[MAX_PATH];
- const TCHAR *nativePath =
+ const char *nativePath =
Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds);
- DWORD wpathlen = GetLongPathNameProc(nativePath,
- (TCHAR *) wpath, MAX_PATH);
+ DWORD wpathlen = (*tclWinProcs->getLongPathNameProc)(
+ nativePath, (TCHAR *) wpath, MAX_PATH);
/*
* We have to make the drive letter uppercase.
@@ -2653,11 +2933,10 @@ TclpObjNormalizePath(
if (wpath[0] >= L'a') {
wpath[0] -= (L'a' - L'A');
}
- Tcl_DStringAppend(&dsNorm, (const char *) wpath,
- wpathlen * sizeof(WCHAR));
+ Tcl_DStringAppend(&dsNorm, (TCHAR*)wpath, wpathlen*sizeof(WCHAR));
Tcl_DStringFree(&ds);
}
-#endif /* TclNORM_LONG_PATH */
+#endif
}
/*
@@ -2672,9 +2951,11 @@ TclpObjNormalizePath(
* native encoding, so we have to convert it to Utf.
*/
- Tcl_WinTCharToUtf((const TCHAR *) Tcl_DStringValue(&dsNorm),
- Tcl_DStringLength(&dsNorm), &ds);
- nextCheckpoint = Tcl_DStringLength(&ds);
+ Tcl_DString dsTemp;
+
+ Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm),
+ Tcl_DStringLength(&dsNorm), &dsTemp);
+ nextCheckpoint = Tcl_DStringLength(&dsTemp);
if (*lastValidPathEnd != 0) {
/*
* Not the end of the string.
@@ -2684,7 +2965,7 @@ TclpObjNormalizePath(
char *path;
Tcl_Obj *tmpPathPtr;
- tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
nextCheckpoint);
Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
path = Tcl_GetStringFromObj(tmpPathPtr, &len);
@@ -2695,9 +2976,10 @@ TclpObjNormalizePath(
* End of string was reached above.
*/
- Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint);
+ Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),
+ nextCheckpoint);
}
- Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&dsTemp);
}
Tcl_DStringFree(&dsNorm);
@@ -2709,7 +2991,6 @@ TclpObjNormalizePath(
if (temp != NULL) {
Tcl_DecrRefCount(temp);
}
-
return nextCheckpoint;
}
@@ -2849,7 +3130,7 @@ TclpNativeToNormalized(
int len;
char *copy, *p;
- Tcl_WinTCharToUtf((const TCHAR *) clientData, -1, &ds);
+ Tcl_WinTCharToUtf((const char *) clientData, -1, &ds);
copy = Tcl_DStringValue(&ds);
len = Tcl_DStringLength(&ds);
@@ -2905,11 +3186,10 @@ ClientData
TclNativeCreateNativeRep(
Tcl_Obj *pathPtr)
{
- WCHAR *nativePathPtr = NULL;
- const char *str;
+ char *nativePathPtr, *str;
+ Tcl_DString ds;
Tcl_Obj *validPathPtr;
- size_t len;
- WCHAR *wp;
+ int len;
if (TclFSCwdIsNative()) {
/*
@@ -2922,7 +3202,6 @@ TclNativeCreateNativeRep(
if (validPathPtr == NULL) {
return NULL;
}
- /* refCount of validPathPtr was already incremented in Tcl_FSGetTranslatedPath */
} else {
/*
* Make sure the normalized path is set.
@@ -2932,86 +3211,87 @@ TclNativeCreateNativeRep(
if (validPathPtr == NULL) {
return NULL;
}
- /* validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl, so incr refCount here */
Tcl_IncrRefCount(validPathPtr);
}
- str = Tcl_GetString(validPathPtr);
- len = validPathPtr->length;
-
- if (strlen(str)!=(unsigned int)len) {
- /* String contains NUL-bytes. This is invalid. */
- goto done;
- }
- /* For a reserved device, strip a possible postfix ':' */
- len = WinIsReserved(str);
- if (len == 0) {
- /* Let MultiByteToWideChar check for other invalid sequences, like
- * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames */
- len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0);
- if (len==0) {
- goto done;
- }
- }
- /* Overallocate 6 chars, making some room for extended paths */
- wp = nativePathPtr = ckalloc( (len+6) * sizeof(WCHAR) );
- if (nativePathPtr==0) {
- goto done;
- }
- MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len+1);
- /*
- ** If path starts with "//?/" or "\\?\" (extended path), translate
- ** any slashes to backslashes but leave the '?' intact
- */
- if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
- && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
- wp[0] = wp[1] = wp[3] = '\\';
- str += 4;
- wp += 4;
- }
- /*
- ** If there is no "\\?\" prefix but there is a drive or UNC
- ** path prefix and the path is larger than MAX_PATH chars,
- ** no Win32 API function can handle that unless it is
- ** prefixed with the extended path prefix. See:
- ** <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath>
- **/
- if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
- && str[1]==':') {
- if (wp==nativePathPtr && len>MAX_PATH && (str[2]=='\\' || str[2]=='/')) {
- memmove(wp+4, wp, len*sizeof(WCHAR));
- memcpy(wp, L"\\\\?\\", 4*sizeof(WCHAR));
+ str = Tcl_GetStringFromObj(validPathPtr, &len);
+ Tcl_WinUtfToTChar(str, len, &ds);
+ if (tclWinProcs->useWide) {
+ WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds);
+ /* For a reserved device, strip a possible postfix ':' */
+ len = WinIsReserved(str);
+ /* For normal devices */
+ if (len == 0) len = Tcl_DStringLength(&ds)>>1;
+ /*
+ ** If path starts with "//?/" or "\\?\" (extended path), translate
+ ** any slashes to backslashes but accept the '?' as being valid.
+ */
+ if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
+ && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
+ wp[0] = wp[1] = wp[3] = '\\';
+ str += 4;
wp += 4;
+ len -= 4;
}
/*
- ** If (remainder of) path starts with "<drive>:",
- ** leave the ':' intact.
- */
- wp += 2;
- } else if (wp==nativePathPtr && len>MAX_PATH
- && (str[0]=='\\' || str[0]=='/')
- && (str[1]=='\\' || str[1]=='/') && str[2]!='?') {
- memmove(wp+6, wp, len*sizeof(WCHAR));
- memcpy(wp, L"\\\\?\\UNC", 7*sizeof(WCHAR));
- wp += 7;
- }
- /*
- ** In the remainder of the path, translate invalid characters to
- ** characters in the Unicode private use area.
- */
- while (*wp != '\0') {
- if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) {
- *wp |= 0xF000;
- } else if (*wp == '/') {
- *wp = '\\';
+ ** If there is a drive prefix, the ':' must be considered valid.
+ **/
+ if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
+ && str[1]==':') {
+ wp += 2;
+ len -= 2;
}
- ++wp;
+ while (len-->0) {
+ if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) {
+ Tcl_DecrRefCount(validPathPtr);
+ Tcl_DStringFree(&ds);
+ return NULL;
+ } else if (*wp=='/') {
+ *wp = '\\';
+ }
+ ++wp;
+ }
+ len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
+ } else {
+ char *p = Tcl_DStringValue(&ds);
+ len = Tcl_DStringLength(&ds);
+ /*
+ ** If path starts with "//?/" or "\\?\" (extended path), translate
+ ** any slashes to backslashes but accept the '?' as being valid.
+ */
+ if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
+ && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
+ p[0] = p[1] = p[3] = '\\';
+ str += 4;
+ p += 4;
+ len -= 4;
+ }
+ /*
+ ** If there is a drive prefix, the ':' must be considered valid.
+ **/
+ if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
+ && str[1]==':') {
+ p += 2;
+ len -= 2;
+ }
+ while (len-->0) {
+ if ((*p < ' ') || strchr("\"*:<>?|", *p)) {
+ Tcl_DecrRefCount(validPathPtr);
+ Tcl_DStringFree(&ds);
+ return NULL;
+ } else if (*p=='/') {
+ *p = '\\';
+ }
+ ++p;
+ }
+ len = Tcl_DStringLength(&ds) + sizeof(char);
}
+ Tcl_DecrRefCount(validPathPtr);
+ nativePathPtr = ckalloc((unsigned) len);
+ memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
- done:
-
- TclDecrRefCount(validPathPtr);
- return nativePathPtr;
+ Tcl_DStringFree(&ds);
+ return (ClientData) nativePathPtr;
}
/*
@@ -3042,11 +3322,23 @@ TclNativeDupInternalRep(
return NULL;
}
- len = sizeof(TCHAR) * (_tcslen((const TCHAR *) clientData) + 1);
+ if (tclWinProcs->useWide) {
+ /*
+ * Unicode representation when running on NT/2K/XP.
+ */
+
+ len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1);
+ } else {
+ /*
+ * ANSI representation when running on 95/98/ME.
+ */
+
+ len = sizeof(char) * (strlen((const char *) clientData) + 1);
+ }
- copy = ckalloc(len);
+ copy = (char *) ckalloc(len);
memcpy(copy, clientData, len);
- return copy;
+ return (ClientData) copy;
}
/*
@@ -3081,9 +3373,9 @@ TclpUtime(
FromCTime(tval->actime, &lastAccessTime);
FromCTime(tval->modtime, &lastModTime);
- native = Tcl_FSGetNativePath(pathPtr);
+ native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
- attr = GetFileAttributes(native);
+ attr = (*tclWinProcs->getFileAttributesProc)(native);
if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {
flags = FILE_FLAG_BACKUP_SEMANTICS;
@@ -3094,8 +3386,8 @@ TclpUtime(
* savings complications that utime gets wrong.
*/
- fileHandle = CreateFile(native, FILE_WRITE_ATTRIBUTES, 0, NULL,
- OPEN_EXISTING, flags, NULL);
+ fileHandle = (tclWinProcs->createFileProc)(native, FILE_WRITE_ATTRIBUTES,
+ 0, NULL, OPEN_EXISTING, flags, NULL);
if (fileHandle == INVALID_HANDLE_VALUE ||
!SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 8b600f6..4e860b2 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -83,12 +83,12 @@ typedef struct {
#define NUMPLATFORMS 4
-static const char *const platforms[NUMPLATFORMS] = {
+static char* platforms[NUMPLATFORMS] = {
"Win32s", "Windows 95", "Windows NT", "Windows CE"
};
#define NUMPROCESSORS 11
-static const char *const processors[NUMPROCESSORS] = {
+static char* processors[NUMPROCESSORS] = {
"intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
"amd64", "ia32_on_win64"
};
@@ -105,8 +105,8 @@ static TclInitProcessGlobalValueProc InitializeSourceLibraryDir;
static ProcessGlobalValue sourceLibraryDir =
{0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL};
-static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib);
-static int ToUtf(const WCHAR *wSrc, char *dst);
+static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib);
+static int ToUtf(CONST WCHAR *wSrc, char *dst);
/*
*---------------------------------------------------------------------------
@@ -135,11 +135,11 @@ TclpInitPlatform(void)
tclPlatform = TCL_PLATFORM_WINDOWS;
- /*
- * Initialize the winsock library. On Windows XP and higher this
- * can never fail.
- */
- WSAStartup(wVersionRequested, &wsaData);
+ /*
+ * Initialize the winsock library. On Windows XP and higher this
+ * can never fail.
+ */
+ WSAStartup(wVersionRequested, &wsaData);
#ifdef STATIC_BUILD
/*
@@ -178,7 +178,7 @@ TclpInitLibraryPath(
#define LIBRARY_SIZE 64
Tcl_Obj *pathPtr;
char installLib[LIBRARY_SIZE];
- const char *bytes;
+ char *bytes;
pathPtr = Tcl_NewObj();
@@ -215,7 +215,7 @@ TclpInitLibraryPath(
*encodingPtr = NULL;
bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = ckalloc((*lengthPtr) + 1);
+ *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1);
memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
Tcl_DecrRefCount(pathPtr);
}
@@ -242,14 +242,14 @@ TclpInitLibraryPath(
static void
AppendEnvironment(
Tcl_Obj *pathPtr,
- const char *lib)
+ CONST char *lib)
{
int pathc;
WCHAR wBuf[MAX_PATH];
char buf[MAX_PATH * TCL_UTF_MAX];
Tcl_Obj *objPtr;
Tcl_DString ds;
- const char **pathv;
+ CONST char **pathv;
char *shortlib;
/*
@@ -295,6 +295,8 @@ AppendEnvironment(
*/
if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
+ CONST char *str;
+
/*
* TCL_LIBRARY is set but refers to a different tcl installation
* than the current version. Try fiddling with the specified
@@ -304,13 +306,14 @@ AppendEnvironment(
pathv[pathc - 1] = shortlib;
Tcl_DStringInit(&ds);
- (void) Tcl_JoinPath(pathc, pathv, &ds);
- objPtr = TclDStringToObj(&ds);
+ str = Tcl_JoinPath(pathc, pathv, &ds);
+ objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
} else {
objPtr = Tcl_NewStringObj(buf, -1);
}
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- ckfree(pathv);
+ ckfree((char *) pathv);
}
}
@@ -410,7 +413,7 @@ InitializeSourceLibraryDir(
TclWinNoBackslash(name);
sprintf(end + 1, "../library");
*lengthPtr = strlen(name);
- *valuePtr = ckalloc(*lengthPtr + 1);
+ *valuePtr = ckalloc((unsigned int) *lengthPtr + 1);
*encodingPtr = NULL;
memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}
@@ -433,7 +436,7 @@ InitializeSourceLibraryDir(
static int
ToUtf(
- const WCHAR *wSrc,
+ CONST WCHAR *wSrc,
char *dst)
{
char *start;
@@ -450,6 +453,31 @@ ToUtf(
/*
*---------------------------------------------------------------------------
*
+ * TclWinEncodingsCleanup --
+ *
+ * Reset information to its original state in finalization to allow for
+ * reinitialization to be possible. This must not be called until after
+ * the filesystem has been finalised, or exit crashes may occur when
+ * using virtual filesystems.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Static information reset to startup state.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclWinEncodingsCleanup(void)
+{
+ TclWinResetInterfaceEncodings();
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* TclpSetInitialEncodings --
*
* Based on the locale, determine the encoding of the operating system
@@ -482,13 +510,18 @@ TclpSetInitialEncodings(void)
Tcl_DStringFree(&encodingName);
}
-void TclWinSetInterfaces(
- int dummy) /* Not used. */
+void
+TclpSetInterfaces(void)
{
- TclpSetInterfaces();
+ int platformId, useWide;
+
+ platformId = TclWinGetPlatformId();
+ useWide = ((platformId == VER_PLATFORM_WIN32_NT)
+ || (platformId == VER_PLATFORM_WIN32_CE));
+ TclWinSetInterfaces(useWide);
}
-const char *
+CONST char *
Tcl_GetEncodingNameFromEnvironment(
Tcl_DString *bufPtr)
{
@@ -520,7 +553,7 @@ void
TclpSetVariables(
Tcl_Interp *interp) /* Interp to initialize. */
{
- const char *ptr;
+ CONST char *ptr;
char buffer[TCL_INTEGER_SPACE * 2];
union {
SYSTEM_INFO info;
@@ -529,7 +562,7 @@ TclpSetVariables(
static OSVERSIONINFOW osInfo;
static int osInfoInitialized = 0;
Tcl_DString ds;
- TCHAR szUserName[UNLEN+1];
+ WCHAR szUserName[UNLEN+1];
DWORD cchUserNameLen = UNLEN;
Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
@@ -568,7 +601,7 @@ TclpSetVariables(
TCL_GLOBAL_ONLY);
}
-#ifdef _DEBUG
+#ifndef NDEBUG
/*
* The existence of the "debug" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with debug
@@ -613,21 +646,15 @@ TclpSetVariables(
Tcl_DStringInit(&ds);
if (TclGetEnv("USERNAME", &ds) == NULL) {
- if (GetUserName(szUserName, &cchUserNameLen) != 0) {
+ if (tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen) != 0) {
int cbUserNameLen = cchUserNameLen - 1;
- cbUserNameLen *= sizeof(TCHAR);
- Tcl_WinTCharToUtf(szUserName, cbUserNameLen, &ds);
+ if (tclWinProcs->useWide) cbUserNameLen *= sizeof(WCHAR);
+ Tcl_WinTCharToUtf((LPTSTR)szUserName, cbUserNameLen, &ds);
}
}
Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds);
-
- /*
- * Define what the platform PATH separator is. [TIP #315]
- */
-
- Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY);
}
/*
@@ -652,7 +679,7 @@ TclpSetVariables(
int
TclpFindVariable(
- const char *name, /* Name of desired environment variable
+ CONST char *name, /* Name of desired environment variable
* (UTF-8). */
int *lengthPtr) /* Used to return length of name (for
* successful searches) or number of non-NULL
@@ -660,7 +687,7 @@ TclpFindVariable(
* searches). */
{
int i, length, result = -1;
- register const char *env, *p1, *p2;
+ register CONST char *env, *p1, *p2;
char *envUpper, *nameUpper;
Tcl_DString envString;
@@ -669,7 +696,7 @@ TclpFindVariable(
*/
length = strlen(name);
- nameUpper = ckalloc(length + 1);
+ nameUpper = (char *) ckalloc((unsigned) length+1);
memcpy(nameUpper, name, (size_t) length+1);
Tcl_UtfToUpper(nameUpper);
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 9df424f..ccf48bb 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -32,6 +32,14 @@ typedef struct TCLEXCEPTION_REGISTRATION {
#endif
/*
+ * The following specifies how much stack space TclpCheckStackSpace()
+ * ensures is available. TclpCheckStackSpace() is called by Tcl_EvalObj()
+ * to help avoid overflowing the stack in the case of infinite recursion.
+ */
+
+#define TCL_WIN_STACK_THRESHOLD 0x8000
+
+/*
* Some versions of Borland C have a define for the OSVERSIONINFO for
* Win32s and for NT, but not for Windows 95.
* Define VER_PLATFORM_WIN32_CE for those without newer headers.
@@ -51,12 +59,124 @@ typedef struct TCLEXCEPTION_REGISTRATION {
#endif
/*
+ * The following structure keeps track of whether we are using the
+ * multi-byte or the wide-character interfaces to the operating system.
+ * System calls should be made through the following function table.
+ */
+
+typedef union {
+ WIN32_FIND_DATAA a;
+ WIN32_FIND_DATAW w;
+} WIN32_FIND_DATAT;
+
+typedef struct TclWinProcs {
+ int useWide;
+
+ BOOL (WINAPI *buildCommDCBProc)(CONST TCHAR *, LPDCB);
+ TCHAR *(WINAPI *charLowerProc)(TCHAR *);
+ BOOL (WINAPI *copyFileProc)(CONST TCHAR *, CONST TCHAR *, BOOL);
+ BOOL (WINAPI *createDirectoryProc)(CONST TCHAR *, LPSECURITY_ATTRIBUTES);
+ HANDLE (WINAPI *createFileProc)(CONST TCHAR *, DWORD, DWORD,
+ LPSECURITY_ATTRIBUTES, DWORD, DWORD, HANDLE);
+ BOOL (WINAPI *createProcessProc)(CONST TCHAR *, TCHAR *,
+ LPSECURITY_ATTRIBUTES, LPSECURITY_ATTRIBUTES, BOOL, DWORD,
+ LPVOID, CONST TCHAR *, LPSTARTUPINFOA, LPPROCESS_INFORMATION);
+ BOOL (WINAPI *deleteFileProc)(CONST TCHAR *);
+ HANDLE (WINAPI *findFirstFileProc)(CONST TCHAR *, WIN32_FIND_DATAT *);
+ BOOL (WINAPI *findNextFileProc)(HANDLE, WIN32_FIND_DATAT *);
+ BOOL (WINAPI *getComputerNameProc)(WCHAR *, LPDWORD);
+ DWORD (WINAPI *getCurrentDirectoryProc)(DWORD, WCHAR *);
+ DWORD (WINAPI *getFileAttributesProc)(CONST TCHAR *);
+ DWORD (WINAPI *getFullPathNameProc)(CONST TCHAR *, DWORD nBufferLength,
+ WCHAR *, TCHAR **);
+ DWORD (WINAPI *getModuleFileNameProc)(HMODULE, WCHAR *, int);
+ DWORD (WINAPI *getShortPathNameProc)(CONST TCHAR *, WCHAR *, DWORD);
+ UINT (WINAPI *getTempFileNameProc)(CONST TCHAR *, CONST TCHAR *, UINT,
+ WCHAR *);
+ DWORD (WINAPI *getTempPathProc)(DWORD, WCHAR *);
+ BOOL (WINAPI *getVolumeInformationProc)(CONST TCHAR *, WCHAR *, DWORD,
+ LPDWORD, LPDWORD, LPDWORD, WCHAR *, DWORD);
+ HINSTANCE (WINAPI *loadLibraryExProc)(CONST TCHAR *, HANDLE, DWORD);
+ TCHAR (WINAPI *lstrcpyProc)(WCHAR *, CONST TCHAR *);
+ BOOL (WINAPI *moveFileProc)(CONST TCHAR *, CONST TCHAR *);
+ BOOL (WINAPI *removeDirectoryProc)(CONST TCHAR *);
+ DWORD (WINAPI *searchPathProc)(CONST TCHAR *, CONST TCHAR *,
+ CONST TCHAR *, DWORD, WCHAR *, TCHAR **);
+ BOOL (WINAPI *setCurrentDirectoryProc)(CONST TCHAR *);
+ BOOL (WINAPI *setFileAttributesProc)(CONST TCHAR *, DWORD);
+ /*
+ * These two function pointers will only be set when
+ * Tcl_FindExecutable is called. If you don't ever call that
+ * function, the application will crash whenever WinTcl tries to call
+ * functions through these null pointers. That is not a bug in Tcl
+ * -- Tcl_FindExecutable is obligatory in recent Tcl releases.
+ */
+ BOOL (WINAPI *getFileAttributesExProc)(CONST TCHAR *,
+ GET_FILEEX_INFO_LEVELS, LPVOID);
+ BOOL (WINAPI *createHardLinkProc)(CONST TCHAR*, CONST TCHAR*,
+ LPSECURITY_ATTRIBUTES);
+
+ /* deleted INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *); */
+ /* These two are also NULL at start; see comment above */
+ HANDLE (WINAPI *findFirstFileExProc)(CONST TCHAR*, UINT,
+ LPVOID, UINT,
+ LPVOID, DWORD);
+ BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD);
+ DWORD (WINAPI *getLongPathNameProc)(CONST TCHAR*, TCHAR*, DWORD);
+ /*
+ * These six are for the security sdk to get correct file
+ * permissions on NT, 2000, XP, etc. On 95,98,ME they are
+ * always null.
+ */
+ BOOL (WINAPI *getFileSecurityProc)(LPCTSTR lpFileName,
+ SECURITY_INFORMATION RequestedInformation,
+ PSECURITY_DESCRIPTOR pSecurityDescriptor,
+ DWORD nLength,
+ LPDWORD lpnLengthNeeded);
+ BOOL (WINAPI *impersonateSelfProc) (SECURITY_IMPERSONATION_LEVEL
+ ImpersonationLevel);
+ BOOL (WINAPI *openThreadTokenProc) (HANDLE ThreadHandle,
+ DWORD DesiredAccess, BOOL OpenAsSelf,
+ PHANDLE TokenHandle);
+ BOOL (WINAPI *revertToSelfProc) (void);
+ VOID (WINAPI *mapGenericMaskProc) (PDWORD AccessMask,
+ PGENERIC_MAPPING GenericMapping);
+ BOOL (WINAPI *accessCheckProc)(PSECURITY_DESCRIPTOR pSecurityDescriptor,
+ HANDLE ClientToken, DWORD DesiredAccess,
+ PGENERIC_MAPPING GenericMapping,
+ PPRIVILEGE_SET PrivilegeSet,
+ LPDWORD PrivilegeSetLength,
+ LPDWORD GrantedAccess,
+ LPBOOL AccessStatus);
+ /*
+ * Unicode console support. WriteConsole and ReadConsole
+ */
+ BOOL (WINAPI *readConsoleProc)(
+ HANDLE hConsoleInput,
+ LPVOID lpBuffer,
+ DWORD nNumberOfCharsToRead,
+ LPDWORD lpNumberOfCharsRead,
+ LPVOID lpReserved
+ );
+ BOOL (WINAPI *writeConsoleProc)(
+ HANDLE hConsoleOutput,
+ const VOID* lpBuffer,
+ DWORD nNumberOfCharsToWrite,
+ LPDWORD lpNumberOfCharsWritten,
+ LPVOID lpReserved
+ );
+ BOOL (WINAPI *getUserName)(LPTSTR lpBuffer, LPDWORD lpnSize);
+} TclWinProcs;
+
+MODULE_SCOPE TclWinProcs *tclWinProcs;
+
+/*
* Declarations of functions that are not accessible by way of the
* stubs table.
*/
MODULE_SCOPE char TclWinDriveLetterForVolMountPoint(
- const TCHAR *mountPoint);
+ CONST WCHAR *mountPoint);
MODULE_SCOPE void TclWinEncodingsCleanup();
MODULE_SCOPE void TclWinInit(HINSTANCE hInst);
MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle);
@@ -66,11 +186,12 @@ MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName,
int permissions, int appendMode);
MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle,
char *channelName, int permissions);
-MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, const TCHAR *name,
+MODULE_SCOPE void TclWinResetInterfaceEncodings();
+MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, CONST TCHAR *name,
DWORD access);
-MODULE_SCOPE int TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal,
- const TCHAR *LinkCopy);
-MODULE_SCOPE int TclWinSymLinkDelete(const TCHAR *LinkOriginal,
+MODULE_SCOPE int TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal,
+ CONST TCHAR* LinkCopy);
+MODULE_SCOPE int TclWinSymLinkDelete(CONST TCHAR* LinkOriginal,
int linkOnly);
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
MODULE_SCOPE void TclWinFreeAllocCache(void);
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index 26512b1..c4d08e8 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -13,23 +13,6 @@
#include "tclWinInt.h"
-/*
- * Native name of the directory in the native filesystem where DLLs used in
- * this process are copied prior to loading, and mutex used to protect its
- * allocation.
- */
-
-static WCHAR *dllDirectoryName = NULL;
-static Tcl_Mutex dllDirectoryNameMutex;
-
-/*
- * Static functions defined within this file.
- */
-
-static void * FindSymbol(Tcl_Interp *interp,
- Tcl_LoadHandle loadHandle, const char *symbol);
-static int InitDLLDirectoryName(void);
-static void UnloadFile(Tcl_LoadHandle loadHandle);
/*
*----------------------------------------------------------------------
@@ -57,15 +40,13 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr,
+ Tcl_FSUnloadFileProc **unloadProcPtr)
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
- int flags)
{
- HINSTANCE hInstance;
- const TCHAR *nativeName;
- Tcl_LoadHandle handlePtr;
+ HINSTANCE handle;
+ CONST TCHAR *nativeName;
/*
* First try the full path the user gave us. This is particularly
@@ -74,8 +55,9 @@ TclpDlopen(
*/
nativeName = Tcl_FSGetNativePath(pathPtr);
- hInstance = LoadLibraryEx(nativeName,NULL,LOAD_WITH_ALTERED_SEARCH_PATH);
- if (hInstance == NULL) {
+ handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
+ LOAD_WITH_ALTERED_SEARCH_PATH);
+ if (handle == NULL) {
/*
* Let the OS loader examine the binary search path for whatever
* string the user gave us which hopefully refers to a file on the
@@ -83,17 +65,38 @@ TclpDlopen(
*/
Tcl_DString ds;
+ char *fileName = Tcl_GetString(pathPtr);
- nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds);
- hInstance = LoadLibraryEx(nativeName, NULL,
+ nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
LOAD_WITH_ALTERED_SEARCH_PATH);
Tcl_DStringFree(&ds);
}
- if (hInstance == NULL) {
+ *loadHandle = (Tcl_LoadHandle) handle;
+
+ if (handle == NULL) {
DWORD lastError = GetLastError();
- Tcl_Obj *errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ",
- Tcl_GetString(pathPtr));
+
+#if 0
+ /*
+ * It would be ideal if the FormatMessage stuff worked better, but
+ * unfortunately it doesn't seem to want to...
+ */
+
+ LPTSTR lpMsgBuf;
+ char *buf;
+ int size;
+
+ size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
+ FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
+ (LPTSTR) &lpMsgBuf, 0, NULL);
+ buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
+ sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
+#endif
+
+ Tcl_AppendResult(interp, "couldn't load library \"",
+ Tcl_GetString(pathPtr), "\": ", NULL);
/*
* Check for possible DLL errors. This doesn't work quite right,
@@ -102,59 +105,40 @@ TclpDlopen(
* better if there was a way to get what DLLs
*/
- if (interp) {
- switch (lastError) {
- case ERROR_MOD_NOT_FOUND:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL);
- goto notFoundMsg;
- case ERROR_DLL_NOT_FOUND:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL);
- notFoundMsg:
- Tcl_AppendToObj(errMsg, "this library or a dependent library"
- " could not be found in library path", -1);
- break;
- case ERROR_PROC_NOT_FOUND:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL);
- Tcl_AppendToObj(errMsg, "A function specified in the import"
- " table could not be resolved by the system. Windows"
- " is not telling which one, I'm sorry.", -1);
- break;
- case ERROR_INVALID_DLL:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL);
- Tcl_AppendToObj(errMsg, "this library or a dependent library"
- " is damaged", -1);
- break;
- case ERROR_DLL_INIT_FAILED:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL);
- Tcl_AppendToObj(errMsg, "the library initialization"
- " routine failed", -1);
- break;
- default:
- TclWinConvertError(lastError);
- Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1);
- }
- Tcl_SetObjResult(interp, errMsg);
+ switch (lastError) {
+ case ERROR_MOD_NOT_FOUND:
+ case ERROR_DLL_NOT_FOUND:
+ Tcl_AppendResult(interp, "this library or a dependent library"
+ " could not be found in library path", NULL);
+ break;
+ case ERROR_PROC_NOT_FOUND:
+ Tcl_AppendResult(interp, "A function specified in the import"
+ " table could not be resolved by the system. Windows"
+ " is not telling which one, I'm sorry.", NULL);
+ break;
+ case ERROR_INVALID_DLL:
+ Tcl_AppendResult(interp, "this library or a dependent library"
+ " is damaged", NULL);
+ break;
+ case ERROR_DLL_INIT_FAILED:
+ Tcl_AppendResult(interp, "the library initialization"
+ " routine failed", NULL);
+ break;
+ default:
+ TclWinConvertError(lastError);
+ Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
+ } else {
+ *unloadProcPtr = &TclpUnloadFile;
}
-
- /*
- * Succeded; package everything up for Tcl.
- */
-
- handlePtr = ckalloc(sizeof(struct Tcl_LoadHandle_));
- handlePtr->clientData = (ClientData) hInstance;
- handlePtr->findSymbolProcPtr = &FindSymbol;
- handlePtr->unloadFileProcPtr = &UnloadFile;
- *loadHandle = handlePtr;
- *unloadProcPtr = &UnloadFile;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * FindSymbol --
+ * TclpFindSymbol --
*
* Looks up a symbol, by name, through a handle associated with a
* previously loaded piece of code (shared library).
@@ -167,43 +151,37 @@ TclpDlopen(
*----------------------------------------------------------------------
*/
-static void *
-FindSymbol(
+Tcl_PackageInitProc *
+TclpFindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
- const char *symbol)
+ CONST char *symbol)
{
- HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
Tcl_PackageInitProc *proc = NULL;
+ HINSTANCE handle = (HINSTANCE)loadHandle;
/*
* For each symbol, check for both Symbol and _Symbol, since Borland
* generates C symbols with a leading '_' by default.
*/
- proc = (void *) GetProcAddress(hInstance, symbol);
+ proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
if (proc == NULL) {
Tcl_DString ds;
- const char *sym2;
Tcl_DStringInit(&ds);
- TclDStringAppendLiteral(&ds, "_");
- sym2 = Tcl_DStringAppend(&ds, symbol, -1);
- proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
+ Tcl_DStringAppend(&ds, "_", 1);
+ symbol = Tcl_DStringAppend(&ds, symbol, -1);
+ proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
Tcl_DStringFree(&ds);
}
- if (proc == NULL && interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "cannot find symbol \"%s\"", symbol));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
- }
return proc;
}
/*
*----------------------------------------------------------------------
*
- * UnloadFile --
+ * TclpUnloadFile --
*
* Unloads a dynamically loaded binary code file from memory. Code
* pointers in the formerly loaded file are no longer valid after calling
@@ -218,16 +196,16 @@ FindSymbol(
*----------------------------------------------------------------------
*/
-static void
-UnloadFile(
+void
+TclpUnloadFile(
Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
* TclpDlopen(). The loadHandle is a token
* that represents the loaded file. */
{
- HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
+ HINSTANCE handle;
- FreeLibrary(hInstance);
- ckfree(loadHandle);
+ handle = (HINSTANCE) loadHandle;
+ FreeLibrary(handle);
}
/*
@@ -252,7 +230,7 @@ UnloadFile(
int
TclGuessPackageName(
- const char *fileName, /* Name of file containing package (already
+ CONST char *fileName, /* Name of file containing package (already
* translated to local form if needed). */
Tcl_DString *bufPtr) /* Initialized empty dstring. Append package
* name to this if possible. */
@@ -261,139 +239,6 @@ TclGuessPackageName(
}
/*
- *----------------------------------------------------------------------
- *
- * TclpTempFileNameForLibrary --
- *
- * Constructs a temporary file name for loading a shared object (DLL).
- *
- * Results:
- * Returns the constructed file name.
- *
- * On Windows, a DLL is identified by the final component of its path name.
- * Cross linking among DLL's (and hence, preloading) will not work unless this
- * name is preserved when copying a DLL from a VFS to a temp file for
- * preloading. For this reason, all DLLs in a given process are copied to a
- * temp directory, and their names are preserved.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclpTempFileNameForLibrary(
- Tcl_Interp *interp, /* Tcl interpreter. */
- Tcl_Obj *path) /* Path name of the DLL in the VFS. */
-{
- Tcl_Obj *fileName; /* Name of the temp file. */
- Tcl_Obj *tail; /* Tail of the source path. */
-
- Tcl_MutexLock(&dllDirectoryNameMutex);
- if (dllDirectoryName == NULL) {
- if (InitDLLDirectoryName() == TCL_ERROR) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't create temporary directory: %s",
- Tcl_PosixError(interp)));
- Tcl_MutexUnlock(&dllDirectoryNameMutex);
- return NULL;
- }
- }
- Tcl_MutexUnlock(&dllDirectoryNameMutex);
-
- /*
- * Now we know where to put temporary DLLs, construct the name.
- */
-
- fileName = TclpNativeToNormalized(dllDirectoryName);
- tail = TclPathPart(interp, path, TCL_PATH_TAIL);
- if (tail == NULL) {
- Tcl_DecrRefCount(fileName);
- return NULL;
- }
- Tcl_AppendToObj(fileName, "/", 1);
- Tcl_AppendObjToObj(fileName, tail);
- return fileName;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InitDLLDirectoryName --
- *
- * Helper for TclpTempFileNameForLibrary; builds a temporary directory
- * that is specific to the current process. Should only be called once
- * per process start. Caller must hold dllDirectoryNameMutex.
- *
- * Results:
- * Tcl result code.
- *
- * Side-effects:
- * Creates temp directory.
- * Allocates memory pointed to by dllDirectoryName.
- *
- *----------------------------------------------------------------------
- * [Candidate for process global?]
- */
-
-static int
-InitDLLDirectoryName(void)
-{
- size_t nameLen; /* Length of the temp folder name. */
- WCHAR name[MAX_PATH]; /* Path name of the temp folder. */
- DWORD id; /* The process id. */
- DWORD lastError; /* Last error to happen in Win API. */
- int i;
-
- /*
- * Determine the name of the directory to use, and create it. (Keep
- * trying with new names until an attempt to create the directory
- * succeeds)
- */
-
- nameLen = GetTempPathW(MAX_PATH, name);
- if (nameLen >= MAX_PATH-12) {
- Tcl_SetErrno(ENAMETOOLONG);
- return TCL_ERROR;
- }
-
- wcscpy(name+nameLen, L"TCLXXXXXXXX");
- nameLen += 11;
-
- id = GetCurrentProcessId();
- lastError = ERROR_ALREADY_EXISTS;
-
- for (i=0 ; i<256 ; i++) {
- wsprintfW(name+nameLen-8, L"%08x", id);
- if (CreateDirectoryW(name, NULL)) {
- /*
- * Issue: we don't schedule this directory for deletion by anyone.
- * Can we ask the OS to do this for us? There appears to be
- * potential for using CreateFile (with the flag
- * FILE_FLAG_BACKUP_SEMANTICS) and RemoveDirectory to do this...
- */
-
- goto copyToGlobalBuffer;
- }
- lastError = GetLastError();
- if (lastError != ERROR_ALREADY_EXISTS) {
- break;
- }
- id *= 16777619;
- }
-
- TclWinConvertError(lastError);
- return TCL_ERROR;
-
- /*
- * Store our computed value in the global.
- */
-
- copyToGlobalBuffer:
- dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR));
- wcscpy(dllDirectoryName, name);
- return TCL_OK;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 4543b02..1cd5823 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -42,6 +42,9 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
+extern TclStubs tclStubs;
+extern Tcl_NotifierProcs tclOriginalNotifier;
+
/*
* The following static indicates the number of threads that have initialized
* notifiers. It controls the lifetime of the TclNotifier window class.
@@ -50,7 +53,6 @@ static Tcl_ThreadDataKey dataKey;
*/
static int notifierCount = 0;
-static const TCHAR classname[] = TEXT("TclNotifier");
TCL_DECLARE_MUTEX(notifierMutex)
/*
@@ -79,49 +81,45 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message,
ClientData
Tcl_InitNotifier(void)
{
- if (tclNotifierHooks.initNotifierProc) {
- return tclNotifierHooks.initNotifierProc();
- } else {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- WNDCLASS class;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ WNDCLASS class;
- /*
- * Register Notifier window class if this is the first thread to use
- * this module.
- */
+ /*
+ * Register Notifier window class if this is the first thread to use this
+ * module.
+ */
- Tcl_MutexLock(&notifierMutex);
- if (notifierCount == 0) {
- class.style = 0;
- class.cbClsExtra = 0;
- class.cbWndExtra = 0;
- class.hInstance = TclWinGetTclInstance();
- class.hbrBackground = NULL;
- class.lpszMenuName = NULL;
- class.lpszClassName = classname;
- class.lpfnWndProc = NotifierProc;
- class.hIcon = NULL;
- class.hCursor = NULL;
-
- if (!RegisterClass(&class)) {
- Tcl_Panic("Unable to register TclNotifier window class");
- }
+ Tcl_MutexLock(&notifierMutex);
+ if (notifierCount == 0) {
+ class.style = 0;
+ class.cbClsExtra = 0;
+ class.cbWndExtra = 0;
+ class.hInstance = TclWinGetTclInstance();
+ class.hbrBackground = NULL;
+ class.lpszMenuName = NULL;
+ class.lpszClassName = "TclNotifier";
+ class.lpfnWndProc = NotifierProc;
+ class.hIcon = NULL;
+ class.hCursor = NULL;
+
+ if (!RegisterClassA(&class)) {
+ Tcl_Panic("Unable to register TclNotifier window class");
}
- notifierCount++;
- Tcl_MutexUnlock(&notifierMutex);
+ }
+ notifierCount++;
+ Tcl_MutexUnlock(&notifierMutex);
- tsdPtr->pending = 0;
- tsdPtr->timerActive = 0;
+ tsdPtr->pending = 0;
+ tsdPtr->timerActive = 0;
- InitializeCriticalSection(&tsdPtr->crit);
+ InitializeCriticalSection(&tsdPtr->crit);
- tsdPtr->hwnd = NULL;
- tsdPtr->thread = GetCurrentThreadId();
- tsdPtr->event = CreateEvent(NULL, TRUE /* manual */,
- FALSE /* !signaled */, NULL);
+ tsdPtr->hwnd = NULL;
+ tsdPtr->thread = GetCurrentThreadId();
+ tsdPtr->event = CreateEvent(NULL, TRUE /* manual */,
+ FALSE /* !signaled */, NULL);
- return tsdPtr;
- }
+ return (ClientData) tsdPtr;
}
/*
@@ -145,51 +143,46 @@ void
Tcl_FinalizeNotifier(
ClientData clientData) /* Pointer to notifier data. */
{
- if (tclNotifierHooks.finalizeNotifierProc) {
- tclNotifierHooks.finalizeNotifierProc(clientData);
- return;
- } else {
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
- /*
- * Only finalize the notifier if a notifier was installed in the
- * current thread; there is a route in which this is not guaranteed to
- * be true (when tclWin32Dll.c:DllMain() is called with the flag
- * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread
- * that's never previously been involved with Tcl, e.g. the task
- * manager) so this check is important.
- *
- * Fixes Bug #217982 reported by Hugh Vu and Gene Leache.
- */
+ /*
+ * Only finalize the notifier if a notifier was installed in the current
+ * thread; there is a route in which this is not guaranteed to be true
+ * (when tclWin32Dll.c:DllMain() is called with the flag
+ * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread
+ * that's never previously been involved with Tcl, e.g. the task manager)
+ * so this check is important.
+ *
+ * Fixes Bug #217982 reported by Hugh Vu and Gene Leache.
+ */
- if (tsdPtr == NULL) {
- return;
- }
+ if (tsdPtr == NULL) {
+ return;
+ }
- DeleteCriticalSection(&tsdPtr->crit);
- CloseHandle(tsdPtr->event);
+ DeleteCriticalSection(&tsdPtr->crit);
+ CloseHandle(tsdPtr->event);
- /*
- * Clean up the timer and messaging window for this thread.
- */
+ /*
+ * Clean up the timer and messaging window for this thread.
+ */
- if (tsdPtr->hwnd) {
- KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
- DestroyWindow(tsdPtr->hwnd);
- }
+ if (tsdPtr->hwnd) {
+ KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
+ DestroyWindow(tsdPtr->hwnd);
+ }
- /*
- * If this is the last thread to use the notifier, unregister the
- * notifier window class.
- */
+ /*
+ * If this is the last thread to use the notifier, unregister the notifier
+ * window class.
+ */
- Tcl_MutexLock(&notifierMutex);
- notifierCount--;
- if (notifierCount == 0) {
- UnregisterClass(classname, TclWinGetTclInstance());
- }
- Tcl_MutexUnlock(&notifierMutex);
+ Tcl_MutexLock(&notifierMutex);
+ notifierCount--;
+ if (notifierCount == 0) {
+ UnregisterClassA("TclNotifier", TclWinGetTclInstance());
}
+ Tcl_MutexUnlock(&notifierMutex);
}
/*
@@ -218,32 +211,27 @@ void
Tcl_AlertNotifier(
ClientData clientData) /* Pointer to thread data. */
{
- if (tclNotifierHooks.alertNotifierProc) {
- tclNotifierHooks.alertNotifierProc(clientData);
- return;
- } else {
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+
+ /*
+ * Note that we do not need to lock around access to the hwnd because the
+ * race condition has no effect since any race condition implies that the
+ * notifier thread is already awake.
+ */
+ if (tsdPtr->hwnd) {
/*
- * Note that we do not need to lock around access to the hwnd because
- * the race condition has no effect since any race condition implies
- * that the notifier thread is already awake.
+ * We do need to lock around access to the pending flag.
*/
- if (tsdPtr->hwnd) {
- /*
- * We do need to lock around access to the pending flag.
- */
-
- EnterCriticalSection(&tsdPtr->crit);
- if (!tsdPtr->pending) {
- PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
- }
- tsdPtr->pending = 1;
- LeaveCriticalSection(&tsdPtr->crit);
- } else {
- SetEvent(tsdPtr->event);
+ EnterCriticalSection(&tsdPtr->crit);
+ if (!tsdPtr->pending) {
+ PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
}
+ tsdPtr->pending = 1;
+ LeaveCriticalSection(&tsdPtr->crit);
+ } else {
+ SetEvent(tsdPtr->event);
}
}
@@ -267,48 +255,53 @@ Tcl_AlertNotifier(
void
Tcl_SetTimer(
- const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
+ Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
- if (tclNotifierHooks.setTimerProc) {
- tclNotifierHooks.setTimerProc(timePtr);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ UINT timeout;
+
+ /*
+ * Allow the notifier to be hooked. This may not make sense on Windows,
+ * but mirrors the UNIX hook.
+ */
+
+ if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) {
+ tclStubs.tcl_SetTimer(timePtr);
return;
- } else {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- UINT timeout;
+ }
- /*
- * We only need to set up an interval timer if we're being called from
- * an external event loop. If we don't have a window handle then we
- * just return immediately and let Tcl_WaitForEvent handle timeouts.
- */
+ /*
+ * We only need to set up an interval timer if we're being called from an
+ * external event loop. If we don't have a window handle then we just
+ * return immediately and let Tcl_WaitForEvent handle timeouts.
+ */
- if (!tsdPtr->hwnd) {
- return;
- }
+ if (!tsdPtr->hwnd) {
+ return;
+ }
- if (!timePtr) {
- timeout = 0;
- } else {
- /*
- * Make sure we pass a non-zero value into the timeout argument.
- * Windows seems to get confused by zero length timers.
- */
+ if (!timePtr) {
+ timeout = 0;
+ } else {
+ /*
+ * Make sure we pass a non-zero value into the timeout argument.
+ * Windows seems to get confused by zero length timers.
+ */
- timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
- if (timeout == 0) {
- timeout = 1;
- }
- }
- tsdPtr->timeout = timeout;
- if (timeout != 0) {
- tsdPtr->timerActive = 1;
- SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
- (unsigned long) tsdPtr->timeout, NULL);
- } else {
- tsdPtr->timerActive = 0;
- KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
+ timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+ if (timeout == 0) {
+ timeout = 1;
}
}
+ tsdPtr->timeout = timeout;
+ if (timeout != 0) {
+ tsdPtr->timerActive = 1;
+ SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, (unsigned long) tsdPtr->timeout,
+ NULL);
+ } else {
+ tsdPtr->timerActive = 0;
+ KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
+ }
}
/*
@@ -333,36 +326,29 @@ Tcl_ServiceModeHook(
int mode) /* Either TCL_SERVICE_ALL, or
* TCL_SERVICE_NONE. */
{
- if (tclNotifierHooks.serviceModeHookProc) {
- tclNotifierHooks.serviceModeHookProc(mode);
- return;
- } else {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- /*
- * If this is the first time that the notifier has been used from a
- * modal loop, then create a communication window. Note that after this
- * point, the application needs to service events in a timely fashion
- * or Windows will hang waiting for the window to respond to
- * synchronous system messages. At some point, we may want to consider
- * destroying the window if we leave the modal loop, but for now we'll
- * leave it around.
- */
+ /*
+ * If this is the first time that the notifier has been used from a modal
+ * loop, then create a communication window. Note that after this point,
+ * the application needs to service events in a timely fashion or Windows
+ * will hang waiting for the window to respond to synchronous system
+ * messages. At some point, we may want to consider destroying the window
+ * if we leave the modal loop, but for now we'll leave it around.
+ */
- if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
- tsdPtr->hwnd = CreateWindow(classname, classname,
- WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(),
- NULL);
+ if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
+ tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED,
+ 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
- /*
- * Send an initial message to the window to ensure that we wake up
- * the notifier once we get into the modal loop. This will force
- * the notifier to recompute the timeout value and schedule a timer
- * if one is needed.
- */
+ /*
+ * Send an initial message to the window to ensure that we wake up the
+ * notifier once we get into the modal loop. This will force the
+ * notifier to recompute the timeout value and schedule a timer if one
+ * is needed.
+ */
- Tcl_AlertNotifier(tsdPtr);
- }
+ Tcl_AlertNotifier((ClientData)tsdPtr);
}
}
@@ -430,102 +416,107 @@ NotifierProc(
int
Tcl_WaitForEvent(
- const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
+ Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
- if (tclNotifierHooks.waitForEventProc) {
- return tclNotifierHooks.waitForEventProc(timePtr);
- } else {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- MSG msg;
- DWORD timeout, result;
- int status;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ MSG msg;
+ DWORD timeout, result;
+ int status;
+
+ /*
+ * Allow the notifier to be hooked. This may not make sense on windows,
+ * but mirrors the UNIX hook.
+ */
+
+ if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
+ return tclStubs.tcl_WaitForEvent(timePtr);
+ }
+ /*
+ * Compute the timeout in milliseconds.
+ */
+
+ if (timePtr) {
/*
- * Compute the timeout in milliseconds.
+ * TIP #233 (Virtualized Time). Convert virtual domain delay to
+ * real-time.
*/
- if (timePtr) {
- /*
- * TIP #233 (Virtualized Time). Convert virtual domain delay to
- * real-time.
- */
+ Tcl_Time myTime;
- Tcl_Time myTime;
+ myTime.sec = timePtr->sec;
+ myTime.usec = timePtr->usec;
- myTime.sec = timePtr->sec;
- myTime.usec = timePtr->usec;
+ if (myTime.sec != 0 || myTime.usec != 0) {
+ (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData);
+ }
- if (myTime.sec != 0 || myTime.usec != 0) {
- tclScaleTimeProcPtr(&myTime, tclTimeClientData);
- }
+ timeout = myTime.sec * 1000 + myTime.usec / 1000;
+ } else {
+ timeout = INFINITE;
+ }
- timeout = myTime.sec * 1000 + myTime.usec / 1000;
- } else {
- timeout = INFINITE;
- }
+ /*
+ * Check to see if there are any messages in the queue before waiting
+ * because MsgWaitForMultipleObjects will not wake up if there are events
+ * currently sitting in the queue.
+ */
+ if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
/*
- * Check to see if there are any messages in the queue before waiting
- * because MsgWaitForMultipleObjects will not wake up if there are
- * events currently sitting in the queue.
+ * Wait for something to happen (a signal from another thread, a
+ * message, or timeout) or loop servicing asynchronous procedure calls
+ * queued to this thread.
*/
- if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
- /*
- * Wait for something to happen (a signal from another thread, a
- * message, or timeout) or loop servicing asynchronous procedure
- * calls queued to this thread.
- */
-
- again:
- result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout,
- QS_ALLINPUT, MWMO_ALERTABLE);
- if (result == WAIT_IO_COMPLETION) {
- goto again;
- } else if (result == WAIT_FAILED) {
- status = -1;
- goto end;
- }
+ again:
+ result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout,
+ QS_ALLINPUT, MWMO_ALERTABLE);
+ if (result == WAIT_IO_COMPLETION) {
+ goto again;
+ } else if (result == WAIT_FAILED) {
+ status = -1;
+ goto end;
}
+ }
+
+ /*
+ * Check to see if there are any messages to process.
+ */
+ if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
/*
- * Check to see if there are any messages to process.
+ * Retrieve and dispatch the first message.
*/
- if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
+ result = GetMessage(&msg, NULL, 0, 0);
+ if (result == 0) {
+ /*
+ * We received a request to exit this thread (WM_QUIT), so
+ * propagate the quit message and start unwinding.
+ */
+
+ PostQuitMessage((int) msg.wParam);
+ status = -1;
+ } else if (result == (DWORD)-1) {
/*
- * Retrieve and dispatch the first message.
+ * We got an error from the system. I have no idea why this would
+ * happen, so we'll just unwind.
*/
- result = GetMessage(&msg, NULL, 0, 0);
- if (result == 0) {
- /*
- * We received a request to exit this thread (WM_QUIT), so
- * propagate the quit message and start unwinding.
- */
-
- PostQuitMessage((int) msg.wParam);
- status = -1;
- } else if (result == (DWORD)-1) {
- /*
- * We got an error from the system. I have no idea why this
- * would happen, so we'll just unwind.
- */
-
- status = -1;
- } else {
- TranslateMessage(&msg);
- DispatchMessage(&msg);
- status = 1;
- }
+ status = -1;
} else {
- status = 0;
+ TranslateMessage(&msg);
+ DispatchMessage(&msg);
+ status = 1;
}
-
- end:
- ResetEvent(tsdPtr->event);
- return status;
+ } else {
+ status = 0;
}
+
+ end:
+ ResetEvent(tsdPtr->event);
+ return status;
}
/*
@@ -579,11 +570,11 @@ Tcl_Sleep(
* TIP #233: Scale delay from virtual to real-time.
*/
- tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
+ (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
for (;;) {
- SleepEx(sleepTime, TRUE);
+ Sleep(sleepTime);
Tcl_GetTime(&now);
if (now.sec > desired.sec) {
break;
@@ -594,7 +585,7 @@ Tcl_Sleep(
vdelay.sec = desired.sec - now.sec;
vdelay.usec = desired.usec - now.usec;
- tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
+ (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
}
}
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index aff8836..ee088a5 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -50,7 +50,7 @@ TCL_DECLARE_MUTEX(pipeMutex)
* used in a pipeline.
*/
-typedef struct {
+typedef struct WinFile {
int type; /* One of the file types defined above. */
HANDLE handle; /* Open file handle. */
} WinFile;
@@ -82,12 +82,6 @@ static ProcInfo *procList;
#define PIPE_EXTRABYTE (1<<3) /* The reader thread has consumed one byte. */
/*
- * TODO: It appears the whole EXTRABYTE machinery is in place to support
- * outdated Win 95 systems. If this can be confirmed, much code can be
- * deleted.
- */
-
-/*
* This structure describes per-instance data for a pipe based channel.
*/
@@ -148,7 +142,7 @@ typedef struct PipeInfo {
* synchronized with the readable object. */
} PipeInfo;
-typedef struct {
+typedef struct ThreadSpecificData {
/*
* The following pointer refers to the head of the list of pipes that are
* being watched for file events.
@@ -164,7 +158,7 @@ static Tcl_ThreadDataKey dataKey;
* events are generated.
*/
-typedef struct {
+typedef struct PipeEvent {
Tcl_Event header; /* Information that is standard for all
* events. */
PipeInfo *infoPtr; /* Pointer to pipe info structure. Note that
@@ -198,7 +192,7 @@ static DWORD WINAPI PipeReaderThread(LPVOID arg);
static void PipeSetupProc(ClientData clientData, int flags);
static void PipeWatchProc(ClientData instanceData, int mask);
static DWORD WINAPI PipeWriterThread(LPVOID arg);
-static int TempFileName(TCHAR name[MAX_PATH]);
+static int TempFileName(WCHAR name[MAX_PATH]);
static int WaitForRead(PipeInfo *infoPtr, int blocking);
static void PipeThreadActionProc(ClientData instanceData,
int action);
@@ -208,7 +202,7 @@ static void PipeThreadActionProc(ClientData instanceData,
* I/O.
*/
-static const Tcl_ChannelType pipeChannelType = {
+static Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
TCL_CLOSE2PROC, /* Close proc. */
@@ -225,7 +219,7 @@ static const Tcl_ChannelType pipeChannelType = {
NULL, /* handler proc. */
NULL, /* wide seek proc */
PipeThreadActionProc, /* thread action proc */
- NULL /* truncate */
+ NULL, /* truncate */
};
/*
@@ -410,7 +404,7 @@ PipeCheckProc(
if (needEvent) {
infoPtr->flags |= PIPE_PENDING;
- evPtr = ckalloc(sizeof(PipeEvent));
+ evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
evPtr->header.proc = PipeEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -441,7 +435,7 @@ TclWinMakeFile(
{
WinFile *filePtr;
- filePtr = ckalloc(sizeof(WinFile));
+ filePtr = (WinFile *) ckalloc(sizeof(WinFile));
filePtr->type = WIN_FILE;
filePtr->handle = handle;
@@ -470,18 +464,27 @@ TclWinMakeFile(
static int
TempFileName(
- TCHAR name[MAX_PATH]) /* Buffer in which name for temporary file
+ WCHAR name[MAX_PATH]) /* Buffer in which name for temporary file
* gets stored. */
{
- const TCHAR *prefix = TEXT("TCL");
- if (GetTempPath(MAX_PATH, name) != 0) {
- if (GetTempFileName(name, prefix, 0, name) != 0) {
+ TCHAR *prefix;
+
+ prefix = (tclWinProcs->useWide) ? (TCHAR *) L"TCL" : (TCHAR *) "TCL";
+ if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) {
+ if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
+ name) != 0) {
return 1;
}
}
- name[0] = '.';
- name[1] = '\0';
- return GetTempFileName(name, prefix, 0, name);
+ if (tclWinProcs->useWide) {
+ ((WCHAR *) name)[0] = '.';
+ ((WCHAR *) name)[1] = '\0';
+ } else {
+ ((char *) name)[0] = '.';
+ ((char *) name)[1] = '\0';
+ }
+ return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
+ name);
}
/*
@@ -593,7 +596,7 @@ TclpOpenFile(
flags = 0;
if (!(mode & O_CREAT)) {
- flags = GetFileAttributes(nativePath);
+ flags = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
@@ -609,8 +612,8 @@ TclpOpenFile(
* Now we get to create the file.
*/
- handle = CreateFile(nativePath, accessMode, shareMode,
- NULL, createMode, flags, NULL);
+ handle = (*tclWinProcs->createFileProc)(nativePath, accessMode,
+ shareMode, NULL, createMode, flags, NULL);
Tcl_DStringFree(&ds);
if (handle == INVALID_HANDLE_VALUE) {
@@ -657,7 +660,7 @@ TclFile
TclpCreateTempFile(
const char *contents) /* String to write into temp file, or NULL. */
{
- TCHAR name[MAX_PATH];
+ WCHAR name[MAX_PATH];
const char *native;
Tcl_DString dstring;
HANDLE handle;
@@ -666,7 +669,7 @@ TclpCreateTempFile(
return NULL;
}
- handle = CreateFile(name,
+ handle = (*tclWinProcs->createFileProc)((TCHAR *) name,
GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);
if (handle == INVALID_HANDLE_VALUE) {
@@ -728,7 +731,7 @@ TclpCreateTempFile(
TclWinConvertError(GetLastError());
CloseHandle(handle);
- DeleteFile(name);
+ (*tclWinProcs->deleteFileProc)((TCHAR *) name);
return NULL;
}
@@ -751,13 +754,13 @@ TclpCreateTempFile(
Tcl_Obj *
TclpTempFileName(void)
{
- TCHAR fileName[MAX_PATH];
+ WCHAR fileName[MAX_PATH];
if (TempFileName(fileName) == 0) {
return NULL;
}
- return TclpNativeToNormalized(fileName);
+ return TclpNativeToNormalized((ClientData) fileName);
}
/*
@@ -833,7 +836,7 @@ TclpCloseFile(
if (filePtr->handle != NULL &&
CloseHandle(filePtr->handle) == FALSE) {
TclWinConvertError(GetLastError());
- ckfree(filePtr);
+ ckfree((char *) filePtr);
return -1;
}
}
@@ -843,7 +846,7 @@ TclpCloseFile(
Tcl_Panic("TclpCloseFile: unexpected file type");
}
- ckfree(filePtr);
+ ckfree((char *) filePtr);
return 0;
}
@@ -944,7 +947,7 @@ TclpCreateProcess(
{
int result, applType, createFlags;
Tcl_DString cmdLine; /* Complete command line (TCHAR). */
- STARTUPINFO startInfo;
+ STARTUPINFOA startInfo;
PROCESS_INFORMATION procInfo;
SECURITY_ATTRIBUTES secAtts;
HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
@@ -1034,9 +1037,8 @@ TclpCreateProcess(
}
if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't duplicate input handle: %s",
- Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
+ Tcl_PosixError(interp), (char *) NULL);
goto end;
}
@@ -1055,17 +1057,23 @@ TclpCreateProcess(
* sink.
*/
- startInfo.hStdOutput = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0,
- &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
+ if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS)
+ && (applType == APPL_DOS)) {
+ if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {
+ CloseHandle(h);
+ }
+ } else {
+ startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0,
+ &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
+ }
} else {
DuplicateHandle(hProcess, outputHandle, hProcess,
&startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS);
}
if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't duplicate output handle: %s",
- Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
+ Tcl_PosixError(interp), (char *) NULL);
goto end;
}
@@ -1075,7 +1083,7 @@ TclpCreateProcess(
* sink.
*/
- startInfo.hStdError = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0,
+ startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0,
&secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
} else {
DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,
@@ -1083,9 +1091,8 @@ TclpCreateProcess(
}
if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't duplicate error handle: %s",
- Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
+ Tcl_PosixError(interp), (char *) NULL);
goto end;
}
@@ -1117,7 +1124,7 @@ TclpCreateProcess(
startInfo.wShowWindow = SW_HIDE;
startInfo.dwFlags |= STARTF_USESHOWWINDOW;
createFlags = CREATE_NEW_CONSOLE;
- TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
+ Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1);
} else {
createFlags = DETACHED_PROCESS;
}
@@ -1129,12 +1136,82 @@ TclpCreateProcess(
}
if (applType == APPL_DOS) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "DOS application process not supported on this platform",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP",
- NULL);
- goto end;
+ /*
+ * Under Windows 95, 16-bit DOS applications do not work well with
+ * pipes:
+ *
+ * 1. EOF on a pipe between a detached 16-bit DOS application and
+ * another application is not seen at the other end of the pipe,
+ * so the listening process blocks forever on reads. This inablity
+ * to detect EOF happens when either a 16-bit app or the 32-bit
+ * app is the listener.
+ *
+ * 2. If a 16-bit DOS application (detached or not) blocks when
+ * writing to a pipe, it will never wake up again, and it
+ * eventually brings the whole system down around it.
+ *
+ * The 16-bit application is run as a normal process inside of a
+ * hidden helper console app, and this helper may be run as a
+ * detached process. If any of the stdio handles is a pipe, the
+ * helper application accumulates information into temp files and
+ * forwards it to or from the DOS application as appropriate.
+ * This means that DOS apps must receive EOF from a stdin pipe
+ * before they will actually begin, and must finish generating
+ * stdout or stderr before the data will be sent to the next stage
+ * of the pipe.
+ *
+ * The helper app should be located in the same directory as the
+ * tcl dll.
+ */
+ Tcl_Obj *tclExePtr, *pipeDllPtr;
+ char *start, *end;
+ int i, fileExists;
+ Tcl_DString pipeDll;
+
+ if (createFlags != 0) {
+ startInfo.wShowWindow = SW_HIDE;
+ startInfo.dwFlags |= STARTF_USESHOWWINDOW;
+ createFlags = CREATE_NEW_CONSOLE;
+ }
+
+ Tcl_DStringInit(&pipeDll);
+ Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1);
+ tclExePtr = TclGetObjNameOfExecutable();
+ Tcl_IncrRefCount(tclExePtr);
+ start = Tcl_GetStringFromObj(tclExePtr, &i);
+ for (end = start + (i-1); end > start; end--) {
+ if (*end == '/') {
+ break;
+ }
+ }
+ if (*end != '/') {
+ Tcl_AppendResult(interp, "no / in executable path name \"",
+ start, "\"", (char *) NULL);
+ Tcl_DecrRefCount(tclExePtr);
+ Tcl_DStringFree(&pipeDll);
+ goto end;
+ }
+ i = (end - start) + 1;
+ pipeDllPtr = Tcl_NewStringObj(start, i);
+ Tcl_AppendToObj(pipeDllPtr, Tcl_DStringValue(&pipeDll), -1);
+ Tcl_IncrRefCount(pipeDllPtr);
+ if (Tcl_FSConvertToPathType(interp, pipeDllPtr) != TCL_OK) {
+ Tcl_Panic("Tcl_FSConvertToPathType failed");
+ }
+ fileExists = (Tcl_FSAccess(pipeDllPtr, F_OK) == 0);
+ if (!fileExists) {
+ Tcl_AppendResult(interp, "Tcl pipe dll \"",
+ Tcl_DStringValue(&pipeDll), "\" not found",
+ (char *) NULL);
+ Tcl_DecrRefCount(tclExePtr);
+ Tcl_DecrRefCount(pipeDllPtr);
+ Tcl_DStringFree(&pipeDll);
+ goto end;
+ }
+ Tcl_DStringAppend(&cmdLine, Tcl_DStringValue(&pipeDll), -1);
+ Tcl_DecrRefCount(tclExePtr);
+ Tcl_DecrRefCount(pipeDllPtr);
+ Tcl_DStringFree(&pipeDll);
}
}
@@ -1158,12 +1235,12 @@ TclpCreateProcess(
BuildCommandLine(execPath, argc, argv, &cmdLine);
- if (CreateProcess(NULL, (TCHAR *) Tcl_DStringValue(&cmdLine),
- NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo,
- &procInfo) == 0) {
+ if ((*tclWinProcs->createProcessProc)(NULL,
+ (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
+ (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
- argv[0], Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
goto end;
}
@@ -1291,7 +1368,7 @@ ApplicationType(
IMAGE_DOS_HEADER header;
Tcl_DString nameBuf, ds;
const TCHAR *nativeName;
- TCHAR nativeFullPath[MAX_PATH];
+ WCHAR nativeFullPath[MAX_PATH];
static const char extensions[][5] = {"", ".com", ".exe", ".bat"};
/*
@@ -1317,8 +1394,8 @@ ApplicationType(
Tcl_DStringAppend(&nameBuf, extensions[i], -1);
nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),
Tcl_DStringLength(&nameBuf), &ds);
- found = SearchPath(NULL, nativeName, NULL, MAX_PATH,
- nativeFullPath, &rest);
+ found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL,
+ MAX_PATH, nativeFullPath, &rest);
Tcl_DStringFree(&ds);
if (found == 0) {
continue;
@@ -1329,11 +1406,11 @@ ApplicationType(
* known type.
*/
- attr = GetFileAttributes(nativeFullPath);
+ attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath);
if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
continue;
}
- strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds));
+ strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
Tcl_DStringFree(&ds);
ext = strrchr(fullName, '.');
@@ -1342,7 +1419,7 @@ ApplicationType(
break;
}
- hFile = CreateFile(nativeFullPath,
+ hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath,
GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
@@ -1409,8 +1486,8 @@ ApplicationType(
if (applType == APPL_NONE) {
TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
- originalName, Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "couldn't execute \"", originalName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
return APPL_NONE;
}
@@ -1422,8 +1499,9 @@ ApplicationType(
* application name from the arguments.
*/
- GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH);
- strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds));
+ (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath,
+ nativeFullPath, MAX_PATH);
+ strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
Tcl_DStringFree(&ds);
}
return applType;
@@ -1467,9 +1545,9 @@ BuildCommandLine(
* Prime the path. Add a space separator if we were primed with something.
*/
- TclDStringAppendDString(&ds, linePtr);
+ Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
if (Tcl_DStringLength(linePtr) > 0) {
- TclDStringAppendLiteral(&ds, " ");
+ Tcl_DStringAppend(&ds, " ", 1);
}
for (i = 0; i < argc; i++) {
@@ -1477,7 +1555,7 @@ BuildCommandLine(
arg = executable;
} else {
arg = argv[i];
- TclDStringAppendLiteral(&ds, " ");
+ Tcl_DStringAppend(&ds, " ", 1);
}
quote = 0;
@@ -1486,7 +1564,6 @@ BuildCommandLine(
} else {
int count;
Tcl_UniChar ch;
-
for (start = arg; *start != '\0'; start += count) {
count = Tcl_UtfToUniChar(start, &ch);
if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */
@@ -1496,7 +1573,7 @@ BuildCommandLine(
}
}
if (quote) {
- TclDStringAppendLiteral(&ds, "\"");
+ Tcl_DStringAppend(&ds, "\"", 1);
}
start = arg;
for (special = arg; ; ) {
@@ -1525,7 +1602,7 @@ BuildCommandLine(
}
if (*special == '"') {
Tcl_DStringAppend(&ds, start, (int) (special - start));
- TclDStringAppendLiteral(&ds, "\\\"");
+ Tcl_DStringAppend(&ds, "\\\"", 2);
start = special + 1;
}
if (*special == '\0') {
@@ -1535,7 +1612,7 @@ BuildCommandLine(
}
Tcl_DStringAppend(&ds, start, (int) (special - start));
if (quote) {
- TclDStringAppendLiteral(&ds, "\"");
+ Tcl_DStringAppend(&ds, "\"", 1);
}
}
Tcl_DStringFree(linePtr);
@@ -1571,7 +1648,7 @@ TclpCreateCommandChannel(
{
char channelName[16 + TCL_INTEGER_SPACE];
DWORD id;
- PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo));
+ PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));
PipeInit();
@@ -1586,7 +1663,7 @@ TclpCreateCommandChannel(
infoPtr->writeBuf = 0;
infoPtr->writeBufLen = 0;
infoPtr->writeError = 0;
- infoPtr->channel = NULL;
+ infoPtr->channel = (Tcl_Channel) NULL;
infoPtr->validMask = 0;
@@ -1628,9 +1705,9 @@ TclpCreateCommandChannel(
* unique, in case channels share handles (stdin/stdout).
*/
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
- infoPtr, infoPtr->validMask);
+ (ClientData) infoPtr, infoPtr->validMask);
/*
* Pipes have AUTO translation mode on Windows and ^Z eof char, which
@@ -1638,58 +1715,16 @@ TclpCreateCommandChannel(
* Windows programs that expect a ^Z at EOF.
*/
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+ Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
+ "-translation", "auto");
+ Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
+ "-eofchar", "\032 {}");
return infoPtr->channel;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_CreatePipe --
- *
- * System dependent interface to create a pipe for the [chan pipe]
- * command. Stolen from TclX.
- *
- * Results:
- * TCL_OK or TCL_ERROR.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_CreatePipe(
- Tcl_Interp *interp, /* Errors returned in result.*/
- Tcl_Channel *rchan, /* Where to return the read side. */
- Tcl_Channel *wchan, /* Where to return the write side. */
- int flags) /* Reserved for future use. */
-{
- HANDLE readHandle, writeHandle;
- SECURITY_ATTRIBUTES sec;
-
- sec.nLength = sizeof(SECURITY_ATTRIBUTES);
- sec.lpSecurityDescriptor = NULL;
- sec.bInheritHandle = FALSE;
-
- if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "pipe creation failed: %s", Tcl_PosixError(interp)));
- return TCL_ERROR;
- }
-
- *rchan = Tcl_MakeFileChannel((ClientData) readHandle, TCL_READABLE);
- Tcl_RegisterChannel(interp, *rchan);
-
- *wchan = Tcl_MakeFileChannel((ClientData) writeHandle, TCL_WRITABLE);
- Tcl_RegisterChannel(interp, *wchan);
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclGetAndDetachPids --
*
* Stores a list of the command PIDs for a command channel in the
@@ -1711,8 +1746,8 @@ TclGetAndDetachPids(
{
PipeInfo *pipePtr;
const Tcl_ChannelType *chanTypePtr;
- Tcl_Obj *pidsObj;
int i;
+ char buf[TCL_INTEGER_SPACE];
/*
* Punt if the channel is not a command channel.
@@ -1723,17 +1758,14 @@ TclGetAndDetachPids(
return;
}
- pipePtr = Tcl_GetChannelInstanceData(chan);
- TclNewObj(pidsObj);
+ pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
for (i = 0; i < pipePtr->numPids; i++) {
- Tcl_ListObjAppendElement(NULL, pidsObj,
- Tcl_NewWideIntObj((unsigned)
- TclpGetPid(pipePtr->pidPtr[i])));
- Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
+ wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
+ Tcl_AppendElement(interp, buf);
+ Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
}
- Tcl_SetObjResult(interp, pidsObj);
if (pipePtr->numPids > 0) {
- ckfree(pipePtr->pidPtr);
+ ckfree((char *) pipePtr->pidPtr);
pipePtr->numPids = 0;
}
}
@@ -1878,26 +1910,12 @@ PipeClose2Proc(
&& (pipePtr->writeFile != NULL)) {
if (pipePtr->writeThread) {
/*
- * Wait for the writer thread to finish the current buffer, then
- * terminate the thread and close the handles. If the channel is
- * nonblocking but blocked during exit, bail out since the worker
- * thread is not interruptible and we want TIP#398-fast-exit.
+ * Wait for the writer thread to finish the current buffer, then
+ * terminate the thread and close the handles. If the channel is
+ * nonblocking, there should be no pending write operations.
*/
- if (TclInExit()
- && (pipePtr->flags & PIPE_ASYNC)) {
-
- /* give it a chance to leave honorably */
- SetEvent(pipePtr->stopWriter);
-
- if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) {
- return EWOULDBLOCK;
- }
-
- } else {
-
- WaitForSingleObject(pipePtr->writable, INFINITE);
- }
+ WaitForSingleObject(pipePtr->writable, INFINITE);
/*
* The thread may already have closed on it's own. Check its exit
@@ -2007,11 +2025,12 @@ PipeClose2Proc(
*/
if (pipePtr->errorFile) {
- WinFile *filePtr = (WinFile *) pipePtr->errorFile;
+ WinFile *filePtr;
+ filePtr = (WinFile*)pipePtr->errorFile;
errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
TCL_READABLE);
- ckfree(filePtr);
+ ckfree((char *) filePtr);
} else {
errChan = NULL;
}
@@ -2021,14 +2040,14 @@ PipeClose2Proc(
}
if (pipePtr->numPids > 0) {
- ckfree(pipePtr->pidPtr);
+ ckfree((char *) pipePtr->pidPtr);
}
if (pipePtr->writeBuf != NULL) {
ckfree(pipePtr->writeBuf);
}
- ckfree(pipePtr);
+ ckfree((char*) pipePtr);
if (errorCode == 0) {
return result;
@@ -2167,7 +2186,7 @@ PipeOutputProc(
* the channel is in non-blocking mode.
*/
- errno = EWOULDBLOCK;
+ errno = EAGAIN;
goto error;
}
@@ -2196,7 +2215,7 @@ PipeOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc(toWrite);
+ infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
}
memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
@@ -2575,7 +2594,7 @@ Tcl_WaitPid(
*/
CloseHandle(infoPtr->hProcess);
- ckfree(infoPtr);
+ ckfree((char*)infoPtr);
return result;
}
@@ -2601,9 +2620,9 @@ Tcl_WaitPid(
void
TclWinAddProcess(
void *hProcess, /* Handle to process */
- unsigned long id) /* Global process identifier */
+ unsigned long id) /* Global process identifier */
{
- ProcInfo *procPtr = ckalloc(sizeof(ProcInfo));
+ ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
PipeInit();
@@ -2645,15 +2664,17 @@ Tcl_PidObjCmd(
PipeInfo *pipePtr;
int i;
Tcl_Obj *resultPtr;
+ char buf[TCL_INTEGER_SPACE];
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
return TCL_ERROR;
}
if (objc == 1) {
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid()));
+ wsprintfA(buf, "%lu", (unsigned long) getpid());
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
} else {
- chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]),
+ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
@@ -2666,9 +2687,9 @@ Tcl_PidObjCmd(
pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
resultPtr = Tcl_NewObj();
for (i = 0; i < pipePtr->numPids; i++) {
+ wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
- Tcl_NewWideIntObj((unsigned)
- TclpGetPid(pipePtr->pidPtr[i])));
+ Tcl_NewStringObj(buf, -1));
}
Tcl_SetObjResult(interp, resultPtr);
}
@@ -2718,7 +2739,7 @@ WaitForRead(
* is in non-blocking mode.
*/
- errno = EWOULDBLOCK;
+ errno = EAGAIN;
return -1;
}
@@ -2960,10 +2981,6 @@ PipeWriterThread(
* an error, so exit.
*/
- if (waitResult == WAIT_OBJECT_0) {
- SetEvent(infoPtr->writable);
- }
-
break;
}
@@ -3064,100 +3081,6 @@ PipeThreadActionProc(
}
/*
- *----------------------------------------------------------------------
- *
- * TclpOpenTemporaryFile --
- *
- * Creates a temporary file, possibly based on the supplied bits and
- * pieces of template supplied in the first three arguments. If the
- * fourth argument is non-NULL, it contains a Tcl_Obj to store the name
- * of the temporary file in (and it is caller's responsibility to clean
- * up). If the fourth argument is NULL, try to arrange for the temporary
- * file to go away once it is no longer needed.
- *
- * Results:
- * A read-write Tcl Channel open on the file.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-TclpOpenTemporaryFile(
- Tcl_Obj *dirObj,
- Tcl_Obj *basenameObj,
- Tcl_Obj *extensionObj,
- Tcl_Obj *resultingNameObj)
-{
- TCHAR name[MAX_PATH];
- char *namePtr;
- HANDLE handle;
- DWORD flags = FILE_ATTRIBUTE_TEMPORARY;
- int length, counter, counter2;
- Tcl_DString buf;
-
- if (!resultingNameObj) {
- flags |= FILE_FLAG_DELETE_ON_CLOSE;
- }
-
- namePtr = (char *) name;
- length = GetTempPath(MAX_PATH, name);
- if (length == 0) {
- goto gotError;
- }
- namePtr += length * sizeof(TCHAR);
- if (basenameObj) {
- const char *string = Tcl_GetString(basenameObj);
-
- Tcl_WinUtfToTChar(string, basenameObj->length, &buf);
- memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf));
- namePtr += Tcl_DStringLength(&buf);
- Tcl_DStringFree(&buf);
- } else {
- const TCHAR *baseStr = TEXT("TCL");
- int length = 3 * sizeof(TCHAR);
-
- memcpy(namePtr, baseStr, length);
- namePtr += length;
- }
- counter = TclpGetClicks() % 65533;
- counter2 = 1024; /* Only try this many times! Prevents
- * an infinite loop. */
-
- do {
- char number[TCL_INTEGER_SPACE + 4];
-
- sprintf(number, "%d.TMP", counter);
- counter = (unsigned short) (counter + 1);
- Tcl_WinUtfToTChar(number, strlen(number), &buf);
- Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1);
- memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1);
- Tcl_DStringFree(&buf);
-
- handle = CreateFile(name,
- GENERIC_READ|GENERIC_WRITE, 0, NULL, CREATE_NEW, flags, NULL);
- } while (handle == INVALID_HANDLE_VALUE
- && --counter2 > 0
- && GetLastError() == ERROR_FILE_EXISTS);
- if (handle == INVALID_HANDLE_VALUE) {
- goto gotError;
- }
-
- if (resultingNameObj) {
- Tcl_Obj *tmpObj = TclpNativeToNormalized(name);
-
- Tcl_AppendObjToObj(resultingNameObj, tmpObj);
- TclDecrRefCount(tmpObj);
- }
-
- return Tcl_MakeFileChannel((ClientData) handle,
- TCL_READABLE|TCL_WRITABLE);
-
- gotError:
- TclWinConvertError(GetLastError());
- return NULL;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index ca6b2bf..b2bf1d7 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -14,24 +14,11 @@
#ifndef _TCLWINPORT
#define _TCLWINPORT
-#if !defined(_WIN64) && defined(BUILD_tcl)
+#ifndef _WIN64
/* See [Bug 3354324]: file mtime sets wrong time */
# define _USE_32BIT_TIME_T
#endif
-/*
- * We must specify the lower version we intend to support.
- *
- * WINVER = 0x0500 means Windows 2000 and above
- */
-
-#ifndef WINVER
-# define WINVER 0x0501
-#endif
-#ifndef _WIN32_WINNT
-# define _WIN32_WINNT 0x0501
-#endif
-
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
@@ -47,10 +34,6 @@ typedef DWORD_PTR * PDWORD_PTR;
*/
#define INCL_WINSOCK_API_TYPEDEFS 1
#include <winsock2.h>
-#include <ws2tcpip.h>
-#ifdef HAVE_WSPIAPI_H
-# include <wspiapi.h>
-#endif
#ifdef CHECK_UNICODE_CALLS
# define _UNICODE
@@ -62,20 +45,6 @@ typedef DWORD_PTR * PDWORD_PTR;
#endif /* CHECK_UNICODE_CALLS */
/*
- * Pull in the typedef of TCHAR for windows.
- */
-#include <tchar.h>
-#ifndef _TCHAR_DEFINED
- /* Borland seems to forget to set this. */
- typedef _TCHAR TCHAR;
-# define _TCHAR_DEFINED
-#endif
-#if defined(_MSC_VER) && defined(__STDC__)
- /* VS2005 SP1 misses this. See [Bug #3110161] */
- typedef _TCHAR TCHAR;
-#endif
-
-/*
*---------------------------------------------------------------------------
* The following sets of #includes and #ifdefs are required to get Tcl to
* compile under the windows compilers.
@@ -83,14 +52,16 @@ typedef DWORD_PTR * PDWORD_PTR;
*/
#include <time.h>
-#include <wchar.h>
#include <io.h>
+#include <stdio.h>
+#include <stdlib.h>
#include <errno.h>
#include <fcntl.h>
#include <float.h>
#include <malloc.h>
#include <process.h>
#include <signal.h>
+#include <string.h>
#include <limits.h>
#ifndef __GNUC__
@@ -114,166 +85,108 @@ typedef DWORD_PTR * PDWORD_PTR;
#endif /* __MWERKS__ */
/*
+ * Define EINPROGRESS in terms of WSAEINPROGRESS.
+ */
+
+#undef EINPROGRESS
+#define EINPROGRESS WSAEINPROGRESS
+
+/*
+ * Define ENOTSUP to a value that will never occur.
+ */
+
+#undef ENOTSUP
+#define ENOTSUP -1030507
+
+/* Those codes, from Visual Studio 2010, conflict with other values */
+#undef ENODATA
+#undef ENOMSG
+#undef ENOSR
+#undef ENOSTR
+#undef EPROTO
+
+/*
* The following defines redefine the Windows Socket errors as
* BSD errors so Tcl_PosixError can do the right thing.
*/
-#ifndef ENOTEMPTY
-# define ENOTEMPTY 41 /* Directory not empty */
-#endif
-#ifndef EREMOTE
-# define EREMOTE 66 /* The object is remote */
-#endif
-#ifndef EPFNOSUPPORT
-# define EPFNOSUPPORT 96 /* Protocol family not supported */
-#endif
-#ifndef EADDRINUSE
-# define EADDRINUSE 100 /* Address already in use */
-#endif
-#ifndef EADDRNOTAVAIL
-# define EADDRNOTAVAIL 101 /* Can't assign requested address */
-#endif
-#ifndef EAFNOSUPPORT
-# define EAFNOSUPPORT 102 /* Address family not supported */
-#endif
-#ifndef EALREADY
-# define EALREADY 103 /* Operation already in progress */
-#endif
-#ifndef EBADMSG
-# define EBADMSG 104 /* Not a data message */
-#endif
-#ifndef ECANCELED
-# define ECANCELED 105 /* Canceled */
-#endif
-#ifndef ECONNABORTED
-# define ECONNABORTED 106 /* Software caused connection abort */
-#endif
-#ifndef ECONNREFUSED
-# define ECONNREFUSED 107 /* Connection refused */
-#endif
-#ifndef ECONNRESET
-# define ECONNRESET 108 /* Connection reset by peer */
-#endif
-#ifndef EDESTADDRREQ
-# define EDESTADDRREQ 109 /* Destination address required */
-#endif
-#ifndef EHOSTUNREACH
-# define EHOSTUNREACH 110 /* No route to host */
-#endif
-#ifndef EIDRM
-# define EIDRM 111 /* Identifier removed */
-#endif
-#ifndef EINPROGRESS
-# define EINPROGRESS 112 /* Operation now in progress */
-#endif
-#ifndef EISCONN
-# define EISCONN 113 /* Socket is already connected */
-#endif
-#ifndef ELOOP
-# define ELOOP 114 /* Symbolic link loop */
-#endif
-#ifndef EMSGSIZE
-# define EMSGSIZE 115 /* Message too long */
-#endif
-#ifndef ENETDOWN
-# define ENETDOWN 116 /* Network is down */
-#endif
-#ifndef ENETRESET
-# define ENETRESET 117 /* Network dropped connection on reset */
-#endif
-#ifndef ENETUNREACH
-# define ENETUNREACH 118 /* Network is unreachable */
-#endif
-#ifndef ENOBUFS
-# define ENOBUFS 119 /* No buffer space available */
-#endif
-#ifndef ENODATA
-# define ENODATA 120 /* No data available */
-#endif
-#ifndef ENOLINK
-# define ENOLINK 121 /* Link has be severed */
-#endif
-#ifndef ENOMSG
-# define ENOMSG 122 /* No message of desired type */
-#endif
-#ifndef ENOPROTOOPT
-# define ENOPROTOOPT 123 /* Protocol not available */
-#endif
-#ifndef ENOSR
-# define ENOSR 124 /* Out of stream resources */
-#endif
-#ifndef ENOSTR
-# define ENOSTR 125 /* Not a stream device */
-#endif
-#ifndef ENOTCONN
-# define ENOTCONN 126 /* Socket is not connected */
-#endif
-#ifndef ENOTRECOVERABLE
-# define ENOTRECOVERABLE 127 /* Not recoverable */
-#endif
-#ifndef ENOTSOCK
-# define ENOTSOCK 128 /* Socket operation on non-socket */
-#endif
-#ifndef ENOTSUP
-# define ENOTSUP 129 /* Operation not supported */
-#endif
-#ifndef EOPNOTSUPP
-# define EOPNOTSUPP 130 /* Operation not supported on socket */
-#endif
-#ifndef EOTHER
-# define EOTHER 131 /* Other error */
-#endif
-#ifndef EOVERFLOW
-# define EOVERFLOW 132 /* File too big */
-#endif
-#ifndef EOWNERDEAD
-# define EOWNERDEAD 133 /* Owner dead */
-#endif
-#ifndef EPROTO
-# define EPROTO 134 /* Protocol error */
-#endif
-#ifndef EPROTONOSUPPORT
-# define EPROTONOSUPPORT 135 /* Protocol not supported */
-#endif
-#ifndef EPROTOTYPE
-# define EPROTOTYPE 136 /* Protocol wrong type for socket */
-#endif
-#ifndef ETIME
-# define ETIME 137 /* Timer expired */
-#endif
-#ifndef ETIMEDOUT
-# define ETIMEDOUT 138 /* Connection timed out */
-#endif
-#ifndef ETXTBSY
-# define ETXTBSY 139 /* Text file or pseudo-device busy */
-#endif
-#ifndef EWOULDBLOCK
-# define EWOULDBLOCK 140 /* Operation would block */
-#endif
+#undef EWOULDBLOCK
+#define EWOULDBLOCK EAGAIN
+#undef EALREADY
+#define EALREADY 149 /* operation already in progress */
+#undef ENOTSOCK
+#define ENOTSOCK 95 /* Socket operation on non-socket */
+#undef EDESTADDRREQ
+#define EDESTADDRREQ 96 /* Destination address required */
+#undef EMSGSIZE
+#define EMSGSIZE 97 /* Message too long */
+#undef EPROTOTYPE
+#define EPROTOTYPE 98 /* Protocol wrong type for socket */
+#undef ENOPROTOOPT
+#define ENOPROTOOPT 99 /* Protocol not available */
+#undef EPROTONOSUPPORT
+#define EPROTONOSUPPORT 120 /* Protocol not supported */
+#undef ESOCKTNOSUPPORT
+#define ESOCKTNOSUPPORT 121 /* Socket type not supported */
+#undef EOPNOTSUPP
+#define EOPNOTSUPP 122 /* Operation not supported on socket */
+#undef EPFNOSUPPORT
+#define EPFNOSUPPORT 123 /* Protocol family not supported */
+#undef EAFNOSUPPORT
+#define EAFNOSUPPORT 124 /* Address family not supported */
+#undef EADDRINUSE
+#define EADDRINUSE 125 /* Address already in use */
+#undef EADDRNOTAVAIL
+#define EADDRNOTAVAIL 126 /* Can't assign requested address */
+#undef ENETDOWN
+#define ENETDOWN 127 /* Network is down */
+#undef ENETUNREACH
+#define ENETUNREACH 128 /* Network is unreachable */
+#undef ENETRESET
+#define ENETRESET 129 /* Network dropped connection on reset */
+#undef ECONNABORTED
+#define ECONNABORTED 130 /* Software caused connection abort */
+#undef ECONNRESET
+#define ECONNRESET 131 /* Connection reset by peer */
+#undef ENOBUFS
+#define ENOBUFS 132 /* No buffer space available */
+#undef EISCONN
+#define EISCONN 133 /* Socket is already connected */
+#undef ENOTCONN
+#define ENOTCONN 134 /* Socket is not connected */
+#undef ESHUTDOWN
+#define ESHUTDOWN 143 /* Can't send after socket shutdown */
+#undef ETOOMANYREFS
+#define ETOOMANYREFS 144 /* Too many references: can't splice */
+#undef ETIMEDOUT
+#define ETIMEDOUT 145 /* Connection timed out */
+#undef ECONNREFUSED
+#define ECONNREFUSED 146 /* Connection refused */
+#undef ELOOP
+#define ELOOP 90 /* Symbolic link loop */
+#undef EHOSTDOWN
+#define EHOSTDOWN 147 /* Host is down */
+#undef EHOSTUNREACH
+#define EHOSTUNREACH 148 /* No route to host */
+#undef ENOTEMPTY
+#define ENOTEMPTY 93 /* directory not empty */
+#undef EUSERS
+#define EUSERS 94 /* Too many users (for UFS) */
+#undef EDQUOT
+#define EDQUOT 69 /* Disc quota exceeded */
+#undef ESTALE
+#define ESTALE 151 /* Stale NFS file handle */
+#undef EREMOTE
+#define EREMOTE 66 /* The object is remote */
+/*
+ * It is very hard to determine how Windows reacts to attempting to
+ * set a file pointer outside the input datatype's representable
+ * region. So we fake the error code ourselves.
+ */
-/* Visual Studio doesn't have these, so just choose some high numbers */
-#ifndef ESOCKTNOSUPPORT
-# define ESOCKTNOSUPPORT 240 /* Socket type not supported */
-#endif
-#ifndef ESHUTDOWN
-# define ESHUTDOWN 241 /* Can't send after socket shutdown */
-#endif
-#ifndef ETOOMANYREFS
-# define ETOOMANYREFS 242 /* Too many references: can't splice */
-#endif
-#ifndef EHOSTDOWN
-# define EHOSTDOWN 243 /* Host is down */
-#endif
-#ifndef EUSERS
-# define EUSERS 244 /* Too many users (for UFS) */
-#endif
-#ifndef EDQUOT
-# define EDQUOT 245 /* Disc quota exceeded */
-#endif
-#ifndef ESTALE
-# define ESTALE 246 /* Stale NFS file handle */
-#endif
+#undef EOVERFLOW
+#define EOVERFLOW EFBIG /* The object couldn't fit in the datatype */
/*
* Signals not known to the standard ANSI signal.h. These are used
@@ -472,6 +385,13 @@ typedef DWORD_PTR * PDWORD_PTR;
# pragma warning(disable:4996)
#endif
+
+/*
+ * There is no platform-specific panic routine for Windows in the Tcl internals.
+ */
+
+#define TclpPanic ((Tcl_PanicProc *) NULL)
+
/*
*---------------------------------------------------------------------------
* The following macros and declarations represent the interface between
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 56aa991..a6ce2ce 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -12,48 +12,36 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#undef STATIC_BUILD
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
#include "tclInt.h"
+#include "tclPort.h"
#ifdef _MSC_VER
# pragma comment (lib, "advapi32.lib")
#endif
#include <stdlib.h>
-#ifndef UNICODE
-# undef Tcl_WinTCharToUtf
-# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
-# undef Tcl_WinUtfToTChar
-# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
-#endif /* !UNICODE */
-
/*
- * Ensure that we can say which registry is being accessed.
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Registry_Init declaration is in the source file itself, which is only
+ * accessed when we are building a library.
*/
-#ifndef KEY_WOW64_64KEY
-# define KEY_WOW64_64KEY (0x0100)
-#endif
-#ifndef KEY_WOW64_32KEY
-# define KEY_WOW64_32KEY (0x0200)
-#endif
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
/*
* The maximum length of a sub-key name.
*/
#ifndef MAX_KEY_LENGTH
-# define MAX_KEY_LENGTH 256
+#define MAX_KEY_LENGTH 256
#endif
/*
* The following macros convert between different endian ints.
*/
-#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x))
-#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
+#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x))
+#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
/*
* The following flag is used in OpenKeys to indicate that the specified key
@@ -67,7 +55,7 @@
* system predefined keys.
*/
-static const char *const rootKeyNames[] = {
+static CONST char *rootKeyNames[] = {
"HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
"HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG",
"HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
@@ -78,7 +66,7 @@ static const HKEY rootKeys[] = {
HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
};
-static const char REGISTRY_ASSOC_KEY[] = "registry::command";
+static CONST char REGISTRY_ASSOC_KEY[] = "registry::command";
/*
* The following table maps from registry types to strings. Note that the
@@ -86,7 +74,7 @@ static const char REGISTRY_ASSOC_KEY[] = "registry::command";
* types so we don't need a separate table to hold the mapping.
*/
-static const char *const typeNames[] = {
+static CONST char *typeNames[] = {
"none", "sz", "expand_sz", "binary", "dword",
"dword_big_endian", "link", "multi_sz", "resource_list", NULL
};
@@ -94,26 +82,100 @@ static const char *const typeNames[] = {
static DWORD lastType = REG_RESOURCE_LIST;
/*
+ * The following structures allow us to select between the Unicode and ASCII
+ * interfaces at run time based on whether Unicode APIs are available. The
+ * Unicode APIs are preferable because they will handle characters outside of
+ * the current code page.
+ */
+
+typedef struct RegWinProcs {
+ int useWide;
+
+ LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY);
+ LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
+ DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *);
+ LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *);
+ LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *);
+ LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD);
+ LONG (WINAPI *regEnumKeyExProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ TCHAR *, DWORD *, FILETIME *);
+ LONG (WINAPI *regEnumValueProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ DWORD *, BYTE *, DWORD *);
+ LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM,
+ HKEY *);
+ LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
+ BYTE *, DWORD *);
+ LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD,
+ CONST BYTE*, DWORD);
+} RegWinProcs;
+
+static RegWinProcs *regWinProcs;
+
+static RegWinProcs asciiProcs = {
+ 0,
+
+ (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
+ DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
+ DWORD *)) RegCreateKeyExA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ DWORD *, BYTE *, DWORD *)) RegEnumValueA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
+ HKEY *)) RegOpenKeyExA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
+ BYTE *, DWORD *)) RegQueryValueExA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
+ CONST BYTE*, DWORD)) RegSetValueExA,
+};
+
+static RegWinProcs unicodeProcs = {
+ 1,
+
+ (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
+ DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
+ DWORD *)) RegCreateKeyExW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ DWORD *, BYTE *, DWORD *)) RegEnumValueW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
+ HKEY *)) RegOpenKeyExW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
+ BYTE *, DWORD *)) RegQueryValueExW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
+ CONST BYTE*, DWORD)) RegSetValueExW,
+};
+
+
+/*
* Declarations for functions defined in this file.
*/
static void AppendSystemError(Tcl_Interp *interp, DWORD error);
static int BroadcastValue(Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
+ Tcl_Obj * CONST objv[]);
static DWORD ConvertDWORD(DWORD type, DWORD value);
static void DeleteCmd(ClientData clientData);
-static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- REGSAM mode);
+static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj);
static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj, REGSAM mode);
+ Tcl_Obj *valueNameObj);
static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *patternObj, REGSAM mode);
+ Tcl_Obj *patternObj);
static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj, REGSAM mode);
+ Tcl_Obj *valueNameObj);
static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj, REGSAM mode);
+ Tcl_Obj *valueNameObj);
static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *patternObj, REGSAM mode);
+ Tcl_Obj *patternObj);
static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
REGSAM mode, int flags, HKEY *keyPtr);
static DWORD OpenSubKey(char *hostName, HKEY rootKey,
@@ -123,16 +185,16 @@ static int ParseKeyName(Tcl_Interp *interp, char *name,
char **hostNamePtr, HKEY *rootKeyPtr,
char **keyNamePtr);
static DWORD RecursiveDeleteKey(HKEY hStartKey,
- const TCHAR * pKeyName, REGSAM mode);
+ CONST TCHAR * pKeyName);
static int RegistryObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
+ Tcl_Obj * CONST objv[]);
static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
- Tcl_Obj *typeObj, REGSAM mode);
+ Tcl_Obj *typeObj);
-DLLEXPORT int Registry_Init(Tcl_Interp *interp);
-DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags);
+EXTERN int Registry_Init(Tcl_Interp *interp);
+EXTERN int Registry_Unload(Tcl_Interp *interp, int flags);
/*
*----------------------------------------------------------------------
@@ -156,14 +218,25 @@ Registry_Init(
{
Tcl_Command cmd;
- if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
return TCL_ERROR;
}
+ /*
+ * Determine if the unicode interfaces are available and select the
+ * appropriate registry function table.
+ */
+
+ if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ regWinProcs = &unicodeProcs;
+ } else {
+ regWinProcs = &asciiProcs;
+ }
+
cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
- interp, DeleteCmd);
- Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
- return Tcl_PkgProvide(interp, "registry", "1.3.1");
+ (ClientData)interp, DeleteCmd);
+ Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd);
+ return Tcl_PkgProvide(interp, "registry", "1.2.2");
}
/*
@@ -203,7 +276,7 @@ Registry_Unload(
* Delete the originally registered command.
*/
- cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
+ cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
if (cmd != NULL) {
Tcl_DeleteCommandFromToken(interp, cmd);
}
@@ -233,8 +306,7 @@ DeleteCmd(
ClientData clientData)
{
Tcl_Interp *interp = clientData;
-
- Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL);
+ Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL);
}
/*
@@ -258,125 +330,89 @@ RegistryObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument values. */
+ Tcl_Obj * CONST objv[]) /* Argument values. */
{
- int n = 1;
- int index, argc;
- REGSAM mode = 0;
- const char *errString = NULL;
+ int index;
+ char *errString = NULL;
- static const char *const subcommands[] = {
+ static CONST char *subcommands[] = {
"broadcast", "delete", "get", "keys", "set", "type", "values", NULL
};
enum SubCmdIdx {
BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx
};
- static const char *const modes[] = {
- "-32bit", "-64bit", NULL
- };
if (objc < 2) {
- wrongArgs:
- Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?");
+ Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetString(objv[n])[0] == '-') {
- if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
- switch (index) {
- case 0: /* -32bit */
- mode |= KEY_WOW64_32KEY;
- break;
- case 1: /* -64bit */
- mode |= KEY_WOW64_64KEY;
- break;
- }
- if (objc < 3) {
- goto wrongArgs;
- }
- }
-
- if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index)
+ != TCL_OK) {
return TCL_ERROR;
}
- argc = (objc - n);
switch (index) {
case BroadcastIdx: /* broadcast */
- if (argc == 1 || argc == 3) {
- int res = BroadcastValue(interp, argc, objv + n);
-
- if (res != TCL_BREAK) {
- return res;
- }
- }
- errString = "keyName ?-timeout milliseconds?";
+ return BroadcastValue(interp, objc, objv);
break;
case DeleteIdx: /* delete */
- if (argc == 1) {
- return DeleteKey(interp, objv[n], mode);
- } else if (argc == 2) {
- return DeleteValue(interp, objv[n], objv[n+1], mode);
+ if (objc == 3) {
+ return DeleteKey(interp, objv[2]);
+ } else if (objc == 4) {
+ return DeleteValue(interp, objv[2], objv[3]);
}
errString = "keyName ?valueName?";
break;
case GetIdx: /* get */
- if (argc == 2) {
- return GetValue(interp, objv[n], objv[n+1], mode);
+ if (objc == 4) {
+ return GetValue(interp, objv[2], objv[3]);
}
errString = "keyName valueName";
break;
case KeysIdx: /* keys */
- if (argc == 1) {
- return GetKeyNames(interp, objv[n], NULL, mode);
- } else if (argc == 2) {
- return GetKeyNames(interp, objv[n], objv[n+1], mode);
+ if (objc == 3) {
+ return GetKeyNames(interp, objv[2], NULL);
+ } else if (objc == 4) {
+ return GetKeyNames(interp, objv[2], objv[3]);
}
errString = "keyName ?pattern?";
break;
case SetIdx: /* set */
- if (argc == 1) {
+ if (objc == 3) {
HKEY key;
/*
* Create the key and then close it immediately.
*/
- mode |= KEY_ALL_ACCESS;
- if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) {
+ if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
return TCL_ERROR;
}
RegCloseKey(key);
return TCL_OK;
- } else if (argc == 3) {
- return SetValue(interp, objv[n], objv[n+1], objv[n+2], NULL,
- mode);
- } else if (argc == 4) {
- return SetValue(interp, objv[n], objv[n+1], objv[n+2], objv[n+3],
- mode);
+ } else if (objc == 5 || objc == 6) {
+ Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
+ return SetValue(interp, objv[2], objv[3], objv[4], typeObj);
}
errString = "keyName ?valueName data ?type??";
break;
case TypeIdx: /* type */
- if (argc == 2) {
- return GetType(interp, objv[n], objv[n+1], mode);
+ if (objc == 4) {
+ return GetType(interp, objv[2], objv[3]);
}
errString = "keyName valueName";
break;
case ValuesIdx: /* values */
- if (argc == 1) {
- return GetValueNames(interp, objv[n], NULL, mode);
- } else if (argc == 2) {
- return GetValueNames(interp, objv[n], objv[n+1], mode);
+ if (objc == 3) {
+ return GetValueNames(interp, objv[2], NULL);
+ } else if (objc == 4) {
+ return GetValueNames(interp, objv[2], objv[3]);
}
errString = "keyName ?pattern?";
break;
}
- Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString);
+ Tcl_WrongNumArgs(interp, 2, objv, errString);
return TCL_ERROR;
}
@@ -399,22 +435,21 @@ RegistryObjCmd(
static int
DeleteKey(
Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj, /* Name of key to delete. */
- REGSAM mode) /* Mode flags to pass. */
+ Tcl_Obj *keyNameObj) /* Name of key to delete. */
{
char *tail, *buffer, *hostName, *keyName;
- const TCHAR *nativeTail;
+ CONST char *nativeTail;
HKEY rootKey, subkey;
DWORD result;
+ int length;
Tcl_DString buf;
- REGSAM saveMode = mode;
/*
* Find the parent of the key being deleted and open it.
*/
- keyName = Tcl_GetString(keyNameObj);
- buffer = ckalloc(keyNameObj->length + 1);
+ keyName = Tcl_GetStringFromObj(keyNameObj, &length);
+ buffer = ckalloc((unsigned int) length + 1);
strcpy(buffer, keyName);
if (ParseKeyName(interp, buffer, &hostName, &rootKey,
@@ -424,9 +459,8 @@ DeleteKey(
}
if (*keyName == '\0') {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("bad key: cannot delete root keys", -1));
- Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad key: cannot delete root keys", -1));
ckfree(buffer);
return TCL_ERROR;
}
@@ -439,15 +473,15 @@ DeleteKey(
keyName = NULL;
}
- mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
- result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
+ result = OpenSubKey(hostName, rootKey, keyName,
+ KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey);
if (result != ERROR_SUCCESS) {
ckfree(buffer);
if (result == ERROR_FILE_NOT_FOUND) {
return TCL_OK;
}
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("unable to delete key: ", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to delete key: ", -1));
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -457,7 +491,7 @@ DeleteKey(
*/
nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf);
- result = RecursiveDeleteKey(subkey, nativeTail, saveMode);
+ result = RecursiveDeleteKey(subkey, nativeTail);
Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
@@ -494,12 +528,11 @@ static int
DeleteValue(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj, /* Name of value to delete. */
- REGSAM mode) /* Mode flags to pass. */
+ Tcl_Obj *valueNameObj) /* Name of value to delete. */
{
HKEY key;
char *valueName;
- size_t length;
+ int length;
DWORD result;
Tcl_DString ds;
@@ -507,20 +540,19 @@ DeleteValue(
* Attempt to open the key for deletion.
*/
- mode |= KEY_SET_VALUE;
- if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
+ if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key)
+ != TCL_OK) {
return TCL_ERROR;
}
- valueName = Tcl_GetString(valueNameObj);
- length = valueNameObj->length;
+ valueName = Tcl_GetStringFromObj(valueNameObj, &length);
Tcl_WinUtfToTChar(valueName, length, &ds);
- result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
+ result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unable to delete value \"%s\" from key \"%s\": ",
- Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
+ Tcl_AppendResult(interp, "unable to delete value \"",
+ Tcl_GetString(valueNameObj), "\" from key \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
result = TCL_ERROR;
} else {
@@ -553,13 +585,11 @@ static int
GetKeyNames(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Key to enumerate. */
- Tcl_Obj *patternObj, /* Optional match pattern. */
- REGSAM mode) /* Mode flags to pass. */
+ Tcl_Obj *patternObj) /* Optional match pattern. */
{
- const char *pattern; /* Pattern being matched against subkeys */
+ char *pattern; /* Pattern being matched against subkeys */
HKEY key; /* Handle to the key being examined */
- TCHAR buffer[MAX_KEY_LENGTH];
- /* Buffer to hold the subkey name */
+ TCHAR buffer[MAX_KEY_LENGTH*2]; /* Buffer to hold the subkey name */
DWORD bufSize; /* Size of the buffer */
DWORD index; /* Position of the current subkey */
char *name; /* Subkey name */
@@ -573,37 +603,39 @@ GetKeyNames(
pattern = NULL;
}
- /*
- * Attempt to open the key for enumeration.
- */
+ /* Attempt to open the key for enumeration. */
- mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS;
- if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
+ if (OpenKey(interp, keyNameObj,
+ KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS,
+ 0, &key) != TCL_OK) {
return TCL_ERROR;
}
- /*
- * Enumerate the subkeys.
- */
+ /* Enumerate the subkeys */
resultPtr = Tcl_NewObj();
for (index = 0;; ++index) {
bufSize = MAX_KEY_LENGTH;
- result = RegEnumKeyEx(key, index, buffer, &bufSize,
- NULL, NULL, NULL, NULL);
+ result = (*regWinProcs->regEnumKeyExProc)
+ (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
if (result == ERROR_NO_MORE_ITEMS) {
result = TCL_OK;
} else {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unable to enumerate subkeys of \"%s\": ",
- Tcl_GetString(keyNameObj)));
+ Tcl_SetObjResult(interp, Tcl_NewObj());
+ Tcl_AppendResult(interp,
+ "unable to enumerate subkeys of \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
result = TCL_ERROR;
}
break;
}
- Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
+ if (regWinProcs->useWide) {
+ Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds);
+ } else {
+ Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds);
+ }
name = Tcl_DStringValue(&ds);
if (pattern && !Tcl_StringMatch(name, pattern)) {
Tcl_DStringFree(&ds);
@@ -647,22 +679,22 @@ static int
GetType(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj, /* Name of value to get. */
- REGSAM mode) /* Mode flags to pass. */
+ Tcl_Obj *valueNameObj) /* Name of value to get. */
{
HKEY key;
- DWORD result, type;
+ DWORD result;
+ DWORD type;
Tcl_DString ds;
- const char *valueName;
- const TCHAR *nativeValue;
- size_t length;
+ char *valueName;
+ CONST char *nativeValue;
+ int length;
/*
* Attempt to open the key for reading.
*/
- mode |= KEY_QUERY_VALUE;
- if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
+ if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
+ != TCL_OK) {
return TCL_ERROR;
}
@@ -670,18 +702,17 @@ GetType(
* Get the type of the value.
*/
- valueName = Tcl_GetString(valueNameObj);
- length = valueNameObj->length;
+ valueName = Tcl_GetStringFromObj(valueNameObj, &length);
nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
- result = RegQueryValueEx(key, nativeValue, NULL, &type,
+ result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
NULL, NULL);
Tcl_DStringFree(&ds);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unable to get type of value \"%s\" from key \"%s\": ",
- Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
+ Tcl_AppendResult(interp, "unable to get type of value \"",
+ Tcl_GetString(valueNameObj), "\" from key \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -720,22 +751,20 @@ static int
GetValue(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj, /* Name of value to get. */
- REGSAM mode) /* Mode flags to pass. */
+ Tcl_Obj *valueNameObj) /* Name of value to get. */
{
HKEY key;
- const char *valueName;
- const TCHAR *nativeValue;
+ char *valueName;
+ CONST char *nativeValue;
DWORD result, length, type;
Tcl_DString data, buf;
- size_t nameLen;
+ int nameLen;
/*
* Attempt to open the key for reading.
*/
- mode |= KEY_QUERY_VALUE;
- if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
+ if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
@@ -751,13 +780,12 @@ GetValue(
Tcl_DStringInit(&data);
Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
- length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;
+ length = TCL_DSTRING_STATIC_SIZE / (regWinProcs->useWide ? 2 : 1) - 1;
- valueName = Tcl_GetString(valueNameObj);
- nameLen = valueNameObj->length;
+ valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
- result = RegQueryValueEx(key, nativeValue, NULL, &type,
+ result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
(BYTE *) Tcl_DStringValue(&data), &length);
while (result == ERROR_MORE_DATA) {
/*
@@ -766,17 +794,17 @@ GetValue(
* HKEY_PERFORMANCE_DATA
*/
- length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR));
- Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR));
- result = RegQueryValueEx(key, nativeValue,
+ length = Tcl_DStringLength(&data) * (regWinProcs->useWide ? 1 : 2);
+ Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1));
+ result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
}
Tcl_DStringFree(&buf);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unable to get value \"%s\" from key \"%s\": ",
- Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
+ Tcl_AppendResult(interp, "unable to get value \"",
+ Tcl_GetString(valueNameObj), "\" from key \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
Tcl_DStringFree(&data);
return TCL_ERROR;
@@ -791,7 +819,7 @@ GetValue(
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type,
- *((DWORD *) Tcl_DStringValue(&data)))));
+ *((DWORD*) Tcl_DStringValue(&data)))));
} else if (type == REG_MULTI_SZ) {
char *p = Tcl_DStringValue(&data);
char *end = Tcl_DStringValue(&data) + length;
@@ -803,17 +831,19 @@ GetValue(
* we get bogus data.
*/
- while ((p < end) && *((Tcl_UniChar *) p) != 0) {
- Tcl_UniChar *up;
-
+ while (p < end && ((regWinProcs->useWide)
+ ? *((Tcl_UniChar *)p) : *p) != 0) {
Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(Tcl_DStringValue(&buf),
Tcl_DStringLength(&buf)));
- up = (Tcl_UniChar *) p;
-
- while (*up++ != 0) {/* empty body */}
- p = (char *) up;
+ if (regWinProcs->useWide) {
+ Tcl_UniChar* up = (Tcl_UniChar*) p;
+ while (*up++ != 0) {}
+ p = (char*) up;
+ } else {
+ while (*p++ != '\0') {}
+ }
Tcl_DStringFree(&buf);
}
Tcl_SetObjResult(interp, resultPtr);
@@ -855,27 +885,27 @@ static int
GetValueNames(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Key to enumerate. */
- Tcl_Obj *patternObj, /* Optional match pattern. */
- REGSAM mode) /* Mode flags to pass. */
+ Tcl_Obj *patternObj) /* Optional match pattern. */
{
HKEY key;
Tcl_Obj *resultPtr;
DWORD index, size, result;
Tcl_DString buffer, ds;
- const char *pattern, *name;
+ char *pattern, *name;
/*
* Attempt to open the key for enumeration.
*/
- mode |= KEY_QUERY_VALUE;
- if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
+ if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
+ != TCL_OK) {
return TCL_ERROR;
}
resultPtr = Tcl_NewObj();
Tcl_DStringInit(&buffer);
- Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
+ Tcl_DStringSetLength(&buffer,
+ (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH*2 : MAX_KEY_LENGTH));
index = 0;
result = TCL_OK;
@@ -892,9 +922,13 @@ GetValueNames(
*/
size = MAX_KEY_LENGTH;
- while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer),
- &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) {
- size *= sizeof(TCHAR);
+ while ((*regWinProcs->regEnumValueProc)(key, index,
+ Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL)
+ == ERROR_SUCCESS) {
+
+ if (regWinProcs->useWide) {
+ size *= 2;
+ }
Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
&ds);
@@ -944,13 +978,12 @@ OpenKey(
HKEY *keyPtr) /* Returned HKEY. */
{
char *keyName, *buffer, *hostName;
- size_t length;
+ int length;
HKEY rootKey;
DWORD result;
- keyName = Tcl_GetString(keyNameObj);
- length = keyNameObj->length;
- buffer = ckalloc(length + 1);
+ keyName = Tcl_GetStringFromObj(keyNameObj, &length);
+ buffer = ckalloc((unsigned int) length + 1);
strcpy(buffer, keyName);
result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
@@ -1006,7 +1039,7 @@ OpenSubKey(
if (hostName) {
hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf);
- result = RegConnectRegistry((TCHAR *)hostName, rootKey,
+ result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey,
&rootKey);
Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS) {
@@ -1022,19 +1055,17 @@ OpenSubKey(
keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
if (flags & REG_CREATE) {
DWORD create;
-
- result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL,
+ result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL,
REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
} else if (rootKey == HKEY_PERFORMANCE_DATA) {
/*
* Here we fudge it for this special root key. See MSDN for more info
* on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it.
*/
-
*keyPtr = HKEY_PERFORMANCE_DATA;
result = ERROR_SUCCESS;
} else {
- result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
+ result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode,
keyPtr);
}
Tcl_DStringFree(&buf);
@@ -1098,9 +1129,8 @@ ParseKeyName(
rootName = name;
}
if (!rootName) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad key \"%s\": must start with a valid root", name));
- Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL);
+ Tcl_AppendResult(interp, "bad key \"", name,
+ "\": must start with a valid root", NULL);
return TCL_ERROR;
}
@@ -1152,16 +1182,12 @@ ParseKeyName(
static DWORD
RecursiveDeleteKey(
HKEY startKey, /* Parent of key to be deleted. */
- const TCHAR *keyName, /* Name of key to be deleted in external
+ CONST char *keyName) /* Name of key to be deleted in external
* encoding, not UTF. */
- REGSAM mode) /* Mode flags to pass. */
{
DWORD result, size;
Tcl_DString subkey;
HKEY hKey;
- REGSAM saveMode = mode;
- static int checkExProc = 0;
- static FARPROC regDeleteKeyExProc = NULL;
/*
* Do not allow NULL or empty key name.
@@ -1171,50 +1197,29 @@ RecursiveDeleteKey(
return ERROR_BADKEY;
}
- mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
- result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey);
+ result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0,
+ KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey);
if (result != ERROR_SUCCESS) {
return result;
}
Tcl_DStringInit(&subkey);
- Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
+ Tcl_DStringSetLength(&subkey,
+ (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH * 2 : MAX_KEY_LENGTH));
- mode = saveMode;
while (result == ERROR_SUCCESS) {
/*
* Always get index 0 because key deletion changes ordering.
*/
size = MAX_KEY_LENGTH;
- result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey),
- &size, NULL, NULL, NULL, NULL);
+ result=(*regWinProcs->regEnumKeyExProc)(hKey, 0,
+ Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL);
if (result == ERROR_NO_MORE_ITEMS) {
- /*
- * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we
- * can't compile with it in. We need to check for it at runtime
- * and use it if we find it.
- */
-
- if (mode && !checkExProc) {
- HINSTANCE dllH;
-
- checkExProc = 1;
- dllH = LoadLibrary(TEXT("advapi32.dll"));
- if (dllH) {
- regDeleteKeyExProc = (FARPROC)
- GetProcAddress(dllH, "RegDeleteKeyExW");
- }
- }
- if (mode && regDeleteKeyExProc) {
- result = regDeleteKeyExProc(startKey, keyName, mode, 0);
- } else {
- result = RegDeleteKey(startKey, keyName);
- }
+ result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName);
break;
} else if (result == ERROR_SUCCESS) {
- result = RecursiveDeleteKey(hKey,
- (const TCHAR *) Tcl_DStringValue(&subkey), mode);
+ result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey));
}
}
Tcl_DStringFree(&subkey);
@@ -1246,32 +1251,29 @@ SetValue(
Tcl_Obj *keyNameObj, /* Name of key. */
Tcl_Obj *valueNameObj, /* Name of value to set. */
Tcl_Obj *dataObj, /* Data to be written. */
- Tcl_Obj *typeObj, /* Type of data to be written. */
- REGSAM mode) /* Mode flags to pass. */
+ Tcl_Obj *typeObj) /* Type of data to be written. */
{
int type;
- size_t length;
DWORD result;
HKEY key;
- const char *valueName;
+ int length;
+ char *valueName;
Tcl_DString nameBuf;
if (typeObj == NULL) {
type = REG_SZ;
} else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
0, (int *) &type) != TCL_OK) {
- if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) {
+ if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) {
return TCL_ERROR;
}
Tcl_ResetResult(interp);
}
- mode |= KEY_ALL_ACCESS;
- if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) {
+ if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
return TCL_ERROR;
}
- valueName = Tcl_GetString(valueNameObj);
- length = valueNameObj->length;
+ valueName = Tcl_GetStringFromObj(valueNameObj, &length);
valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
@@ -1283,8 +1285,8 @@ SetValue(
return TCL_ERROR;
}
- value = ConvertDWORD((DWORD) type, (DWORD) value);
- result = RegSetValueEx(key, (TCHAR *) valueName, 0,
+ value = ConvertDWORD((DWORD)type, (DWORD)value);
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
(DWORD) type, (BYTE *) &value, sizeof(DWORD));
} else if (type == REG_MULTI_SZ) {
Tcl_DString data, buf;
@@ -1305,53 +1307,53 @@ SetValue(
Tcl_DStringInit(&data);
for (i = 0; i < objc; i++) {
- const char *bytes = Tcl_GetString(objv[i]);
-
- length = objv[i]->length;
- Tcl_DStringAppend(&data, bytes, length);
+ Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
/*
- * Add a null character to separate this value from the next.
+ * Add a null character to separate this value from the next. We
+ * accomplish this by growing the string by one byte. Since the
+ * DString always tacks on an extra null byte, the new byte will
+ * already be set to null.
*/
- Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */
+ Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1);
}
Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
&buf);
- result = RegSetValueEx(key, (TCHAR *) valueName, 0,
- (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+ (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
(DWORD) Tcl_DStringLength(&buf));
Tcl_DStringFree(&data);
Tcl_DStringFree(&buf);
} else if (type == REG_SZ || type == REG_EXPAND_SZ) {
Tcl_DString buf;
- const char *data = Tcl_GetString(dataObj);
+ CONST char *data = Tcl_GetStringFromObj(dataObj, &length);
- length = dataObj->length;
- data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
+ data = Tcl_WinUtfToTChar(data, length, &buf);
/*
* Include the null in the length, padding if needed for Unicode.
*/
- Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
+ if (regWinProcs->useWide) {
+ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
+ }
length = Tcl_DStringLength(&buf) + 1;
- result = RegSetValueEx(key, (TCHAR *) valueName, 0,
- (DWORD) type, (BYTE *) data, (DWORD) length);
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+ (DWORD) type, (BYTE *) data, (DWORD) length);
Tcl_DStringFree(&buf);
} else {
BYTE *data;
- int bytelength;
/*
* Store binary data in the registry.
*/
- data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
- result = RegSetValueEx(key, (TCHAR *) valueName, 0,
- (DWORD) type, data, (DWORD) bytelength);
+ data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length);
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+ (DWORD) type, data, (DWORD) length);
}
Tcl_DStringFree(&nameBuf);
@@ -1387,29 +1389,34 @@ static int
BroadcastValue(
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument values. */
+ Tcl_Obj *CONST objv[]) /* Argument values. */
{
LRESULT result;
DWORD_PTR sendResult;
- int timeout = 3000;
- size_t len;
- int unilen;
- const char *str;
+ UINT timeout = 3000;
+ int len;
+ CONST char *str;
Tcl_Obj *objPtr;
- if (objc == 3) {
- str = Tcl_GetString(objv[1]);
- len = objv[1]->length;
- if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) {
- return TCL_BREAK;
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
+ return TCL_ERROR;
+ }
+
+ if (objc > 3) {
+ str = Tcl_GetStringFromObj(objv[3], &len);
+ if ((len < 2) || (*str != '-')
+ || strncmp(str, "-timeout", (size_t) len)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
+ return TCL_ERROR;
}
- if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) {
return TCL_ERROR;
}
}
- str = (char*)Tcl_GetUnicodeFromObj(objv[0], &unilen);
- if (unilen == 0) {
+ str = Tcl_GetStringFromObj(objv[2], &len);
+ if (len == 0) {
str = NULL;
}
@@ -1418,7 +1425,7 @@ BroadcastValue(
*/
result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
- (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult);
+ (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
objPtr = Tcl_NewObj();
Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result));
@@ -1451,8 +1458,8 @@ AppendSystemError(
DWORD error) /* Result code from error. */
{
int length;
- TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
- const char *msg;
+ WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr;
+ char *msg;
char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
Tcl_DString ds;
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
@@ -1460,34 +1467,52 @@ AppendSystemError(
if (Tcl_IsShared(resultPtr)) {
resultPtr = Tcl_DuplicateObj(resultPtr);
}
- length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
+ length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr,
0, NULL);
if (length == 0) {
- sprintf(msgBuf, "unknown error: %ld", error);
- msg = msgBuf;
- } else {
char *msgPtr;
- Tcl_WinTCharToUtf(tMsgPtr, -1, &ds);
- LocalFree(tMsgPtr);
+ length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
+ 0, NULL);
+ if (length > 0) {
+ wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
+ MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr,
+ length + 1);
+ LocalFree(msgPtr);
+ }
+ }
+ if (length == 0) {
+ if (error == ERROR_CALL_NOT_IMPLEMENTED) {
+ msg = "function not supported under Win32s";
+ } else {
+ sprintf(msgBuf, "unknown error: %ld", error);
+ msg = msgBuf;
+ }
+ } else {
+ Tcl_Encoding encoding;
+
+ encoding = Tcl_GetEncoding(NULL, "unicode");
+ Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
+ Tcl_FreeEncoding(encoding);
+ LocalFree(wMsgPtr);
- msgPtr = Tcl_DStringValue(&ds);
+ msg = Tcl_DStringValue(&ds);
length = Tcl_DStringLength(&ds);
/*
* Trim the trailing CR/LF from the system message.
*/
- if (msgPtr[length-1] == '\n') {
- --length;
+ if (msg[length-1] == '\n') {
+ msg[--length] = 0;
}
- if (msgPtr[length-1] == '\r') {
- --length;
+ if (msg[length-1] == '\r') {
+ msg[--length] = 0;
}
- msgPtr[length] = 0;
- msg = msgPtr;
}
sprintf(id, "%ld", error);
@@ -1522,15 +1547,14 @@ ConvertDWORD(
DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */
DWORD value) /* The value to be converted. */
{
- const DWORD order = 1;
+ DWORD order = 1;
DWORD localType;
/*
* Check to see if the low bit is in the first byte.
*/
- localType = (*((const char *) &order) == 1)
- ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
+ localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
return (type != localType) ? (DWORD) SWAPLONG(value) : value;
}
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 0730a46..83f1866 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -173,16 +173,16 @@ static ThreadSpecificData *SerialInit(void);
static int SerialInputProc(ClientData instanceData, char *buf,
int toRead, int *errorCode);
static int SerialOutputProc(ClientData instanceData,
- const char *buf, int toWrite, int *errorCode);
+ CONST char *buf, int toWrite, int *errorCode);
static void SerialSetupProc(ClientData clientData, int flags);
static void SerialWatchProc(ClientData instanceData, int mask);
static void ProcExitHandler(ClientData clientData);
static int SerialGetOptionProc(ClientData instanceData,
- Tcl_Interp *interp, const char *optionName,
+ Tcl_Interp *interp, CONST char *optionName,
Tcl_DString *dsPtr);
static int SerialSetOptionProc(ClientData instanceData,
- Tcl_Interp *interp, const char *optionName,
- const char *value);
+ Tcl_Interp *interp, CONST char *optionName,
+ CONST char *value);
static DWORD WINAPI SerialWriterThread(LPVOID arg);
static void SerialThreadActionProc(ClientData instanceData,
int action);
@@ -197,7 +197,7 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
* based IO.
*/
-static const Tcl_ChannelType serialChannelType = {
+static Tcl_ChannelType serialChannelType = {
"serial", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
SerialCloseProc, /* Close proc. */
@@ -214,7 +214,7 @@ static const Tcl_ChannelType serialChannelType = {
NULL, /* handler proc. */
NULL, /* wide seek proc */
SerialThreadActionProc, /* thread action proc */
- NULL /* truncate */
+ NULL, /* truncate */
};
/*
@@ -374,7 +374,7 @@ SerialGetMilliseconds(void)
{
Tcl_Time time;
- Tcl_GetTime(&time);
+ TclpGetTime(&time);
return (time.sec * 1000 + time.usec / 1000);
}
@@ -527,7 +527,7 @@ SerialCheckProc(
if (needEvent) {
infoPtr->flags |= SERIAL_PENDING;
- evPtr = ckalloc(sizeof(SerialEvent));
+ evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
evPtr->header.proc = SerialEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -706,7 +706,7 @@ SerialCloseProc(
ckfree(serialPtr->writeBuf);
serialPtr->writeBuf = NULL;
}
- ckfree(serialPtr);
+ ckfree((char*) serialPtr);
if (errorCode == 0) {
return result;
@@ -932,7 +932,7 @@ SerialInputProc(
bufSize = cStat.cbInQue;
}
} else {
- errno = *errorCode = EWOULDBLOCK;
+ errno = *errorCode = EAGAIN;
return -1;
}
} else {
@@ -996,7 +996,7 @@ SerialInputProc(
static int
SerialOutputProc(
ClientData instanceData, /* Serial state. */
- const char *buf, /* The data buffer. */
+ CONST char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
{
@@ -1071,7 +1071,7 @@ SerialOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc(toWrite);
+ infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
}
memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
@@ -1415,7 +1415,7 @@ SerialWriterThread(
* Opens or Reopens the serial port with the OVERLAPPED FLAG set
*
* Results:
- * Returns the new handle, or INVALID_HANDLE_VALUE.
+ * Returns the new handle, or INVALID_HANDLE_VALUE.
* If an existing channel is specified it is closed and reopened.
*
* Side effects:
@@ -1427,7 +1427,7 @@ SerialWriterThread(
HANDLE
TclWinSerialOpen(
HANDLE handle,
- const TCHAR *name,
+ CONST TCHAR *name,
DWORD access)
{
SerialInit();
@@ -1446,8 +1446,8 @@ TclWinSerialOpen(
* finished
*/
- handle = CreateFile(name, access, 0, 0, OPEN_EXISTING,
- FILE_FLAG_OVERLAPPED, 0);
+ handle = (*tclWinProcs->createFileProc)(name, access, 0, 0,
+ OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
return handle;
}
@@ -1481,7 +1481,7 @@ TclWinOpenSerialChannel(
SerialInit();
- infoPtr = ckalloc(sizeof(SerialInfo));
+ infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
memset(infoPtr, 0, sizeof(SerialInfo));
infoPtr->validMask = permissions;
@@ -1502,10 +1502,10 @@ TclWinOpenSerialChannel(
* are shared between multiple channels (stdin/stdout).
*/
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr);
infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
- infoPtr, permissions);
+ (ClientData) infoPtr, permissions);
SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
@@ -1648,17 +1648,17 @@ static int
SerialSetOptionProc(
ClientData instanceData, /* File state. */
Tcl_Interp *interp, /* For error reporting - can be NULL. */
- const char *optionName, /* Which option to set? */
- const char *value) /* New value for option. */
+ CONST char *optionName, /* Which option to set? */
+ CONST char *value) /* New value for option. */
{
SerialInfo *infoPtr;
DCB dcb;
BOOL result, flag;
size_t len, vlen;
Tcl_DString ds;
- const TCHAR *native;
+ CONST TCHAR *native;
int argc;
- const char **argv;
+ CONST char **argv;
infoPtr = (SerialInfo *) instanceData;
@@ -1676,18 +1676,19 @@ SerialSetOptionProc(
if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
- goto getStateFailed;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
+ }
+ return TCL_ERROR;
}
native = Tcl_WinUtfToTChar(value, -1, &ds);
- result = BuildCommDCB(native, &dcb);
+ result = (*tclWinProcs->buildCommDCBProc)(native, &dcb);
Tcl_DStringFree(&ds);
if (result == FALSE) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad value \"%s\" for -mode: should be baud,parity,data,stop",
- value));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
+ Tcl_AppendResult(interp, "bad value \"", value,
+ "\" for -mode: should be baud,parity,data,stop", NULL);
}
return TCL_ERROR;
}
@@ -1702,7 +1703,10 @@ SerialSetOptionProc(
dcb.fAbortOnError = FALSE;
if (!SetCommState(infoPtr->handle, &dcb)) {
- goto setStateFailed;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set comm state", NULL);
+ }
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -1713,7 +1717,10 @@ SerialSetOptionProc(
if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
- goto getStateFailed;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
+ }
+ return TCL_ERROR;
}
/*
@@ -1748,16 +1755,18 @@ SerialSetOptionProc(
dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
} else {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad value \"%s\" for -handshake: must be one of"
- " xonxoff, rtscts, dtrdsr or none", value));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL);
+ Tcl_AppendResult(interp, "bad value \"", value,
+ "\" for -handshake: must be one of xonxoff, rtscts, "
+ "dtrdsr or none", NULL);
}
return TCL_ERROR;
}
if (!SetCommState(infoPtr->handle, &dcb)) {
- goto setStateFailed;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set comm state", NULL);
+ }
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -1768,7 +1777,10 @@ SerialSetOptionProc(
if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
- goto getStateFailed;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
+ }
+ return TCL_ERROR;
}
if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
@@ -1777,12 +1789,11 @@ SerialSetOptionProc(
if (argc != 2) {
badXchar:
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "bad value for -xchar: should be a list of"
- " two elements with each a single character", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
+ Tcl_AppendResult(interp, "bad value for -xchar: should be "
+ "a list of two elements with each a single character",
+ NULL);
}
- ckfree(argv);
+ ckfree((char *) argv);
return TCL_ERROR;
}
@@ -1813,10 +1824,13 @@ SerialSetOptionProc(
}
dcb.XoffChar = (char) character;
}
- ckfree(argv);
+ ckfree((char *) argv);
if (!SetCommState(infoPtr->handle, &dcb)) {
- goto setStateFailed;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set comm state", NULL);
+ }
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -1833,12 +1847,11 @@ SerialSetOptionProc(
}
if ((argc % 2) == 1) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad value \"%s\" for -ttycontrol: should be "
- "a list of signal,value pairs", value));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
+ Tcl_AppendResult(interp, "bad value \"", value,
+ "\" for -ttycontrol: should be a list of "
+ "signal,value pairs", NULL);
}
- ckfree(argv);
+ ckfree((char *) argv);
return TCL_ERROR;
}
@@ -1851,10 +1864,7 @@ SerialSetOptionProc(
if (!EscapeCommFunction(infoPtr->handle,
(DWORD) (flag ? SETDTR : CLRDTR))) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can't set DTR signal", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION",
- "FCONFIGURE", "TTY_SIGNAL", NULL);
+ Tcl_AppendResult(interp, "can't set DTR signal", NULL);
}
result = TCL_ERROR;
break;
@@ -1863,10 +1873,7 @@ SerialSetOptionProc(
if (!EscapeCommFunction(infoPtr->handle,
(DWORD) (flag ? SETRTS : CLRRTS))) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can't set RTS signal", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION",
- "FCONFIGURE", "TTY_SIGNAL", NULL);
+ Tcl_AppendResult(interp, "can't set RTS signal", NULL);
}
result = TCL_ERROR;
break;
@@ -1875,20 +1882,15 @@ SerialSetOptionProc(
if (!EscapeCommFunction(infoPtr->handle,
(DWORD) (flag ? SETBREAK : CLRBREAK))) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can't set BREAK signal", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION",
- "FCONFIGURE", "TTY_SIGNAL", NULL);
+ Tcl_AppendResult(interp,"can't set BREAK signal",NULL);
}
result = TCL_ERROR;
break;
}
} else {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad signal name \"%s\" for -ttycontrol: must be"
- " DTR, RTS or BREAK", argv[i]));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
+ Tcl_AppendResult(interp, "bad signal name \"", argv[i],
+ "\" for -ttycontrol: must be DTR, RTS or BREAK",
NULL);
}
result = TCL_ERROR;
@@ -1896,7 +1898,7 @@ SerialSetOptionProc(
}
}
- ckfree(argv);
+ ckfree((char *) argv);
return result;
}
@@ -1922,24 +1924,20 @@ SerialSetOptionProc(
inSize = atoi(argv[0]);
outSize = atoi(argv[1]);
}
- ckfree(argv);
+ ckfree((char *) argv);
if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad value \"%s\" for -sysbuffer: should be "
- "a list of one or two integers > 0", value));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
+ Tcl_AppendResult(interp, "bad value \"", value,
+ "\" for -sysbuffer: should be a list of one or two "
+ "integers > 0", NULL);
}
return TCL_ERROR;
}
if (!SetupComm(infoPtr->handle, inSize, outSize)) {
if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't setup comm buffers: %s",
- Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "can't setup comm buffers", NULL);
}
return TCL_ERROR;
}
@@ -1952,12 +1950,18 @@ SerialSetOptionProc(
*/
if (!GetCommState(infoPtr->handle, &dcb)) {
- goto getStateFailed;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
+ }
+ return TCL_ERROR;
}
dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
if (!SetCommState(infoPtr->handle, &dcb)) {
- goto setStateFailed;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set comm state", NULL);
+ }
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -1987,10 +1991,7 @@ SerialSetOptionProc(
tout.ReadTotalTimeoutConstant = msec;
if (!SetCommTimeouts(infoPtr->handle, &tout)) {
if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't set comm timeouts: %s",
- Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "can't set comm timeouts", NULL);
}
return TCL_ERROR;
}
@@ -2000,22 +2001,6 @@ SerialSetOptionProc(
return Tcl_BadChannelOption(interp, optionName,
"mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
-
- getStateFailed:
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get comm state: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
-
- setStateFailed:
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't set comm state: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
}
/*
@@ -2043,7 +2028,7 @@ static int
SerialGetOptionProc(
ClientData instanceData, /* File state. */
Tcl_Interp *interp, /* For error reporting - can be NULL. */
- const char *optionName, /* Option to get. */
+ CONST char *optionName, /* Option to get. */
Tcl_DString *dsPtr) /* Where to store value(s). */
{
SerialInfo *infoPtr;
@@ -2068,14 +2053,12 @@ SerialGetOptionProc(
}
if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) {
char parity;
- const char *stop;
+ char *stop;
char buf[2 * TCL_INTEGER_SPACE + 16];
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get comm state: %s", Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
}
return TCL_ERROR;
}
@@ -2143,9 +2126,7 @@ SerialGetOptionProc(
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get comm state: %s", Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
}
return TCL_ERROR;
}
@@ -2221,9 +2202,7 @@ SerialGetOptionProc(
if (!GetCommModemStatus(infoPtr->handle, &status)) {
if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get tty status: %s", Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "can't get tty status", NULL);
}
return TCL_ERROR;
}
@@ -2233,9 +2212,10 @@ SerialGetOptionProc(
if (valid) {
return TCL_OK;
+ } else {
+ return Tcl_BadChannelOption(interp, optionName,
+ "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
}
- return Tcl_BadChannelOption(interp, optionName,
- "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
}
/*
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index a022ed5..8f565b9 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -9,9 +9,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* -----------------------------------------------------------------------
- * The order and naming of functions in this file should minimize
- * the file diff to tclUnixSock.c.
- * -----------------------------------------------------------------------
*
* General information on how this module works.
*
@@ -71,126 +68,64 @@
#undef setsockopt
/*
- * Helper macros to make parts of this file clearer. The macros do exactly
- * what they say on the tin. :-) They also only ever refer to their arguments
- * once, and so can be used without regard to side effects.
- */
-
-#define SET_BITS(var, bits) ((var) |= (bits))
-#define CLEAR_BITS(var, bits) ((var) &= ~(bits))
-
-/* "sock" + a pointer in hex + \0 */
-#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1)
-#define SOCK_TEMPLATE "sock%p"
-
-/*
* The following variable is used to tell whether this module has been
* initialized. If 1, initialization of sockets was successful, if -1 then
* socket initialization failed (WSAStartup failed).
*/
static int initialized = 0;
-static const TCHAR classname[] = TEXT("TclSocket");
TCL_DECLARE_MUTEX(socketMutex)
/*
- * The following defines declare the messages used on socket windows.
+ * The following variable holds the network name of this host.
*/
-#define SOCKET_MESSAGE WM_USER+1
-#define SOCKET_SELECT WM_USER+2
-#define SOCKET_TERMINATE WM_USER+3
-#define SELECT TRUE
-#define UNSELECT FALSE
+static TclInitProcessGlobalValueProc InitializeHostName;
+static ProcessGlobalValue hostName = {
+ 0, 0, NULL, NULL, InitializeHostName, NULL, NULL
+};
/*
- * This is needed to comply with the strict aliasing rules of GCC, but it also
- * simplifies casting between the different sockaddr types.
+ * The following defines declare the messages used on socket windows.
*/
-typedef union {
- struct sockaddr sa;
- struct sockaddr_in sa4;
- struct sockaddr_in6 sa6;
- struct sockaddr_storage sas;
-} address;
-
-#ifndef IN6_ARE_ADDR_EQUAL
-#define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL
-#endif
+#define SOCKET_MESSAGE WM_USER+1
+#define SOCKET_SELECT WM_USER+2
+#define SOCKET_TERMINATE WM_USER+3
+#define SELECT TRUE
+#define UNSELECT FALSE
/*
- * This structure describes per-instance state of a tcp based channel.
+ * The following structure is used to store the data associated with each
+ * socket.
+ * All members modified by the notifier thread are defined as volatile.
*/
-typedef struct TcpState TcpState;
-
-typedef struct TcpFdList {
- TcpState *statePtr;
- SOCKET fd;
- struct TcpFdList *next;
-} TcpFdList;
-
-struct TcpState {
+typedef struct SocketInfo {
Tcl_Channel channel; /* Channel associated with this socket. */
- struct TcpFdList *sockets; /* Windows SOCKET handle. */
- int flags; /* Bit field comprised of the flags described
+ SOCKET socket; /* Windows SOCKET handle. */
+ volatile int flags; /* Bit field comprised of the flags described
* below. */
int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE,
* FD_CLOSE, FD_ACCEPT and FD_CONNECT that
* indicate which events are interesting. */
volatile int readyEvents; /* OR'ed combination of FD_READ, FD_WRITE,
* FD_CLOSE, FD_ACCEPT and FD_CONNECT that
- * indicate which events have occurred.
- * Set by notifier thread, access must be
- * protected by semaphore */
+ * indicate which events have occurred. */
int selectEvents; /* OR'ed combination of FD_READ, FD_WRITE,
* FD_CLOSE, FD_ACCEPT and FD_CONNECT that
* indicate which events are currently being
* selected. */
volatile int acceptEventCount;
/* Count of the current number of FD_ACCEPTs
- * that have arrived and not yet processed.
- * Set by notifier thread, access must be
- * protected by semaphore */
+ * that have arrived and not yet processed. */
Tcl_TcpAcceptProc *acceptProc;
/* Proc to call on accept. */
ClientData acceptProcData; /* The data for the accept proc. */
-
- /*
- * Only needed for client sockets
- */
-
- struct addrinfo *addrlist; /* Addresses to connect to. */
- struct addrinfo *addr; /* Iterator over addrlist. */
- struct addrinfo *myaddrlist;/* Local address. */
- struct addrinfo *myaddr; /* Iterator over myaddrlist. */
- int connectError; /* Cache status of async socket. */
- int cachedBlocking; /* Cache blocking mode of async socket. */
- volatile int notifierConnectError;
- /* Async connect error set by notifier thread.
- * This error is still a windows error code.
- * Access must be protected by semaphore */
- struct TcpState *nextPtr; /* The next socket on the per-thread socket
+ volatile int lastError; /* Error code from last message. */
+ struct SocketInfo *nextPtr; /* The next socket on the per-thread socket
* list. */
-};
-
-/*
- * These bits may be ORed together into the "flags" field of a TcpState
- * structure.
- */
-
-#define TCP_NONBLOCKING (1<<0) /* Socket with non-blocking I/O */
-#define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */
-#define SOCKET_EOF (1<<2) /* A zero read happened on the
- * socket. */
-#define SOCKET_PENDING (1<<3) /* A message has been sent for this
- * socket */
-#define TCP_ASYNC_PENDING (1<<4) /* TcpConnect was called to
- * process an async connect. This
- * flag indicates that reentry is
- * still pending */
-#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */
+} SocketInfo;
/*
* The following structure is what is added to the Tcl event queue when a
@@ -201,8 +136,8 @@ typedef struct {
Tcl_Event header; /* Information that is standard for all
* events. */
SOCKET socket; /* Socket descriptor that is ready. Used to
- * find the TcpState structure for the file
- * (can't point directly to the TcpState
+ * find the SocketInfo structure for the file
+ * (can't point directly to the SocketInfo
* structure because it could go away while
* the event is queued). */
} SocketEvent;
@@ -213,6 +148,17 @@ typedef struct {
#define TCP_BUFFER_SIZE 4096
+/*
+ * The following macros may be used to set the flags field of a SocketInfo
+ * structure.
+ */
+
+#define SOCKET_ASYNC (1<<0) /* The socket is in blocking mode. */
+#define SOCKET_EOF (1<<1) /* A zero read happened on the
+ * socket. */
+#define SOCKET_ASYNC_CONNECT (1<<2) /* This socket uses async connect. */
+#define SOCKET_PENDING (1<<3) /* A message has been sent for this
+ * socket */
typedef struct {
HWND hwnd; /* Handle to window for socket messages. */
@@ -223,11 +169,11 @@ typedef struct {
* socketThread has been initialized and has
* started. */
HANDLE socketListLock; /* Win32 Event to lock the socketList */
- TcpState *pendingTcpState;
+ SocketInfo *pendingSocketInfo;
/* This socket is opened but not jet in the
* list. This value is also checked by
* the event structure. */
- TcpState *socketList; /* Every open socket in this thread has an
+ SocketInfo *socketList; /* Every open socket in this thread has an
* entry on this list. */
} ThreadSpecificData;
@@ -235,23 +181,23 @@ static Tcl_ThreadDataKey dataKey;
static WNDCLASS windowClass;
/*
- * Static routines for this file:
+ * Static functions defined in this file.
*/
-static int TcpConnect(Tcl_Interp *interp,
- TcpState *state);
+static SocketInfo * CreateSocket(Tcl_Interp *interp, int port,
+ const char *host, int server, const char *myaddr,
+ int myport, int async);
+static int CreateSocketAddress(LPSOCKADDR_IN sockaddrPtr,
+ const char *host, int port);
static void InitSockets(void);
-static TcpState * NewSocketInfo(SOCKET socket);
+static SocketInfo * NewSocketInfo(SOCKET socket);
static void SocketExitHandler(ClientData clientData);
static LRESULT CALLBACK SocketProc(HWND hwnd, UINT message, WPARAM wParam,
LPARAM lParam);
static int SocketsEnabled(void);
-static void TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
-static int WaitForConnect(TcpState *statePtr, int *errorCodePtr);
-static int WaitForSocketEvent(TcpState *statePtr, int events,
+static void TcpAccept(SocketInfo *infoPtr);
+static int WaitForSocketEvent(SocketInfo *infoPtr, int events,
int *errorCodePtr);
-static void AddSocketInfoFd(TcpState *statePtr, SOCKET socket);
-static int FindFDInList(TcpState *statePtr, SOCKET socket);
static DWORD WINAPI SocketThread(LPVOID arg);
static void TcpThreadActionProc(ClientData instanceData,
int action);
@@ -259,9 +205,8 @@ static void TcpThreadActionProc(ClientData instanceData,
static Tcl_EventCheckProc SocketCheckProc;
static Tcl_EventProc SocketEventProc;
static Tcl_EventSetupProc SocketSetupProc;
-static Tcl_DriverBlockModeProc TcpBlockModeProc;
+static Tcl_DriverBlockModeProc TcpBlockProc;
static Tcl_DriverCloseProc TcpCloseProc;
-static Tcl_DriverClose2Proc TcpClose2Proc;
static Tcl_DriverSetOptionProc TcpSetOptionProc;
static Tcl_DriverGetOptionProc TcpGetOptionProc;
static Tcl_DriverInputProc TcpInputProc;
@@ -271,180 +216,192 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc;
/*
* This structure describes the channel type structure for TCP socket
- * based IO:
+ * based IO.
*/
-static const Tcl_ChannelType tcpChannelType = {
- "tcp", /* Type name. */
- TCL_CHANNEL_VERSION_5, /* v5 channel */
- TcpCloseProc, /* Close proc. */
- TcpInputProc, /* Input proc. */
- TcpOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- TcpSetOptionProc, /* Set option proc. */
- TcpGetOptionProc, /* Get option proc. */
- TcpWatchProc, /* Initialize notifier. */
- TcpGetHandleProc, /* Get OS handles out of channel. */
- TcpClose2Proc, /* Close2 proc. */
- TcpBlockModeProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- NULL, /* wide seek proc. */
- TcpThreadActionProc, /* thread action proc. */
- NULL /* truncate proc. */
+static Tcl_ChannelType tcpChannelType = {
+ "tcp", /* Type name. */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
+ TcpCloseProc, /* Close proc. */
+ TcpInputProc, /* Input proc. */
+ TcpOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ TcpSetOptionProc, /* Set option proc. */
+ TcpGetOptionProc, /* Get option proc. */
+ TcpWatchProc, /* Set up notifier to watch this channel. */
+ TcpGetHandleProc, /* Get an OS handle from channel. */
+ NULL, /* close2proc. */
+ TcpBlockProc, /* Set socket into (non-)blocking mode. */
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
+ NULL, /* wide seek proc */
+ TcpThreadActionProc, /* thread action proc */
+ NULL, /* truncate */
};
-
-/*
- * The following variable holds the network name of this host.
- */
-
-static TclInitProcessGlobalValueProc InitializeHostName;
-static ProcessGlobalValue hostName =
- {0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
-
-/*
- * Address print debug functions
- */
-#if 0
-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);
-}
-void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
-{
- struct addrinfo *ai;
- for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
- printaddrinfo(ai, prefix);
- }
-}
-#endif
/*
*----------------------------------------------------------------------
*
- * InitializeHostName --
+ * InitSockets --
*
- * This routine sets the process global value of the name of the local
- * host on which the process is running.
+ * Initialize the socket module. If winsock startup is successful,
+ * registers the event window for the socket notifier code.
+ *
+ * Assumes socketMutex is held.
*
* Results:
* None.
*
+ * Side effects:
+ * Initializes winsock, registers a new window class and creates a
+ * window for use in asynchronous socket notification.
+ *
*----------------------------------------------------------------------
*/
-void
-InitializeHostName(
- char **valuePtr,
- int *lengthPtr,
- Tcl_Encoding *encodingPtr)
+static void
+InitSockets(void)
{
- TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1];
- DWORD length = MAX_COMPUTERNAME_LENGTH + 1;
- Tcl_DString ds;
+ DWORD id;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
+
+ if (!initialized) {
+ initialized = 1;
+ TclCreateLateExitHandler(SocketExitHandler, (ClientData) NULL);
- if (GetComputerName(tbuf, &length) != 0) {
/*
- * Convert string from native to UTF then change to lowercase.
+ * Create the async notification window with a new class. We must
+ * create a new class to avoid a Windows 95 bug that causes us to get
+ * the wrong message number for socket events if the message window is
+ * a subclass of a static control.
*/
- Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds));
+ windowClass.style = 0;
+ windowClass.cbClsExtra = 0;
+ windowClass.cbWndExtra = 0;
+ windowClass.hInstance = TclWinGetTclInstance();
+ windowClass.hbrBackground = NULL;
+ windowClass.lpszMenuName = NULL;
+ windowClass.lpszClassName = "TclSocket";
+ windowClass.lpfnWndProc = SocketProc;
+ windowClass.hIcon = NULL;
+ windowClass.hCursor = NULL;
- } else {
- Tcl_DStringInit(&ds);
- if (TclpHasSockets(NULL) == TCL_OK) {
- /*
- * The buffer size of 256 is recommended by the MSDN page that
- * documents gethostname() as being always adequate.
- */
+ if (!RegisterClassA(&windowClass)) {
+ TclWinConvertError(GetLastError());
+ goto initFailure;
+ }
- Tcl_DString inDs;
+ }
- Tcl_DStringInit(&inDs);
- Tcl_DStringSetLength(&inDs, 256);
- if (gethostname(Tcl_DStringValue(&inDs),
- Tcl_DStringLength(&inDs)) == 0) {
- Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
- &ds);
- }
- Tcl_DStringFree(&inDs);
+ /*
+ * Check for per-thread initialization.
+ */
+
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->pendingSocketInfo = NULL;
+ tsdPtr->socketList = NULL;
+ tsdPtr->hwnd = NULL;
+ tsdPtr->threadId = Tcl_GetCurrentThread();
+ tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+ if (tsdPtr->readyEvent == NULL) {
+ goto initFailure;
+ }
+ tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
+ if (tsdPtr->socketListLock == NULL) {
+ goto initFailure;
+ }
+ tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr,
+ 0, &id);
+ if (tsdPtr->socketThread == NULL) {
+ goto initFailure;
+ }
+
+ SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
+
+ /*
+ * Wait for the thread to signal when the window has been created and
+ * if it is ready to go.
+ */
+
+ WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+
+ if (tsdPtr->hwnd == NULL) {
+ goto initFailure; /* Trouble creating the window */
}
+
+ Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
}
+ return;
- *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
- *lengthPtr = Tcl_DStringLength(&ds);
- *valuePtr = ckalloc((*lengthPtr) + 1);
- memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
- Tcl_DStringFree(&ds);
+ initFailure:
+ TclpFinalizeSockets();
+ initialized = -1;
+ return;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetHostName --
+ * SocketsEnabled --
*
- * Returns the name of the local host.
+ * Check that the WinSock was successfully initialized.
*
* Results:
- * A string containing the network name for this machine, or an empty
- * string if we can't figure out the name. The caller must not modify or
- * free this string.
+ * 1 if it is.
*
* Side effects:
- * Caches the name to return for future calls.
+ * None.
*
*----------------------------------------------------------------------
*/
-const char *
-Tcl_GetHostName(void)
+ /* ARGSUSED */
+static int
+SocketsEnabled(void)
{
- return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
+ int enabled;
+ Tcl_MutexLock(&socketMutex);
+ enabled = (initialized == 1);
+ Tcl_MutexUnlock(&socketMutex);
+ return enabled;
}
+
/*
*----------------------------------------------------------------------
*
- * TclpHasSockets --
+ * SocketExitHandler --
*
- * This function determines whether sockets are available on the current
- * system and returns an error in interp if they are not. Note that
- * interp may be NULL.
+ * Callback invoked during exit clean up to delete the socket
+ * communication window and to release the WinSock DLL.
*
* Results:
- * Returns TCL_OK if the system supports sockets, or TCL_ERROR with an
- * error in interp (if non-NULL).
+ * None.
*
* Side effects:
- * If not already prepared, initializes the TSD structure and socket
- * message handling thread associated to the calling thread for the
- * subsystem of the driver.
+ * None.
*
*----------------------------------------------------------------------
*/
-int
-TclpHasSockets(
- Tcl_Interp *interp) /* Where to write an error message if sockets
- * are not present, or NULL if no such message
- * is to be written. */
+ /* ARGSUSED */
+static void
+SocketExitHandler(
+ ClientData clientData) /* Not used. */
{
Tcl_MutexLock(&socketMutex);
- InitSockets();
- Tcl_MutexUnlock(&socketMutex);
+ /*
+ * Make sure the socket event handling window is cleaned-up for, at
+ * most, this thread.
+ */
- if (SocketsEnabled()) {
- return TCL_OK;
- }
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "sockets are not available on this system", -1));
- }
- return TCL_ERROR;
+ TclpFinalizeSockets();
+ UnregisterClass("TclSocket", TclWinGetTclInstance());
+ initialized = 0;
+ Tcl_MutexUnlock(&socketMutex);
}
/*
@@ -469,490 +426,346 @@ TclpHasSockets(
void
TclpFinalizeSockets(void)
{
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- /*
- * Careful! This is a finalizer!
- */
-
- if (tsdPtr == NULL) {
- return;
- }
-
- if (tsdPtr->socketThread != NULL) {
- if (tsdPtr->hwnd != NULL) {
- PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);
-
- /*
- * Wait for the thread to exit. This ensures that we are
- * completely cleaned up before we leave this function.
- */
+ ThreadSpecificData *tsdPtr;
- WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
- tsdPtr->hwnd = NULL;
+ tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr != NULL) {
+ if (tsdPtr->socketThread != NULL) {
+ if (tsdPtr->hwnd != NULL) {
+ if (PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0)) {
+ /*
+ * Wait for the thread to exit. This ensures that we are
+ * completely cleaned up before we leave this function.
+ */
+ WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+ }
+ tsdPtr->hwnd = NULL;
+ }
+ CloseHandle(tsdPtr->socketThread);
+ tsdPtr->socketThread = NULL;
}
- CloseHandle(tsdPtr->socketThread);
- tsdPtr->socketThread = NULL;
- }
- if (tsdPtr->readyEvent != NULL) {
- CloseHandle(tsdPtr->readyEvent);
- tsdPtr->readyEvent = NULL;
- }
- if (tsdPtr->socketListLock != NULL) {
- CloseHandle(tsdPtr->socketListLock);
- tsdPtr->socketListLock = NULL;
+ if (tsdPtr->readyEvent != NULL) {
+ CloseHandle(tsdPtr->readyEvent);
+ tsdPtr->readyEvent = NULL;
+ }
+ if (tsdPtr->socketListLock != NULL) {
+ CloseHandle(tsdPtr->socketListLock);
+ tsdPtr->socketListLock = NULL;
+ }
+ Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
}
- Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
}
/*
*----------------------------------------------------------------------
*
- * TcpBlockModeProc --
+ * TclpHasSockets --
*
- * This function is invoked by the generic IO level to set blocking and
- * nonblocking mode on a TCP socket based channel.
+ * This function determines whether sockets are available on the current
+ * system and returns an error in interp if they are not. Note that
+ * interp may be NULL.
*
* Results:
- * 0 if successful, errno when failed.
+ * Returns TCL_OK if the system supports sockets, or TCL_ERROR with an
+ * error in interp (if non-NULL).
*
* Side effects:
- * Sets the device into blocking or nonblocking mode.
+ * If not already prepared, initializes the TSD structure and socket
+ * message handling thread associated to the calling thread for the
+ * subsystem of the driver.
*
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
-static int
-TcpBlockModeProc(
- ClientData instanceData, /* Socket state. */
- int mode) /* The mode to set. Can be one of
- * TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
+int
+TclpHasSockets(
+ Tcl_Interp *interp) /* Where to write an error message if sockets
+ * are not present, or NULL if no such message
+ * is to be written. */
{
- TcpState *statePtr = instanceData;
+ Tcl_MutexLock(&socketMutex);
+ InitSockets();
+ Tcl_MutexUnlock(&socketMutex);
- if (mode == TCL_MODE_NONBLOCKING) {
- statePtr->flags |= TCP_NONBLOCKING;
- } else {
- statePtr->flags &= ~(TCP_NONBLOCKING);
+ if (SocketsEnabled()) {
+ return TCL_OK;
}
- return 0;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "sockets are not available on this system",
+ NULL);
+ }
+ return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * 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'.
+ * SocketSetupProc --
*
- * There are two modes of operation, defined by errorCodePtr:
- * * 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.
+ * This function is invoked before Tcl_DoOneEvent blocks waiting for an
+ * event.
*
* Results:
- * 0 if the connection has completed, -1 if still in progress
- * or there is an error.
+ * None.
*
* Side effects:
- * Processes socket events off the system queue.
- * May process asynchroneous connect.
+ * Adjusts the block time if needed.
*
*----------------------------------------------------------------------
*/
-static int
-WaitForConnect(
- TcpState *statePtr, /* State of the socket. */
- int *errorCodePtr) /* Where to store errors?
- * A passed null-pointer activates background mode.
- */
+void
+SocketSetupProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
- int result;
- int oldMode;
- ThreadSpecificData *tsdPtr;
-
- /*
- * Check if an async connect failed already and error reporting is demanded,
- * return the error ENOTCONN
- */
+ SocketInfo *infoPtr;
+ Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (errorCodePtr != NULL && (statePtr->flags & TCP_ASYNC_FAILED)) {
- *errorCodePtr = ENOTCONN;
- return -1;
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
}
/*
- * Check if an async connect is running. If not return ok
+ * Check to see if there is a ready socket. If so, poll.
*/
- if (!(statePtr->flags & TCP_ASYNC_CONNECT)) {
- return 0;
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->readyEvents & infoPtr->watchEvents) {
+ Tcl_SetMaxBlockTime(&blockTime);
+ break;
+ }
}
+ SetEvent(tsdPtr->socketListLock);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketCheckProc --
+ *
+ * This function is called by Tcl_DoOneEvent to check the socket event
+ * source for events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * Be sure to disable event servicing so we are truly modal.
- */
+static void
+SocketCheckProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+{
+ SocketInfo *infoPtr;
+ SocketEvent *evPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
/*
- * Loop in the blocking case until the connect signal is present
+ * Queue events for any ready sockets that don't already have events
+ * queued (caused by persistent states that won't generate WinSock
+ * events).
*/
- while (1) {
-
- /* get statePtr lock */
- tsdPtr = TclThreadDataKeyGet(&dataKey);
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-
- /* Check for connect event */
- if (statePtr->readyEvents & FD_CONNECT) {
-
- /* Consume the connect event */
- statePtr->readyEvents &= ~(FD_CONNECT);
-
- /*
- * For blocking sockets and foreground processing
- * disable async connect as we continue now synchoneously
- */
- if ( errorCodePtr != NULL &&
- ! (statePtr->flags & TCP_NONBLOCKING) ) {
- CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
- }
-
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
-
- /*
- * Continue connect.
- * If switched to synchroneous connect, the connect is terminated.
- */
- result = TcpConnect(NULL, statePtr);
-
- /* Restore event service mode */
- (void) Tcl_SetServiceMode(oldMode);
-
- /*
- * Check for Succesfull connect or async connect restart
- */
-
- if (result == TCL_OK) {
- /*
- * Check for async connect restart
- * (not possible for foreground blocking operation)
- */
- if ( statePtr->flags & TCP_ASYNC_PENDING ) {
- if (errorCodePtr != NULL) {
- *errorCodePtr = EWOULDBLOCK;
- }
- return -1;
- }
- return 0;
- }
-
- /*
- * Connect finally failed.
- * For foreground operation return ENOTCONN.
- */
-
- if (errorCodePtr != NULL) {
- *errorCodePtr = ENOTCONN;
- }
- return -1;
- }
-
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
-
- /*
- * Background operation returns with no action as there was no connect
- * event
- */
-
- if ( errorCodePtr == NULL ) {
- return -1;
- }
-
- /*
- * A non blocking socket waiting for an asyncronous connect
- * returns directly the error EWOULDBLOCK
- */
-
- if (statePtr->flags & TCP_NONBLOCKING) {
- *errorCodePtr = EWOULDBLOCK;
- return -1;
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if ((infoPtr->readyEvents & infoPtr->watchEvents)
+ && !(infoPtr->flags & SOCKET_PENDING)) {
+ infoPtr->flags |= SOCKET_PENDING;
+ evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
+ evPtr->header.proc = SocketEventProc;
+ evPtr->socket = infoPtr->socket;
+ Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
}
-
- /*
- * Wait until something happens.
- */
-
- WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
}
+ SetEvent(tsdPtr->socketListLock);
}
/*
*----------------------------------------------------------------------
*
- * TcpInputProc --
+ * SocketEventProc --
*
- * This function is invoked by the generic IO level to read input from a
- * TCP socket based channel.
+ * This function is called by Tcl_ServiceEvent when a socket event
+ * reaches the front of the event queue. This function is responsible for
+ * notifying the generic channel code.
*
* Results:
- * The number of bytes read is returned or -1 on error. An output
- * argument contains the POSIX error code on error, or zero if no error
- * occurred.
+ * Returns 1 if the event was handled, meaning it should be removed from
+ * the queue. Returns 0 if the event was not handled, meaning it should
+ * stay on the queue. The only time the event isn't handled is if the
+ * TCL_FILE_EVENTS flag bit isn't set.
*
* Side effects:
- * Reads input from the input device of the channel.
+ * Whatever the channel callback functions do.
*
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
static int
-TcpInputProc(
- ClientData instanceData, /* Socket state. */
- char *buf, /* Where to store data read. */
- int bufSize, /* How much space is available in the
- * buffer? */
- int *errorCodePtr) /* Where to store error code. */
+SocketEventProc(
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to handle,
+ * such as TCL_FILE_EVENTS. */
{
- TcpState *statePtr = instanceData;
- int bytesRead;
- DWORD error;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+ SocketInfo *infoPtr;
+ SocketEvent *eventPtr = (SocketEvent *) evPtr;
+ int mask = 0;
+ int events;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- *errorCodePtr = 0;
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return 0;
+ }
/*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
+ * Find the specified socket on the socket list.
*/
- if (!SocketsEnabled()) {
- *errorCodePtr = EFAULT;
- return -1;
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->socket == eventPtr->socket) {
+ break;
+ }
}
+ SetEvent(tsdPtr->socketListLock);
/*
- * First check to see if EOF was already detected, to prevent calling the
- * socket stack after the first time EOF is detected.
+ * Discard events that have gone stale.
*/
- if (statePtr->flags & SOCKET_EOF) {
- return 0;
+ if (!infoPtr) {
+ return 1;
}
+ infoPtr->flags &= ~SOCKET_PENDING;
+
/*
- * Check if there is an async connect running.
- * For blocking sockets terminate connect, otherwise do one step.
- * For a non blocking socket return EWOULDBLOCK if connect not terminated
+ * Handle connection requests directly.
*/
- if (WaitForConnect(statePtr, errorCodePtr) != 0) {
- return -1;
+ if (infoPtr->readyEvents & FD_ACCEPT) {
+ TcpAccept(infoPtr);
+ return 1;
}
/*
- * No EOF, and it is connected, so try to read more from the socket. Note
- * that we clear the FD_READ bit because read events are level triggered
- * so a new event will be generated if there is still data available to be
- * read. We have to simulate blocking behavior here since we are always
- * using non-blocking sockets.
+ * Mask off unwanted events and compute the read/write mask so we can
+ * notify the channel.
*/
- while (1) {
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) UNSELECT, (LPARAM) 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);
+ events = infoPtr->readyEvents & infoPtr->watchEvents;
+ if (events & FD_CLOSE) {
/*
- * Check for end-of-file condition or successful read.
+ * 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
+ * event until someone does something with the channel. Note that we
+ * do this before calling Tcl_NotifyChannel so we don't have to watch
+ * out for the channel being deleted out from under us. This may cause
+ * a redundant trip through the event loop, but it's simpler than
+ * trying to do unwind protection.
*/
- if (bytesRead == 0) {
- statePtr->flags |= SOCKET_EOF;
- }
- if (bytesRead != SOCKET_ERROR) {
- break;
- }
-
+ Tcl_Time blockTime = { 0, 0 };
+ Tcl_SetMaxBlockTime(&blockTime);
+ mask |= TCL_READABLE|TCL_WRITABLE;
+ } else if (events & FD_READ) {
/*
- * If an error occurs after the FD_CLOSE has arrived, then ignore the
- * error and report an EOF.
+ * Throw the readable event if an async connect failed.
*/
- if (statePtr->readyEvents & FD_CLOSE) {
- statePtr->flags |= SOCKET_EOF;
- bytesRead = 0;
- break;
- }
+ if (infoPtr->lastError) {
- error = WSAGetLastError();
+ mask |= TCL_READABLE;
+
+ } else {
+ fd_set readFds;
+ struct timeval timeout;
- /*
- * If an RST comes, then ignore the error and report an EOF just like
- * on unix.
- */
+ /*
+ * We must check to see if data is really available, since someone
+ * could have consumed the data in the meantime. Turn off async
+ * notification so select will work correctly. If the socket is still
+ * readable, notify the channel driver, otherwise reset the async
+ * select handler and keep waiting.
+ */
- if (error == WSAECONNRESET) {
- statePtr->flags |= SOCKET_EOF;
- bytesRead = 0;
- break;
- }
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) UNSELECT, (LPARAM) infoPtr);
- /*
- * Check for error condition or underflow in non-blocking case.
- */
+ FD_ZERO(&readFds);
+ FD_SET(infoPtr->socket, &readFds);
+ timeout.tv_usec = 0;
+ timeout.tv_sec = 0;
- if ((statePtr->flags & TCP_NONBLOCKING) || (error != WSAEWOULDBLOCK)) {
- TclWinConvertError(error);
- *errorCodePtr = Tcl_GetErrno();
- bytesRead = -1;
- break;
+ if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
+ mask |= TCL_READABLE;
+ } else {
+ infoPtr->readyEvents &= ~(FD_READ);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
+ }
}
+ }
- /*
- * In the blocking case, wait until the file becomes readable or
- * closed and try again.
- */
+ /*
+ * writable event
+ */
- if (!WaitForSocketEvent(statePtr, FD_READ|FD_CLOSE, errorCodePtr)) {
- bytesRead = -1;
- break;
- }
+ if (events & FD_WRITE) {
+ mask |= TCL_WRITABLE;
}
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
-
- return bytesRead;
+ if (mask) {
+ Tcl_NotifyChannel(infoPtr->channel, mask);
+ }
+ return 1;
}
/*
*----------------------------------------------------------------------
*
- * TcpOutputProc --
+ * TcpBlockProc --
*
- * This function is called by the generic IO level to write data to a
- * socket based channel.
+ * Sets a socket into blocking or non-blocking mode.
*
* Results:
- * The number of bytes written or -1 on failure.
+ * 0 if successful, errno if there was an error.
*
* Side effects:
- * Produces output on the socket.
+ * None.
*
*----------------------------------------------------------------------
*/
static int
-TcpOutputProc(
- ClientData instanceData, /* Socket state. */
- const char *buf, /* The data buffer. */
- int toWrite, /* How many bytes to write? */
- int *errorCodePtr) /* Where to store error code. */
+TcpBlockProc(
+ ClientData instanceData, /* The socket to block/un-block. */
+ int mode) /* TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
{
- TcpState *statePtr = instanceData;
- int written;
- DWORD error;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- *errorCodePtr = 0;
-
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
+ SocketInfo *infoPtr = (SocketInfo *) instanceData;
- if (!SocketsEnabled()) {
- *errorCodePtr = EFAULT;
- return -1;
- }
-
- /*
- * Check if there is an async connect running.
- * For blocking sockets terminate connect, otherwise do one step.
- * For a non blocking socket return EWOULDBLOCK if connect not terminated
- */
-
- if (WaitForConnect(statePtr, errorCodePtr) != 0) {
- return -1;
- }
-
- while (1) {
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) UNSELECT, (LPARAM) statePtr);
-
- /* single fd operation: this proc is only called for a connected socket. */
- written = send(statePtr->sockets->fd, buf, toWrite, 0);
- if (written != SOCKET_ERROR) {
- /*
- * Since Windows won't generate a new write event until we hit an
- * overflow condition, we need to force the event loop to poll
- * until the condition changes.
- */
-
- if (statePtr->watchEvents & FD_WRITE) {
- Tcl_Time blockTime = { 0, 0 };
- Tcl_SetMaxBlockTime(&blockTime);
- }
- break;
- }
-
- /*
- * Check for error condition or overflow. In the event of overflow, we
- * need to clear the FD_WRITE flag so we can detect the next writable
- * event. Note that Windows only sends a new writable event after a
- * send fails with WSAEWOULDBLOCK.
- */
-
- error = WSAGetLastError();
- if (error == WSAEWOULDBLOCK) {
- statePtr->readyEvents &= ~(FD_WRITE);
- if (statePtr->flags & TCP_NONBLOCKING) {
- *errorCodePtr = EWOULDBLOCK;
- written = -1;
- break;
- }
- } else {
- TclWinConvertError(error);
- *errorCodePtr = Tcl_GetErrno();
- written = -1;
- break;
- }
-
- /*
- * In the blocking case, wait until the file becomes writable or
- * closed and try again.
- */
-
- if (!WaitForSocketEvent(statePtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
- written = -1;
- break;
- }
+ if (mode == TCL_MODE_NONBLOCKING) {
+ infoPtr->flags |= SOCKET_ASYNC;
+ } else {
+ infoPtr->flags &= ~(SOCKET_ASYNC);
}
-
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
-
- return written;
+ return 0;
}
/*
@@ -979,7 +792,7 @@ TcpCloseProc(
ClientData instanceData, /* The socket to close. */
Tcl_Interp *interp) /* Unused. */
{
- TcpState *statePtr = instanceData;
+ SocketInfo *infoPtr = (SocketInfo *) instanceData;
/* TIP #218 */
int errorCode = 0;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -997,37 +810,24 @@ TcpCloseProc(
* background.
*/
- while ( statePtr->sockets != NULL ) {
- TcpFdList *thisfd = statePtr->sockets;
- statePtr->sockets = thisfd->next;
-
- if (closesocket(thisfd->fd) == SOCKET_ERROR) {
- TclWinConvertError((DWORD) WSAGetLastError());
- errorCode = Tcl_GetErrno();
- }
- ckfree(thisfd);
+ if (closesocket(infoPtr->socket) == SOCKET_ERROR) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ errorCode = Tcl_GetErrno();
}
}
- if (statePtr->addrlist != NULL) {
- freeaddrinfo(statePtr->addrlist);
- }
- if (statePtr->myaddrlist != NULL) {
- freeaddrinfo(statePtr->myaddrlist);
- }
-
/*
* 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) {
+ if (tsdPtr->pendingSocketInfo != NULL
+ && tsdPtr->pendingSocketInfo == infoPtr) {
/* get infoPtr lock, because this concerns the notifier thread */
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- tsdPtr->pendingTcpState = NULL;
+ tsdPtr->pendingSocketInfo = NULL;
/* Free list lock */
SetEvent(tsdPtr->socketListLock);
@@ -1040,93 +840,92 @@ TcpCloseProc(
* fear of damaging the list.
*/
- ckfree(statePtr);
+ ckfree((char *) infoPtr);
return errorCode;
}
/*
*----------------------------------------------------------------------
*
- * TcpClose2Proc --
+ * NewSocketInfo --
*
- * This function is called by the generic IO level to perform the channel
- * type specific part of a half-close: namely, a shutdown() on a socket.
+ * This function allocates and initializes a new SocketInfo structure.
*
* Results:
- * 0 if successful, the value of errno if failed.
+ * Returns a newly allocated SocketInfo.
*
* Side effects:
- * Shuts down one side of the socket.
+ * None, except for allocation of memory.
*
*----------------------------------------------------------------------
*/
-static int
-TcpClose2Proc(
- ClientData instanceData, /* The socket to close. */
- Tcl_Interp *interp, /* For error reporting. */
- int flags) /* Flags that indicate which side to close. */
+static SocketInfo *
+NewSocketInfo(
+ SOCKET socket)
{
- TcpState *statePtr = instanceData;
- int errorCode = 0;
- int sd;
+ SocketInfo *infoPtr;
+ /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
+
+ infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
+ infoPtr->channel = 0;
+ infoPtr->socket = socket;
+ infoPtr->flags = 0;
+ infoPtr->watchEvents = 0;
+ infoPtr->readyEvents = 0;
+ infoPtr->selectEvents = 0;
+ infoPtr->acceptEventCount = 0;
+ infoPtr->acceptProc = NULL;
+ infoPtr->acceptProcData = NULL;
+ infoPtr->lastError = 0;
/*
- * Shutdown the OS socket handle.
+ * TIP #218. Removed the code inserting the new structure into the global
+ * list. This is now handled in the thread action callbacks, and only
+ * there.
*/
- switch(flags) {
- case TCL_CLOSE_READ:
- sd = SD_RECEIVE;
- break;
- case TCL_CLOSE_WRITE:
- sd = SD_SEND;
- break;
- default:
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "socket close2proc called bidirectionally", -1));
- }
- 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. */
- if (shutdown(statePtr->sockets->fd, sd) == SOCKET_ERROR) {
- TclWinConvertError((DWORD) WSAGetLastError());
- errorCode = Tcl_GetErrno();
- }
+ infoPtr->nextPtr = NULL;
- return errorCode;
+ return infoPtr;
}
/*
*----------------------------------------------------------------------
*
- * TcpSetOptionProc --
+ * CreateSocket --
*
- * Sets Tcp channel specific options.
+ * This function opens a new socket and initializes the SocketInfo
+ * structure.
*
* Results:
- * None, unless an error happens.
+ * Returns a new SocketInfo, or NULL with an error in interp.
*
* Side effects:
- * Changes attributes of the socket at the system level.
+ * None, except for allocation of memory.
*
*----------------------------------------------------------------------
*/
-static int
-TcpSetOptionProc(
- ClientData instanceData, /* Socket state. */
- Tcl_Interp *interp, /* For error reporting - can be NULL. */
- const char *optionName, /* Name of the option to set. */
- const char *value) /* New value for option. */
+static SocketInfo *
+CreateSocket(
+ Tcl_Interp *interp, /* For error reporting; can be NULL. */
+ int port, /* Port number to open. */
+ const char *host, /* Name of host on which to open port. */
+ int server, /* 1 if socket should be a server socket, else
+ * 0 for a client socket. */
+ const char *myaddr, /* Optional client-side address */
+ int myport, /* Optional client-side port */
+ int async) /* If nonzero, connect client socket
+ * asynchronously. */
{
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- TcpState *statePtr = instanceData;
- SOCKET sock;
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+ u_long flag = 1; /* Indicates nonblocking mode. */
+ SOCKADDR_IN sockaddr; /* Socket address */
+ SOCKADDR_IN mysockaddr; /* Socket address for client */
+ SOCKET sock = INVALID_SOCKET;
+ SocketInfo *infoPtr=NULL; /* The returned value. */
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
/*
* Check that WinSock is initialized; do not call it if not, to prevent
@@ -1135,748 +934,345 @@ TcpSetOptionProc(
*/
if (!SocketsEnabled()) {
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "winsock is not initialized", -1));
- }
- return TCL_ERROR;
+ return NULL;
}
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- #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")) {
- BOOL val = FALSE;
- int boolVar, rtn;
-
- if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
- return TCL_ERROR;
- }
- if (boolVar) {
- val = TRUE;
- }
- rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
- (const char *) &val, sizeof(BOOL));
- if (rtn != 0) {
- TclWinConvertError(WSAGetLastError());
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't set socket option: %s",
- Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- return TCL_OK;
- } else if (!strcasecmp(optionName, "-nagle")) {
- BOOL val = FALSE;
- int boolVar, rtn;
-
- if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
- return TCL_ERROR;
- }
- if (!boolVar) {
- val = TRUE;
- }
- rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
- (const char *) &val, sizeof(BOOL));
- if (rtn != 0) {
- TclWinConvertError(WSAGetLastError());
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't set socket option: %s",
- Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- return TCL_OK;
+ if (!CreateSocketAddress(&sockaddr, host, port)) {
+ goto error;
+ }
+ if ((myaddr != NULL || myport != 0) &&
+ !CreateSocketAddress(&mysockaddr, myaddr, myport)) {
+ goto error;
}
- return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
-#else
- return Tcl_BadChannelOption(interp, optionName, "");
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpGetOptionProc --
- *
- * Computes an option value for a TCP socket based channel, or a list of
- * all options and their values.
- *
- * Note: This code is based on code contributed by John Haxby.
- *
- * Results:
- * A standard Tcl result. The value of the specified option or a list of
- * all options and their values is returned in the supplied DString. Sets
- * Error message if needed.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpGetOptionProc(
- ClientData instanceData, /* Socket state. */
- Tcl_Interp *interp, /* For error reporting - can be NULL. */
- const char *optionName, /* Name of the option to retrieve the value
- * for, or NULL to get all options and their
- * values. */
- Tcl_DString *dsPtr) /* Where to store the computed value;
- * initialized by caller. */
-{
- TcpState *statePtr = instanceData;
- char host[NI_MAXHOST], port[NI_MAXSERV];
- SOCKET sock;
- size_t len = 0;
- int reverseDNS = 0;
-#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
+ sock = socket(AF_INET, SOCK_STREAM, 0);
+ if (sock == INVALID_SOCKET) {
+ goto error;
+ }
/*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
+ * Win-NT has a misfeature that sockets are inherited in child processes
+ * by default. Turn off the inherit bit.
*/
- if (!SocketsEnabled()) {
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "winsock is not initialized", -1));
- }
- return TCL_ERROR;
- }
+ SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
/*
- * Go one step in async connect
- * If any error is thrown save it as backround error to report eventually below
+ * Set kernel space buffering
*/
- WaitForConnect(statePtr, NULL);
- sock = statePtr->sockets->fd;
- if (optionName != NULL) {
- len = strlen(optionName);
- }
+ TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
- if ((len > 1) && (optionName[1] == 'e') &&
- (strncmp(optionName, "-error", len) == 0)) {
+ if (server) {
+ /*
+ * 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.
+ *
+ * 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, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN))
+ == SOCKET_ERROR) {
+ goto error;
+ }
/*
- * Do not return any errors if async connect is running
- */
- if ( ! (statePtr->flags & TCP_ASYNC_PENDING) ) {
+ * Set the maximum number of pending connect requests to the max value
+ * allowed on each platform (Win32 and Win32s may be different, and
+ * there may be differences between TCP/IP stacks).
+ */
+ if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
+ goto error;
+ }
- if ( statePtr->flags & TCP_ASYNC_FAILED ) {
+ /*
+ * Add this socket to the global list of sockets.
+ */
- /*
- * 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.
- */
+ infoPtr = NewSocketInfo(sock);
- if ( statePtr->connectError != 0 ) {
- Tcl_DStringAppend(dsPtr,
- Tcl_ErrnoMsg(statePtr->connectError), -1);
- statePtr->connectError = 0;
- }
+ /*
+ * Set up the select mask for connection request events.
+ */
- } else {
+ infoPtr->selectEvents = FD_ACCEPT;
+ infoPtr->watchEvents |= FD_ACCEPT;
- /*
- * Report an eventual last error of the socket system
- */
+ /*
+ * Register for interest in events in the select mask. Note that this
+ * automatically places the socket into non-blocking mode.
+ */
+
+ ioctlsocket(sock, (long) FIONBIO, &flag);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+ (LPARAM) infoPtr);
- int optlen;
- int ret;
- DWORD err;
+ } else {
+ /*
+ * Try to bind to a local port, if specified.
+ */
- /*
- * Populater the err Variable with a possix 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
- */
- if (ret == SOCKET_ERROR) {
- err = WSAGetLastError();
- }
- /*
- * Return error message
- */
- if (err) {
- TclWinConvertError(err);
- Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
- }
+ if (myaddr != NULL || myport != 0) {
+ if (bind(sock, (SOCKADDR *) &mysockaddr, sizeof(SOCKADDR_IN))
+ == SOCKET_ERROR) {
+ goto error;
}
}
- return TCL_OK;
- }
- if ((len > 1) && (optionName[1] == 'c') &&
- (strncmp(optionName, "-connecting", len) == 0)) {
+ /*
+ * Allocate socket info structure
+ */
- Tcl_DStringAppend(dsPtr,
- (statePtr->flags & TCP_ASYNC_PENDING)
- ? "1" : "0", -1);
- return TCL_OK;
- }
+ infoPtr = NewSocketInfo(sock);
- if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
- reverseDNS = NI_NUMERICHOST;
- }
+ /*
+ * Set the socket into nonblocking mode if the connect should be done
+ * in the background. Activate connect notification.
+ */
- if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
- (strncmp(optionName, "-peername", len) == 0))) {
- address peername;
- socklen_t size = sizeof(peername);
+ if (async) {
+
+ /* get infoPtr lock */
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- if ( (statePtr->flags & TCP_ASYNC_PENDING) ) {
/*
- * In async connect output an empty string
+ * Buffer new infoPtr in the tsd memory as long as it is not in
+ * the info list. This allows the event procedure to process the
+ * event.
+ * Bugfig for 336441ed59 to not ignore notifications until the
+ * infoPtr is in the list..
*/
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-peername");
- Tcl_DStringAppendElement(dsPtr, "");
- } else {
- return TCL_OK;
- }
- } else if ( getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
+
+ tsdPtr->pendingSocketInfo = infoPtr;
+
/*
- * Peername fetch succeeded - output list
+ * Set connect mask to connect events
+ * This is activated by a SOCKET_SELECT message to the notifier
+ * thread.
*/
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-peername");
- Tcl_DStringStartSublist(dsPtr);
- }
- getnameinfo(&(peername.sa), size, host, sizeof(host),
- NULL, 0, NI_NUMERICHOST);
- Tcl_DStringAppendElement(dsPtr, host);
- getnameinfo(&(peername.sa), size, host, sizeof(host),
- port, sizeof(port), reverseDNS | NI_NUMERICSERV);
- Tcl_DStringAppendElement(dsPtr, host);
- Tcl_DStringAppendElement(dsPtr, port);
- if (len == 0) {
- Tcl_DStringEndSublist(dsPtr);
- } else {
- return TCL_OK;
- }
- } else {
+ infoPtr->selectEvents |= FD_CONNECT | FD_READ | FD_WRITE | FD_CLOSE;
+ infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+
/*
- * getpeername failed - but if we were asked for all the options
- * (len==0), don't flag an error at that point because it could be
- * an fconfigure request on a server socket (such sockets have no
- * peer). {Copied from unix/tclUnixChan.c}
+ * Free list lock
*/
+ SetEvent(tsdPtr->socketListLock);
+
+ /*
+ * Activate accept notification and put in async mode
+ * Bug 336441ed59: activate notification before connect
+ * so we do not miss a notification of a fialed connect.
+ */
+ ioctlsocket(sock, (long) FIONBIO, &flag);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+ (LPARAM) infoPtr);
- if (len) {
- TclWinConvertError((DWORD) WSAGetLastError());
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get peername: %s",
- Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
}
- }
- if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
- (strncmp(optionName, "-sockname", len) == 0))) {
- TcpFdList *fds;
- address sockname;
- socklen_t size;
- int found = 0;
+ /*
+ * Attempt to connect to the remote socket.
+ */
+
+ if (connect(sock, (SOCKADDR *) &sockaddr,
+ sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ if (Tcl_GetErrno() != EWOULDBLOCK) {
+ goto error;
+ }
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-sockname");
- Tcl_DStringStartSublist(dsPtr);
- }
- if ( (statePtr->flags & TCP_ASYNC_PENDING ) ) {
/*
- * In async connect output an empty string
+ * The connection is progressing in the background.
*/
- found = 1;
+
} else {
- for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
- sock = fds->fd;
- size = sizeof(sockname);
- if (getsockname(sock, &(sockname.sa), &size) >= 0) {
- int flags = reverseDNS;
- found = 1;
- getnameinfo(&sockname.sa, size, host, sizeof(host),
- NULL, 0, NI_NUMERICHOST);
- Tcl_DStringAppendElement(dsPtr, host);
+ /*
+ * Set up the select mask for read/write events. If the connect
+ * attempt has not completed, include connect events.
+ */
- /*
- * 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) {
- flags |= NI_NUMERICHOST;
- }
- } else if (sockname.sa.sa_family == AF_INET6) {
- if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
- &in6addr_any)) ||
- (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr)
- && sockname.sa6.sin6_addr.s6_addr[12] == 0
- && sockname.sa6.sin6_addr.s6_addr[13] == 0
- && sockname.sa6.sin6_addr.s6_addr[14] == 0
- && sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
- flags |= NI_NUMERICHOST;
- }
- }
- getnameinfo(&sockname.sa, size, host, sizeof(host),
- port, sizeof(port), flags);
- Tcl_DStringAppendElement(dsPtr, host);
- Tcl_DStringAppendElement(dsPtr, port);
- }
- }
- }
- if (found) {
- if (len) {
- return TCL_OK;
- }
- Tcl_DStringEndSublist(dsPtr);
- } else {
- if (interp) {
- TclWinConvertError((DWORD) WSAGetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get sockname: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- }
+ infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
- int optlen;
- BOOL opt = FALSE;
+ /*
+ * Register for interest in events in the select mask. Note that this
+ * automatically places the socket into non-blocking mode.
+ */
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-keepalive");
- }
- optlen = sizeof(BOOL);
- getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
- if (opt) {
- Tcl_DStringAppendElement(dsPtr, "1");
- } else {
- Tcl_DStringAppendElement(dsPtr, "0");
- }
- if (len > 0) {
- return TCL_OK;
+ ioctlsocket(sock, (long) FIONBIO, &flag);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+ (LPARAM) infoPtr);
}
}
- if (len == 0 || !strncmp(optionName, "-nagle", len)) {
- int optlen;
- BOOL opt = FALSE;
+ return infoPtr;
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-nagle");
- }
- optlen = sizeof(BOOL);
- getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
- if (opt) {
- Tcl_DStringAppendElement(dsPtr, "0");
- } else {
- Tcl_DStringAppendElement(dsPtr, "1");
- }
- if (len > 0) {
- return TCL_OK;
- }
+ error:
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "couldn't open socket: ",
+ Tcl_PosixError(interp), NULL);
}
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
-
- if (len > 0) {
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- return Tcl_BadChannelOption(interp, optionName,
- "connecting peername sockname keepalive nagle");
-#else
- return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname");
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+ if (infoPtr != NULL) {
+ /*
+ * Free the allocated socket info structure and close the socket
+ */
+ TcpCloseProc(infoPtr, interp);
+ } else if (sock != INVALID_SOCKET) {
+ /*
+ * No socket structure jet - just close
+ */
+ closesocket(sock);
}
-
- return TCL_OK;
+ return NULL;
}
/*
*----------------------------------------------------------------------
*
- * TcpWatchProc --
+ * CreateSocketAddress --
*
- * Informs the channel driver of the events that the generic channel code
- * wishes to receive on this socket.
+ * This function initializes a sockaddr structure for a host and port.
*
* Results:
- * None.
+ * 1 if the host was valid, 0 if the host could not be converted to an IP
+ * address.
*
* Side effects:
- * May cause the notifier to poll if any of the specified conditions are
- * already true.
+ * Fills in the *sockaddrPtr structure.
*
*----------------------------------------------------------------------
*/
-static void
-TcpWatchProc(
- ClientData instanceData, /* The socket state. */
- int mask) /* Events of interest; an OR-ed combination of
- * TCL_READABLE, TCL_WRITABLE and
- * TCL_EXCEPTION. */
+static int
+CreateSocketAddress(
+ LPSOCKADDR_IN sockaddrPtr, /* Socket address */
+ const char *host, /* Host. NULL implies INADDR_ANY */
+ int port) /* Port number */
{
- TcpState *statePtr = instanceData;
+ struct hostent *hostent; /* Host database entry */
+ struct in_addr addr; /* For 64/32 bit madness */
/*
- * Update the watch events mask. Only if the socket is not a server
- * socket. [Bug 557878]
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
- if (!statePtr->acceptProc) {
- statePtr->watchEvents = 0;
- if (mask & TCL_READABLE) {
- statePtr->watchEvents |= (FD_READ|FD_CLOSE);
- }
- if (mask & TCL_WRITABLE) {
- statePtr->watchEvents |= (FD_WRITE|FD_CLOSE);
- }
-
- /*
- * If there are any conditions already set, then tell the notifier to
- * poll rather than block.
- */
-
- if (statePtr->readyEvents & statePtr->watchEvents) {
- Tcl_Time blockTime = { 0, 0 };
+ if (!SocketsEnabled()) {
+ Tcl_SetErrno(EFAULT);
+ return 0;
+ }
- Tcl_SetMaxBlockTime(&blockTime);
+ ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN));
+ sockaddrPtr->sin_family = AF_INET;
+ sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
+ if (host == NULL) {
+ addr.s_addr = INADDR_ANY;
+ } else {
+ addr.s_addr = inet_addr(host);
+ if (addr.s_addr == INADDR_NONE) {
+ hostent = gethostbyname(host);
+ if (hostent != NULL) {
+ memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length);
+ } else {
+#ifdef EHOSTUNREACH
+ Tcl_SetErrno(EHOSTUNREACH);
+#else
+#ifdef ENXIO
+ Tcl_SetErrno(ENXIO);
+#endif
+#endif
+ return 0; /* Error. */
+ }
}
}
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpGetHandleProc --
- *
- * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
- * TCP socket based channel.
- *
- * Results:
- * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
- * handle for the specified direction.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- /* ARGSUSED */
-static int
-TcpGetHandleProc(
- ClientData instanceData, /* The socket state. */
- int direction, /* Not used. */
- ClientData *handlePtr) /* Where to store the handle. */
-{
- TcpState *statePtr = instanceData;
+ /*
+ * NOTE: On 64 bit machines the assignment below is rumored to not do the
+ * right thing. Please report errors related to this if you observe
+ * incorrect behavior on 64 bit machines such as DEC Alphas. Should we
+ * modify this code to do an explicit memcpy?
+ */
- *handlePtr = INT2PTR(statePtr->sockets->fd);
- return TCL_OK;
+ sockaddrPtr->sin_addr.s_addr = addr.s_addr;
+ return 1; /* Success. */
}
-
-
/*
*----------------------------------------------------------------------
*
- * TcpConnect --
- *
- * This function opens a new socket in client mode.
+ * WaitForSocketEvent --
*
- * This might be called in 3 circumstances:
- * - By a regular socket command
- * - By the event handler to continue an asynchroneous connect
- * - By a blocking socket function (gets/puts) to terminate the
- * connect synchroneously
+ * Waits until one of the specified events occurs on a socket.
*
* Results:
- * TCL_OK, if the socket was successfully connected or an asynchronous
- * connection is in progress. If an error occurs, TCL_ERROR is returned
- * and an error message is left in interp.
+ * Returns 1 on success or 0 on failure, with an error code in
+ * errorCodePtr.
*
* Side effects:
- * Opens a socket.
- *
- * Remarks:
- * A single host name may resolve to more than one IP address, e.g. for
- * an IPv4/IPv6 dual stack host. For handling asyncronously connecting
- * sockets in the background for such hosts, this function can act as a
- * coroutine. On the first call, it sets up the control variables for the
- * two nested loops over the local and remote addresses. Once the first
- * connection attempt is in progress, it sets up itself as a writable
- * event handler for that socket, and returns. When the callback occurs,
- * control is transferred to the "reenter" label, right after the initial
- * return and the loops resume as if they had never been interrupted.
- * For syncronously connecting sockets, the loops work the usual way.
+ * Processes socket events off the system queue.
*
*----------------------------------------------------------------------
*/
static int
-TcpConnect(
- Tcl_Interp *interp, /* For error reporting; can be NULL. */
- TcpState *statePtr)
+WaitForSocketEvent(
+ SocketInfo *infoPtr, /* Information about this socket. */
+ int events, /* Events to look for. */
+ int *errorCodePtr) /* Where to store errors? */
{
- 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;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- if (async_callback) {
- goto reenter;
- }
-
- 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) {
-
- /*
- * No need to try combinations of local and remote addresses
- * of different families.
- */
-
- if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
- continue;
- }
-
- /*
- * 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 */
- 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);
-
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
-
- /* continue on socket creation error */
- if (statePtr->sockets->fd == INVALID_SOCKET) {
- TclWinConvertError((DWORD) WSAGetLastError());
- continue;
- }
-
- /*
- * Win-NT has a misfeature that sockets are inherited in child
- * processes by default. Turn off the inherit bit.
- */
-
- SetHandleInformation((HANDLE) statePtr->sockets->fd, HANDLE_FLAG_INHERIT, 0);
-
- /*
- * Set kernel space buffering
- */
-
- 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) {
- 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 */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-
- /*
- * Bugfig for 336441ed59 to not ignore notifications until the
- * infoPtr is in the list.
- * Check if my statePtr is already in the tsdPtr->socketList
- * 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
- */
-
- for (statePtr2 = tsdPtr->socketList; statePtr2 != NULL;
- statePtr2 = statePtr2->nextPtr) {
- if (statePtr2 == statePtr) {
- in_socket_list = 1;
- break;
- }
- }
- 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.
- */
- statePtr->selectEvents |= FD_CONNECT;
-
- /*
- * Free list lock
- */
- SetEvent(tsdPtr->socketListLock);
-
- /* activate accept notification */
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
- }
-
- /*
- * Attempt to connect to the remote socket.
- */
-
- connect(statePtr->sockets->fd, statePtr->addr->ai_addr,
- statePtr->addr->ai_addrlen);
-
- error = WSAGetLastError();
- TclWinConvertError(error);
-
- if (async_connect && error == WSAEWOULDBLOCK) {
- /*
- * Asynchroneous connect
- */
-
- /*
- * Remember that we jump back behind this next round
- */
- statePtr->flags |= TCP_ASYNC_PENDING;
- return TCL_OK;
-
- reenter:
- /*
- * Re-entry point for async connect after connect event or
- * blocking operation
- *
- * Clear the reenter flag
- */
- statePtr->flags &= ~(TCP_ASYNC_PENDING);
- /* get statePtr lock */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- /* Get signaled connect error */
- TclWinConvertError((DWORD) statePtr->notifierConnectError);
- /* Clear eventual connect flag */
- 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
- */
- tsdPtr->pendingTcpState = NULL;
-
- if (Tcl_GetErrno() == 0) {
- goto out;
- }
- }
- }
+ int result = 1;
+ int oldMode;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
-out:
/*
- * Socket connected or connection failed
+ * Be sure to disable event servicing so we are truly modal.
*/
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
+
/*
- * Async connect terminated
+ * Reset WSAAsyncSelect so we have a fresh set of events pending.
+ * Don't do that if we are waiting for a connect as we may miss
+ * a connect (bug 336441ed59).
*/
- CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
-
- if ( Tcl_GetErrno() == 0 ) {
- /*
- * Succesfully connected
- */
- /*
- * Set up the select mask for read/write events.
- */
- statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
+ if ( 0 == (events & FD_CONNECT) ) {
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
+ (LPARAM) infoPtr);
+
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+ (LPARAM) infoPtr);
+ }
- /*
- * Register for interest in events in the select mask. Note that this
- * automatically places the socket into non-blocking mode.
- */
+ while (1) {
+ if (infoPtr->lastError) {
+ *errorCodePtr = infoPtr->lastError;
+ result = 0;
+ break;
+ } else if (infoPtr->readyEvents & events) {
+ break;
+ } else if (infoPtr->flags & SOCKET_ASYNC) {
+ *errorCodePtr = EWOULDBLOCK;
+ result = 0;
+ break;
+ }
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
- } else {
/*
- * Connect failed
+ * Wait until something happens.
*/
- /*
- * 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 */
- 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' */
- statePtr->connectError = Tcl_GetErrno();
- /* 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)));
- }
- return TCL_ERROR;
+ WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
}
- return TCL_OK;
+
+ (void) Tcl_SetServiceMode(oldMode);
+ return result;
}
/*
@@ -1903,75 +1299,40 @@ Tcl_OpenTcpClient(
const char *host, /* Host on which to open port. */
const char *myaddr, /* Client-side address */
int myport, /* Client-side port */
- int async) /* If nonzero, attempt to do an asynchronous
- * connect. Otherwise we do a blocking
- * connect. */
+ int async) /* If nonzero, should connect client socket
+ * asynchronously. */
{
- TcpState *statePtr;
- const char *errorMsg = NULL;
- struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
- char channelName[SOCK_CHAN_LENGTH];
+ SocketInfo *infoPtr;
+ char channelName[16 + TCL_INTEGER_SPACE];
if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
}
/*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
+ * Create a new client socket and wrap it in a channel.
*/
- if (!SocketsEnabled()) {
+ infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
+ if (infoPtr == NULL) {
return NULL;
}
- /*
- * Do the name lookups for the local and remote addresses.
- */
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket);
- if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
- || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
- &errorMsg)) {
- if (addrlist != NULL) {
- freeaddrinfo(addrlist);
- }
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open socket: %s", errorMsg));
- }
- return NULL;
- }
-
- statePtr = NewSocketInfo(INVALID_SOCKET);
- statePtr->addrlist = addrlist;
- statePtr->myaddrlist = myaddrlist;
- if (async) {
- statePtr->flags |= TCP_ASYNC_CONNECT;
- }
-
- /*
- * Create a new client socket and wrap it in a channel.
- */
- if (TcpConnect(interp, statePtr) != TCL_OK) {
- TcpCloseProc(statePtr, NULL);
- return NULL;
+ infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+ (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
+ if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
+ "auto crlf") == TCL_ERROR) {
+ Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+ return (Tcl_Channel) NULL;
}
-
- sprintf(channelName, SOCK_TEMPLATE, statePtr);
-
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- statePtr, (TCL_READABLE | TCL_WRITABLE));
- if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
- "-translation", "auto crlf")) {
- Tcl_Close(NULL, statePtr->channel);
- return NULL;
- } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
- "-eofchar", "")) {
- Tcl_Close(NULL, statePtr->channel);
- return NULL;
+ if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "")
+ == TCL_ERROR) {
+ Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+ return (Tcl_Channel) NULL;
}
- return statePtr->channel;
+ return infoPtr->channel;
}
/*
@@ -1987,6 +1348,8 @@ Tcl_OpenTcpClient(
* Side effects:
* None.
*
+ * NOTE: Code contributed by Mark Diekhans (markd@grizzly.com)
+ *
*----------------------------------------------------------------------
*/
@@ -1994,15 +1357,15 @@ Tcl_Channel
Tcl_MakeTcpClientChannel(
ClientData sock) /* The socket to wrap up into a channel. */
{
- TcpState *statePtr;
- char channelName[SOCK_CHAN_LENGTH];
+ SocketInfo *infoPtr;
+ char channelName[16 + TCL_INTEGER_SPACE];
ThreadSpecificData *tsdPtr;
if (TclpHasSockets(NULL) != TCL_OK) {
return NULL;
}
- tsdPtr = TclThreadDataKeyGet(&dataKey);
+ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
/*
* Set kernel space buffering and non-blocking.
@@ -2010,20 +1373,21 @@ Tcl_MakeTcpClientChannel(
TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
- statePtr = NewSocketInfo((SOCKET) sock);
+ infoPtr = NewSocketInfo((SOCKET) sock);
/*
* Start watching for read/write events on the socket.
*/
- statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
+ infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
- sprintf(channelName, SOCK_TEMPLATE, statePtr);
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- statePtr, (TCL_READABLE | TCL_WRITABLE));
- Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
- return statePtr->channel;
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket);
+ infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+ (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
+ return infoPtr->channel;
}
/*
@@ -2034,8 +1398,8 @@ Tcl_MakeTcpClientChannel(
* Opens a TCP server socket and creates a channel around it.
*
* Results:
- * The channel or NULL if failed. If an error occurred, an error message
- * is left in the interp's result if interp is not NULL.
+ * The channel or NULL if failed. An error message is returned in the
+ * interpreter on failure.
*
* Side effects:
* Opens a server socket and creates a new channel.
@@ -2047,205 +1411,115 @@ Tcl_Channel
Tcl_OpenTcpServer(
Tcl_Interp *interp, /* For error reporting - may be NULL. */
int port, /* Port number to open. */
- const char *myHost, /* Name of local host. */
+ const char *host, /* Name of local host. */
Tcl_TcpAcceptProc *acceptProc,
/* Callback for accepting connections from new
* clients. */
ClientData acceptProcData) /* Data for the callback. */
{
- SOCKET sock = INVALID_SOCKET;
- unsigned short chosenport = 0;
- struct addrinfo *addrlist = NULL;
- struct addrinfo *addrPtr; /* Socket address to listen on. */
- TcpState *statePtr = NULL; /* The returned value. */
- char channelName[SOCK_CHAN_LENGTH];
- u_long flag = 1; /* Indicates nonblocking mode. */
- const char *errorMsg = NULL;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+ SocketInfo *infoPtr;
+ char channelName[16 + TCL_INTEGER_SPACE];
if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
}
/*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
+ * Create a new client socket and wrap it in a channel.
*/
- if (!SocketsEnabled()) {
+ infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
+ if (infoPtr == NULL) {
return NULL;
}
- /*
- * Construct the addresses for each end of the socket.
- */
-
- if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
- goto error;
- }
-
- for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
- sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
- addrPtr->ai_protocol);
- if (sock == INVALID_SOCKET) {
- TclWinConvertError((DWORD) WSAGetLastError());
- continue;
- }
-
- /*
- * Win-NT has a misfeature that sockets are inherited in child
- * processes by default. Turn off the inherit bit.
- */
-
- SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
-
- /*
- * Set kernel space buffering
- */
-
- TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
-
- /*
- * Make sure we use the same port when opening two server sockets
- * for IPv4 and IPv6.
- *
- * As sockaddr_in6 uses the same offset and size for the port
- * member as sockaddr_in, we can handle both through the IPv4 API.
- */
-
- if (port == 0 && chosenport != 0) {
- ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
- htons(chosenport);
- }
-
- /*
- * 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.
- *
- * 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) {
- TclWinConvertError((DWORD) WSAGetLastError());
- closesocket(sock);
- continue;
- }
- if (port == 0 && chosenport == 0) {
- address sockname;
- socklen_t namelen = sizeof(sockname);
-
- /*
- * Synchronize port numbers when binding to port 0 of multiple
- * addresses.
- */
-
- if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
- chosenport = ntohs(sockname.sa4.sin_port);
- }
- }
-
- /*
- * Set the maximum number of pending connect requests to the max
- * value allowed on each platform (Win32 and Win32s may be
- * different, and there may be differences between TCP/IP stacks).
- */
-
- if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
- TclWinConvertError((DWORD) WSAGetLastError());
- closesocket(sock);
- continue;
- }
-
- if (statePtr == NULL) {
- /*
- * Add this socket to the global list of sockets.
- */
- statePtr = NewSocketInfo(sock);
- } else {
- AddSocketInfoFd( statePtr, sock );
- }
- }
-
-error:
- if (addrlist != NULL) {
- freeaddrinfo(addrlist);
- }
-
- if (statePtr != NULL) {
-
- statePtr->acceptProc = acceptProc;
- statePtr->acceptProcData = acceptProcData;
- sprintf(channelName, SOCK_TEMPLATE, statePtr);
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- statePtr, 0);
- /*
- * Set up the select mask for connection request events.
- */
+ infoPtr->acceptProc = acceptProc;
+ infoPtr->acceptProcData = acceptProcData;
- statePtr->selectEvents = FD_ACCEPT;
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket);
- /*
- * Register for interest in events in the select mask. Note that this
- * automatically places the socket into non-blocking mode.
- */
-
- ioctlsocket(sock, (long) FIONBIO, &flag);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
- if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "")
+ infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+ (ClientData) infoPtr, 0);
+ if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close(NULL, statePtr->channel);
- return NULL;
- }
- return statePtr->channel;
- }
-
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open socket: %s",
- (errorMsg ? errorMsg : Tcl_PosixError(interp))));
+ Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+ return (Tcl_Channel) NULL;
}
- if (sock != INVALID_SOCKET) {
- closesocket(sock);
- }
- return NULL;
+ return infoPtr->channel;
}
/*
*----------------------------------------------------------------------
*
* TcpAccept --
- * Accept a TCP socket connection. This is called by the event loop.
+ *
+ * Accept a TCP socket connection. This is called by SocketEventProc and
+ * it in turns calls the registered accept function.
*
* Results:
* None.
*
* Side effects:
- * Creates a new connection socket. Calls the registered callback for the
- * connection acceptance mechanism.
+ * Invokes the accept proc which may invoke arbitrary Tcl code.
*
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
static void
TcpAccept(
- TcpFdList *fds, /* Server socket that accepted newSocket. */
- SOCKET newSocket, /* Newly accepted socket. */
- address addr) /* Address of new socket. */
+ SocketInfo *infoPtr) /* Socket to accept. */
{
- TcpState *newInfoPtr;
- TcpState *statePtr = fds->statePtr;
- int len = sizeof(addr);
- char channelName[SOCK_CHAN_LENGTH];
- char host[NI_MAXHOST], port[NI_MAXSERV];
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+ SOCKET newSocket;
+ SocketInfo *newInfoPtr;
+ SOCKADDR_IN addr;
+ int len;
+ char channelName[16 + TCL_INTEGER_SPACE];
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
+
+ /*
+ * Accept the incoming connection request.
+ */
+
+ len = sizeof(SOCKADDR_IN);
+
+ newSocket = accept(infoPtr->socket, (SOCKADDR *)&addr,
+ &len);
+
+ /*
+ * Protect access to sockets (acceptEventCount, readyEvents) in socketList
+ * by the lock. Fix for SF Tcl Bug 3056775.
+ */
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
+ /*
+ * 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.
+ */
+
+ if (newSocket == INVALID_SOCKET) {
+ infoPtr->acceptEventCount = 0;
+ infoPtr->readyEvents &= ~(FD_ACCEPT);
+
+ SetEvent(tsdPtr->socketListLock);
+ return;
+ }
+
+ /*
+ * 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.
+ */
+
+ infoPtr->acceptEventCount--;
+
+ if (infoPtr->acceptEventCount <= 0) {
+ infoPtr->readyEvents &= ~(FD_ACCEPT);
+ }
+
+ SetEvent(tsdPtr->socketListLock);
/*
* Win-NT has a misfeature that sockets are inherited in child processes
@@ -2255,7 +1529,7 @@ TcpAccept(
SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0);
/*
- * Add this socket to the global list of sockets.
+ * Allocate socket info structure
*/
newInfoPtr = NewSocketInfo(newSocket);
@@ -2265,20 +1539,20 @@ TcpAccept(
*/
newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) newInfoPtr);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) newInfoPtr);
- sprintf(channelName, SOCK_TEMPLATE, newInfoPtr);
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)newInfoPtr->socket);
newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
+ (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_Close(NULL, newInfoPtr->channel);
+ Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
return;
}
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close(NULL, newInfoPtr->channel);
+ Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
return;
}
@@ -2286,683 +1560,647 @@ TcpAccept(
* Invoke the accept callback function.
*/
- if (statePtr->acceptProc != NULL) {
- getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port),
- NI_NUMERICHOST|NI_NUMERICSERV);
- statePtr->acceptProc(statePtr->acceptProcData, newInfoPtr->channel,
- host, atoi(port));
+ if (infoPtr->acceptProc != NULL) {
+ (infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel,
+ inet_ntoa(addr.sin_addr), ntohs(addr.sin_port));
}
}
/*
*----------------------------------------------------------------------
*
- * InitSockets --
- *
- * Registers the event window for the socket notifier code.
+ * TcpInputProc --
*
- * Assumes socketMutex is held.
+ * This function is called by the generic IO level to read data from a
+ * socket based channel.
*
* Results:
- * None.
+ * The number of bytes read or -1 on error.
*
* Side effects:
- * Register a new window class and creates a
- * window for use in asynchronous socket notification.
+ * Consumes input from the socket.
*
*----------------------------------------------------------------------
*/
-static void
-InitSockets(void)
+static int
+TcpInputProc(
+ ClientData instanceData, /* The socket state. */
+ char *buf, /* Where to store data. */
+ int toRead, /* Maximum number of bytes to read. */
+ int *errorCodePtr) /* Where to store error codes. */
{
- DWORD id;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- if (!initialized) {
- initialized = 1;
- TclCreateLateExitHandler(SocketExitHandler, NULL);
+ SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ int bytesRead;
+ DWORD error;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
- /*
- * Create the async notification window with a new class. We must
- * create a new class to avoid a Windows 95 bug that causes us to get
- * the wrong message number for socket events if the message window is
- * a subclass of a static control.
- */
+ *errorCodePtr = 0;
- windowClass.style = 0;
- windowClass.cbClsExtra = 0;
- windowClass.cbWndExtra = 0;
- windowClass.hInstance = TclWinGetTclInstance();
- windowClass.hbrBackground = NULL;
- windowClass.lpszMenuName = NULL;
- windowClass.lpszClassName = classname;
- windowClass.lpfnWndProc = SocketProc;
- windowClass.hIcon = NULL;
- windowClass.hCursor = NULL;
+ /*
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
+ */
- if (!RegisterClass(&windowClass)) {
- TclWinConvertError(GetLastError());
- goto initFailure;
- }
+ if (!SocketsEnabled()) {
+ *errorCodePtr = EFAULT;
+ return -1;
}
/*
- * Check for per-thread initialization.
+ * First check to see if EOF was already detected, to prevent calling the
+ * socket stack after the first time EOF is detected.
*/
- if (tsdPtr != NULL) {
- return;
+ if (infoPtr->flags & SOCKET_EOF) {
+ return 0;
}
/*
- * OK, this thread has never done anything with sockets before. Construct
- * a worker thread to handle asynchronous events related to sockets
- * assigned to _this_ thread.
+ * Check to see if the socket is connected before trying to read.
*/
- tsdPtr = TCL_TSD_INIT(&dataKey);
- tsdPtr->pendingTcpState = NULL;
- tsdPtr->socketList = NULL;
- tsdPtr->hwnd = NULL;
- tsdPtr->threadId = Tcl_GetCurrentThread();
- tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
- if (tsdPtr->readyEvent == NULL) {
- goto initFailure;
- }
- tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
- if (tsdPtr->socketListLock == NULL) {
- goto initFailure;
- }
- tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0,
- &id);
- if (tsdPtr->socketThread == NULL) {
- goto initFailure;
+ if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
+ && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
+ return -1;
}
- SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
-
/*
- * Wait for the thread to signal when the window has been created and if
- * it is ready to go.
+ * No EOF, and it is connected, so try to read more from the socket. Note
+ * that we clear the FD_READ bit because read events are level triggered
+ * so a new event will be generated if there is still data available to be
+ * read. We have to simulate blocking behavior here since we are always
+ * using non-blocking sockets.
*/
- WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+ while (1) {
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) UNSELECT, (LPARAM) infoPtr);
+ bytesRead = recv(infoPtr->socket, buf, toRead, 0);
+ infoPtr->readyEvents &= ~(FD_READ);
- if (tsdPtr->hwnd == NULL) {
- goto initFailure; /* Trouble creating the window. */
+ /*
+ * Check for end-of-file condition or successful read.
+ */
+
+ if (bytesRead == 0) {
+ infoPtr->flags |= SOCKET_EOF;
+ }
+ if (bytesRead != SOCKET_ERROR) {
+ break;
+ }
+
+ /*
+ * If an error occurs after the FD_CLOSE has arrived, then ignore the
+ * error and report an EOF.
+ */
+
+ if (infoPtr->readyEvents & FD_CLOSE) {
+ infoPtr->flags |= SOCKET_EOF;
+ bytesRead = 0;
+ break;
+ }
+
+ error = WSAGetLastError();
+
+ /*
+ * If an RST comes, then ignore the error and report an EOF just like
+ * on unix.
+ */
+
+ if (error == WSAECONNRESET) {
+ infoPtr->flags |= SOCKET_EOF;
+ bytesRead = 0;
+ break;
+ }
+
+ /*
+ * Check for error condition or underflow in non-blocking case.
+ */
+
+ if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
+ TclWinConvertWSAError(error);
+ *errorCodePtr = Tcl_GetErrno();
+ bytesRead = -1;
+ break;
+ }
+
+ /*
+ * In the blocking case, wait until the file becomes readable or
+ * closed and try again.
+ */
+
+ if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
+ bytesRead = -1;
+ break;
+ }
}
- Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
- return;
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
- initFailure:
- TclpFinalizeSockets();
- initialized = -1;
- return;
+ return bytesRead;
}
/*
*----------------------------------------------------------------------
*
- * SocketsEnabled --
- *
- * Check that the WinSock was successfully initialized.
+ * TcpOutputProc --
*
- * Warning:
- * This check was useful in times of Windows98 where WinSock may
- * not be available. This is not the case any more.
- * This function may be removed with TCL 9.0
+ * This function is called by the generic IO level to write data to a
+ * socket based channel.
*
* Results:
- * 1 if it is.
+ * The number of bytes written or -1 on failure.
*
* Side effects:
- * None.
+ * Produces output on the socket.
*
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
static int
-SocketsEnabled(void)
+TcpOutputProc(
+ ClientData instanceData, /* The socket state. */
+ const char *buf, /* Where to get data. */
+ int toWrite, /* Maximum number of bytes to write. */
+ int *errorCodePtr) /* Where to store error codes. */
{
- int enabled;
+ SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ int bytesWritten;
+ DWORD error;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
- Tcl_MutexLock(&socketMutex);
- enabled = (initialized == 1);
- Tcl_MutexUnlock(&socketMutex);
- return enabled;
-}
+ *errorCodePtr = 0;
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketExitHandler --
- *
- * Callback invoked during exit clean up to delete the socket
- * communication window.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
+ /*
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
+ */
- /* ARGSUSED */
-static void
-SocketExitHandler(
- ClientData clientData) /* Not used. */
-{
- Tcl_MutexLock(&socketMutex);
+ if (!SocketsEnabled()) {
+ *errorCodePtr = EFAULT;
+ return -1;
+ }
/*
- * Make sure the socket event handling window is cleaned-up for, at
- * most, this thread.
+ * Check to see if the socket is connected before trying to write.
*/
- TclpFinalizeSockets();
- UnregisterClass(classname, TclWinGetTclInstance());
- initialized = 0;
- Tcl_MutexUnlock(&socketMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketSetupProc --
- *
- * This function is invoked before Tcl_DoOneEvent blocks waiting for an
- * event.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Adjusts the block time if needed.
- *
- *----------------------------------------------------------------------
- */
+ if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
+ && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
+ return -1;
+ }
-void
-SocketSetupProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- TcpState *statePtr;
- Tcl_Time blockTime = { 0, 0 };
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ while (1) {
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) UNSELECT, (LPARAM) infoPtr);
- if (!(flags & TCL_FILE_EVENTS)) {
- return;
- }
+ bytesWritten = send(infoPtr->socket, buf, toWrite, 0);
+ if (bytesWritten != SOCKET_ERROR) {
+ /*
+ * Since Windows won't generate a new write event until we hit an
+ * overflow condition, we need to force the event loop to poll
+ * until the condition changes.
+ */
- /*
- * Check to see if there is a ready socket. If so, poll.
- */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- for (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- if (statePtr->readyEvents &
- (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
- ) {
- Tcl_SetMaxBlockTime(&blockTime);
+ if (infoPtr->watchEvents & FD_WRITE) {
+ Tcl_Time blockTime = { 0, 0 };
+ Tcl_SetMaxBlockTime(&blockTime);
+ }
+ break;
+ }
+
+ /*
+ * Check for error condition or overflow. In the event of overflow, we
+ * need to clear the FD_WRITE flag so we can detect the next writable
+ * event. Note that Windows only sends a new writable event after a
+ * send fails with WSAEWOULDBLOCK.
+ */
+
+ error = WSAGetLastError();
+ if (error == WSAEWOULDBLOCK) {
+ infoPtr->readyEvents &= ~(FD_WRITE);
+ if (infoPtr->flags & SOCKET_ASYNC) {
+ *errorCodePtr = EWOULDBLOCK;
+ bytesWritten = -1;
+ break;
+ }
+ } else {
+ TclWinConvertWSAError(error);
+ *errorCodePtr = Tcl_GetErrno();
+ bytesWritten = -1;
+ break;
+ }
+
+ /*
+ * In the blocking case, wait until the file becomes writable or
+ * closed and try again.
+ */
+
+ if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
+ bytesWritten = -1;
break;
}
}
- SetEvent(tsdPtr->socketListLock);
+
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
+
+ return bytesWritten;
}
/*
*----------------------------------------------------------------------
*
- * SocketCheckProc --
+ * TcpSetOptionProc --
*
- * This function is called by Tcl_DoOneEvent to check the socket event
- * source for events.
+ * Sets Tcp channel specific options.
*
* Results:
- * None.
+ * None, unless an error happens.
*
* Side effects:
- * May queue an event.
+ * Changes attributes of the socket at the system level.
*
*----------------------------------------------------------------------
*/
-static void
-SocketCheckProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+static int
+TcpSetOptionProc(
+ ClientData instanceData, /* Socket state. */
+ Tcl_Interp *interp, /* For error reporting - can be NULL. */
+ const char *optionName, /* Name of the option to set. */
+ const char *value) /* New value for option. */
{
- TcpState *statePtr;
- SocketEvent *evPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return;
- }
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+ SocketInfo *infoPtr;
+ SOCKET sock;
+#endif
/*
- * Queue events for any ready sockets that don't already have events
- * queued (caused by persistent states that won't generate WinSock
- * events).
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
- 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;
- evPtr = ckalloc(sizeof(SocketEvent));
- evPtr->header.proc = SocketEventProc;
- evPtr->socket = statePtr->sockets->fd;
- Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+ if (!SocketsEnabled()) {
+ if (interp) {
+ Tcl_AppendResult(interp, "winsock is not initialized", NULL);
}
+ return TCL_ERROR;
}
- SetEvent(tsdPtr->socketListLock);
+
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+ infoPtr = (SocketInfo *) instanceData;
+ sock = infoPtr->socket;
+
+ if (!strcasecmp(optionName, "-keepalive")) {
+ BOOL val = FALSE;
+ int boolVar, rtn;
+
+ if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (boolVar) {
+ val = TRUE;
+ }
+ rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
+ (const char *) &val, sizeof(BOOL));
+ if (rtn != 0) {
+ TclWinConvertWSAError(WSAGetLastError());
+ if (interp) {
+ Tcl_AppendResult(interp, "couldn't set socket option: ",
+ Tcl_PosixError(interp), NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ } else if (!strcasecmp(optionName, "-nagle")) {
+ BOOL val = FALSE;
+ int boolVar, rtn;
+
+ if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!boolVar) {
+ val = TRUE;
+ }
+ rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
+ (const char *) &val, sizeof(BOOL));
+ if (rtn != 0) {
+ TclWinConvertWSAError(WSAGetLastError());
+ if (interp) {
+ Tcl_AppendResult(interp, "couldn't set socket option: ",
+ Tcl_PosixError(interp), NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
+#else
+ return Tcl_BadChannelOption(interp, optionName, "");
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
}
/*
*----------------------------------------------------------------------
*
- * SocketEventProc --
+ * TcpGetOptionProc --
*
- * This function is called by Tcl_ServiceEvent when a socket event
- * reaches the front of the event queue. This function is responsible for
- * notifying the generic channel code.
+ * Computes an option value for a TCP socket based channel, or a list of
+ * all options and their values.
+ *
+ * Note: This code is based on code contributed by John Haxby.
*
* Results:
- * Returns 1 if the event was handled, meaning it should be removed from
- * the queue. Returns 0 if the event was not handled, meaning it should
- * stay on the queue. The only time the event isn't handled is if the
- * TCL_FILE_EVENTS flag bit isn't set.
+ * A standard Tcl result. The value of the specified option or a list of
+ * all options and their values is returned in the supplied DString.
*
* Side effects:
- * Whatever the channel callback functions do.
+ * None.
*
*----------------------------------------------------------------------
*/
static int
-SocketEventProc(
- Tcl_Event *evPtr, /* Event to service. */
- int flags) /* Flags that indicate what events to handle,
- * such as TCL_FILE_EVENTS. */
+TcpGetOptionProc(
+ ClientData instanceData, /* Socket state. */
+ Tcl_Interp *interp, /* For error reporting - can be NULL */
+ const char *optionName, /* Name of the option to retrieve the value
+ * for, or NULL to get all options and their
+ * values. */
+ Tcl_DString *dsPtr) /* Where to store the computed value;
+ * initialized by caller. */
{
- TcpState *statePtr;
- SocketEvent *eventPtr = (SocketEvent *) evPtr;
- int mask = 0, events;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- TcpFdList *fds;
- SOCKET newSocket;
- address addr;
- int len;
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return 0;
- }
+ SocketInfo *infoPtr;
+ SOCKADDR_IN sockname;
+ SOCKADDR_IN peername;
+ struct hostent *hostEntPtr;
+ SOCKET sock;
+ int size = sizeof(SOCKADDR_IN);
+ size_t len = 0;
+ char buf[TCL_INTEGER_SPACE];
/*
- * Find the specified socket on the socket list.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- for (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- if (statePtr->sockets->fd == eventPtr->socket) {
- break;
+ if (!SocketsEnabled()) {
+ if (interp) {
+ Tcl_AppendResult(interp, "winsock is not initialized", NULL);
}
+ return TCL_ERROR;
}
- /*
- * Discard events that have gone stale.
- */
-
- if (!statePtr) {
- SetEvent(tsdPtr->socketListLock);
- return 1;
+ infoPtr = (SocketInfo *) instanceData;
+ sock = (int) infoPtr->socket;
+ if (optionName != NULL) {
+ len = strlen(optionName);
}
- /*
- * Clear flag that (this) event is pending
- */
-
- statePtr->flags &= ~SOCKET_PENDING;
-
- /*
- * Continue async connect if pending and ready
- */
-
- if ( statePtr->readyEvents & FD_CONNECT ) {
- if ( statePtr->flags & TCP_ASYNC_PENDING ) {
+ if ((len > 1) && (optionName[1] == 'e') &&
+ (strncmp(optionName, "-error", len) == 0)) {
+ int optlen;
+ DWORD err;
+ int ret;
- /*
- * Do one step and save eventual connect error
- */
+ optlen = sizeof(int);
+ ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR,
+ (char *)&err, &optlen);
+ if (ret == SOCKET_ERROR) {
+ err = WSAGetLastError();
+ }
+ if (err) {
+ TclWinConvertWSAError(err);
+ Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
+ }
+ return TCL_OK;
+ }
- SetEvent(tsdPtr->socketListLock);
- WaitForConnect(statePtr,NULL);
+ if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
+ (strncmp(optionName, "-peername", len) == 0))) {
+ if (getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) {
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-peername");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
+ if (peername.sin_addr.s_addr == 0) {
+ hostEntPtr = NULL;
+ } else {
+ hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
+ sizeof(peername.sin_addr), AF_INET);
+ }
+ if (hostEntPtr != NULL) {
+ Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+ } else {
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
+ }
+ TclFormatInt(buf, ntohs(peername.sin_port));
+ Tcl_DStringAppendElement(dsPtr, buf);
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ } else {
+ return TCL_OK;
+ }
} else {
-
/*
- * No async connect reenter pending. Just clear event.
+ * getpeername failed - but if we were asked for all the options
+ * (len==0), don't flag an error at that point because it could be
+ * an fconfigure request on a server socket (such sockets have no
+ * peer). {Copied from unix/tclUnixChan.c}
*/
- statePtr->readyEvents &= ~(FD_CONNECT);
- SetEvent(tsdPtr->socketListLock);
+ if (len) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ if (interp) {
+ Tcl_AppendResult(interp, "can't get peername: ",
+ Tcl_PosixError(interp), NULL);
+ }
+ return TCL_ERROR;
+ }
}
- return 1;
}
- /*
- * Handle connection requests directly.
- */
- if (statePtr->readyEvents & FD_ACCEPT) {
- for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
-
- /*
- * 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.
- * Access to sockets (acceptEventCount, readyEvents) in socketList
- * is still protected by the lock (prevents reintroduction of
- * SF Tcl Bug 3056775.
- */
-
- if (newSocket == INVALID_SOCKET) {
- /* int err = WSAGetLastError(); */
- continue;
+ if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
+ (strncmp(optionName, "-sockname", len) == 0))) {
+ if (getsockname(sock, (LPSOCKADDR) &sockname, &size) == 0) {
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-sockname");
+ Tcl_DStringStartSublist(dsPtr);
}
-
- /*
- * 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);
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+ if (sockname.sin_addr.s_addr == 0) {
+ hostEntPtr = NULL;
+ } else {
+ hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
+ sizeof(peername.sin_addr), AF_INET);
}
-
- 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.
- */
- TcpAccept(fds, newSocket, addr);
- return 1;
+ if (hostEntPtr != NULL) {
+ Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+ } else {
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+ }
+ TclFormatInt(buf, ntohs(sockname.sin_port));
+ Tcl_DStringAppendElement(dsPtr, buf);
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ } else {
+ return TCL_OK;
+ }
+ } else {
+ if (interp) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ Tcl_AppendResult(interp, "can't get sockname: ",
+ Tcl_PosixError(interp), NULL);
+ }
+ return TCL_ERROR;
}
-
- /* 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);
-
- SetEvent(tsdPtr->socketListLock);
- return 1;
}
- SetEvent(tsdPtr->socketListLock);
-
- /*
- * Mask off unwanted events and compute the read/write mask so we can
- * notify the channel.
- */
-
- events = statePtr->readyEvents & statePtr->watchEvents;
-
- if (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
- * event until someone does something with the channel. Note that we
- * do this before calling Tcl_NotifyChannel so we don't have to watch
- * out for the channel being deleted out from under us. This may cause
- * a redundant trip through the event loop, but it's simpler than
- * trying to do unwind protection.
- */
-
- Tcl_Time blockTime = { 0, 0 };
-
- Tcl_SetMaxBlockTime(&blockTime);
- mask |= TCL_READABLE|TCL_WRITABLE;
- } else if (events & FD_READ) {
-
- /*
- * Throw the readable event if an async connect failed.
- */
-
- if ( statePtr->flags & TCP_ASYNC_FAILED ) {
-
- mask |= TCL_READABLE;
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+ if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
+ int optlen;
+ BOOL opt = FALSE;
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-keepalive");
+ }
+ optlen = sizeof(BOOL);
+ getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
+ if (opt) {
+ Tcl_DStringAppendElement(dsPtr, "1");
} else {
- fd_set readFds;
- struct timeval timeout;
-
- /*
- * We must check to see if data is really available, since someone
- * could have consumed the data in the meantime. Turn off async
- * notification so select will work correctly. If the socket is
- * still readable, notify the channel driver, otherwise reset the
- * async select handler and keep waiting.
- */
-
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) UNSELECT, (LPARAM) statePtr);
-
- FD_ZERO(&readFds);
- FD_SET(statePtr->sockets->fd, &readFds);
- timeout.tv_usec = 0;
- timeout.tv_sec = 0;
-
- if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
- mask |= TCL_READABLE;
- } else {
- statePtr->readyEvents &= ~(FD_READ);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) statePtr);
- }
+ Tcl_DStringAppendElement(dsPtr, "0");
+ }
+ if (len > 0) {
+ return TCL_OK;
}
}
- /*
- * writable event
- */
+ if (len == 0 || !strncmp(optionName, "-nagle", len)) {
+ int optlen;
+ BOOL opt = FALSE;
- if (events & FD_WRITE) {
- mask |= TCL_WRITABLE;
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-nagle");
+ }
+ optlen = sizeof(BOOL);
+ getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt,
+ &optlen);
+ if (opt) {
+ Tcl_DStringAppendElement(dsPtr, "0");
+ } else {
+ Tcl_DStringAppendElement(dsPtr, "1");
+ }
+ if (len > 0) {
+ return TCL_OK;
+ }
}
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
- /*
- * Call registered event procedures
- */
-
- if (mask) {
- Tcl_NotifyChannel(statePtr->channel, mask);
+ if (len > 0) {
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+ return Tcl_BadChannelOption(interp, optionName,
+ "peername sockname keepalive nagle");
+#else
+ return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
}
- return 1;
+
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * AddSocketInfoFd --
+ * TcpWatchProc --
*
- * This function adds a SOCKET file descriptor to the 'sockets' linked
- * list of a TcpState structure.
+ * Informs the channel driver of the events that the generic channel code
+ * wishes to receive on this socket.
*
* Results:
* None.
*
* Side effects:
- * None, except for allocation of memory.
+ * May cause the notifier to poll if any of the specified conditions are
+ * already true.
*
*----------------------------------------------------------------------
*/
static void
-AddSocketInfoFd(
- TcpState *statePtr,
- SOCKET socket)
-{
- TcpFdList *fds = statePtr->sockets;
-
- 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 ) {
- fds = fds->next;
- }
-
- fds->next = ckalloc(sizeof(TcpFdList));
- fds = fds->next;
- }
-
- /* Populate new FD */
- fds->fd = socket;
- fds->statePtr = statePtr;
- fds->next = NULL;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * NewSocketInfo --
- *
- * This function allocates and initializes a new TcpState structure.
- *
- * Results:
- * Returns a newly allocated TcpState.
- *
- * Side effects:
- * None, except for allocation of memory.
- *
- *----------------------------------------------------------------------
- */
-
-static TcpState *
-NewSocketInfo(SOCKET socket)
+TcpWatchProc(
+ ClientData instanceData, /* The socket state. */
+ int mask) /* Events of interest; an OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION. */
{
- TcpState *statePtr = ckalloc(sizeof(TcpState));
-
- memset(statePtr, 0, sizeof(TcpState));
+ SocketInfo *infoPtr = (SocketInfo *) instanceData;
/*
- * TIP #218. Removed the code inserting the new structure into the global
- * list. This is now handled in the thread action callbacks, and only
- * there.
+ * Update the watch events mask. Only if the socket is not a server
+ * socket. Fix for SF Tcl Bug #557878.
*/
- AddSocketInfoFd(statePtr, socket);
+ if (!infoPtr->acceptProc) {
+ infoPtr->watchEvents = 0;
+ if (mask & TCL_READABLE) {
+ infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
+ }
+ if (mask & TCL_WRITABLE) {
+ infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT);
+ }
+
+ /*
+ * If there are any conditions already set, then tell the notifier to
+ * poll rather than block.
+ */
- return statePtr;
+ if (infoPtr->readyEvents & infoPtr->watchEvents) {
+ Tcl_Time blockTime = { 0, 0 };
+ Tcl_SetMaxBlockTime(&blockTime);
+ }
+ }
}
/*
*----------------------------------------------------------------------
*
- * WaitForSocketEvent --
+ * TcpGetProc --
*
- * Waits until one of the specified events occurs on a socket.
- * For event FD_CONNECT use WaitForConnect.
+ * Called from Tcl_GetChannelHandle to retrieve an OS handle from inside
+ * a TCP socket based channel.
*
* Results:
- * Returns 1 on success or 0 on failure, with an error code in
- * errorCodePtr.
+ * Returns TCL_OK with the socket in handlePtr.
*
* Side effects:
- * Processes socket events off the system queue.
+ * None.
*
*----------------------------------------------------------------------
*/
static int
-WaitForSocketEvent(
- TcpState *statePtr, /* Information about this socket. */
- int events, /* Events to look for. May be one of
- * FD_READ or FD_WRITE.
- */
- int *errorCodePtr) /* Where to store errors? */
+TcpGetHandleProc(
+ ClientData instanceData, /* The socket state. */
+ int direction, /* Not used. */
+ ClientData *handlePtr) /* Where to store the handle. */
{
- int result = 1;
- int oldMode;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
- /*
- * Be sure to disable event servicing so we are truly modal.
- */
-
- oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
-
- /*
- * 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);
-
- while (1) {
- int event_found;
-
- /* get statePtr lock */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ SocketInfo *statePtr = (SocketInfo *) instanceData;
- /* Check if event occured */
- event_found = (statePtr->readyEvents & events);
-
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
-
- /* exit loop if event occured */
- if (event_found) {
- break;
- }
-
- /* Exit loop if event did not occur but this is a non-blocking channel */
- if (statePtr->flags & TCP_NONBLOCKING) {
- *errorCodePtr = EWOULDBLOCK;
- result = 0;
- break;
- }
-
- /*
- * Wait until something happens.
- */
-
- WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
- }
-
- (void) Tcl_SetServiceMode(oldMode);
- return result;
+ *handlePtr = (ClientData) statePtr->socket;
+ return TCL_OK;
}
/*
@@ -2986,14 +2224,14 @@ SocketThread(
LPVOID arg)
{
MSG msg;
- ThreadSpecificData *tsdPtr = arg;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg);
/*
* Create a dummy window receiving socket events.
*/
- tsdPtr->hwnd = CreateWindow(classname, classname, WS_TILED, 0, 0, 0, 0,
- NULL, NULL, windowClass.hInstance, arg);
+ tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket",
+ WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg);
/*
* Signalize thread creator that we are done creating the window.
@@ -3056,9 +2294,8 @@ SocketProc(
{
int event, error;
SOCKET socket;
- TcpState *statePtr;
+ SocketInfo *infoPtr;
int info_found = 0;
- TcpFdList *fds = NULL;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
#ifdef _WIN64
GetWindowLongPtr(hwnd, GWLP_USERDATA);
@@ -3095,16 +2332,15 @@ SocketProc(
error = WSAGETSELECTERROR(lParam);
socket = (SOCKET) wParam;
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-
/*
* Find the specified socket on the socket list and update its
* eventState flag.
*/
- for (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- if ( FindFDInList(statePtr,socket) ) {
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->socket == socket) {
info_found = 1;
break;
}
@@ -3114,9 +2350,9 @@ SocketProc(
* list
*/
if ( !info_found
- && tsdPtr->pendingTcpState != NULL
- && FindFDInList(tsdPtr->pendingTcpState,socket) ) {
- statePtr = tsdPtr->pendingTcpState;
+ && tsdPtr->pendingSocketInfo != NULL
+ && tsdPtr->pendingSocketInfo->socket ==socket ) {
+ infoPtr = tsdPtr->pendingSocketInfo;
info_found = 1;
}
if (info_found) {
@@ -3130,29 +2366,44 @@ SocketProc(
*/
if (event & FD_CLOSE) {
- statePtr->acceptEventCount = 0;
- statePtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+ infoPtr->acceptEventCount = 0;
+ infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
} else if (event & FD_ACCEPT) {
- statePtr->acceptEventCount++;
+ infoPtr->acceptEventCount++;
}
if (event & FD_CONNECT) {
/*
+ * The socket is now connected, clear the async connect
+ * flag.
+ */
+
+ infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+
+ /*
* Remember any error that occurred so we can report
* connection failures.
*/
+
if (error != ERROR_SUCCESS) {
- statePtr->notifierConnectError = error;
+ /* Async Connect error */
+ TclWinConvertWSAError((DWORD) error);
+ infoPtr->lastError = Tcl_GetErrno();
+ /* Fire also readable event on connect failure */
+ infoPtr->readyEvents |= FD_READ;
}
+
+ /* fire writable event on connect */
+ infoPtr->readyEvents |= FD_WRITE;
+
}
- /*
- * Inform main thread about signaled events
- */
- statePtr->readyEvents |= event;
+
+ infoPtr->readyEvents |= event;
/*
* Wake up the Main Thread.
*/
+
SetEvent(tsdPtr->readyEvent);
Tcl_ThreadAlert(tsdPtr->threadId);
}
@@ -3160,18 +2411,20 @@ SocketProc(
break;
case SOCKET_SELECT:
- statePtr = (TcpState *) lParam;
- for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
- if (wParam == SELECT) {
- WSAAsyncSelect(fds->fd, hwnd,
- SOCKET_MESSAGE, statePtr->selectEvents);
- } else {
- /*
- * Clear the selection mask
- */
+ infoPtr = (SocketInfo *) lParam;
+ if (wParam == SELECT) {
+ /*
+ * Start notification by windows messages on socket events
+ */
- WSAAsyncSelect(fds->fd, hwnd, 0, 0);
- }
+ WSAAsyncSelect(infoPtr->socket, hwnd,
+ SOCKET_MESSAGE, infoPtr->selectEvents);
+ } else {
+ /*
+ * UNSELECT: Clear the selection mask
+ */
+
+ WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0);
}
break;
@@ -3186,31 +2439,83 @@ SocketProc(
/*
*----------------------------------------------------------------------
*
- * FindFDInList --
+ * Tcl_GetHostName --
*
- * Return true, if the given file descriptior is contained in the
- * file descriptor list.
+ * Returns the name of the local host.
*
* Results:
- * true if found.
+ * A string containing the network name for this machine. The caller must
+ * not modify or free this string.
*
* Side effects:
+ * Caches the name to return for future calls.
*
*----------------------------------------------------------------------
*/
-static int
-FindFDInList(
- TcpState *statePtr,
- SOCKET socket)
+const char *
+Tcl_GetHostName(void)
{
- TcpFdList *fds;
- for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
- if (fds->fd == socket) {
- return 1;
+ return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitializeHostName --
+ *
+ * This routine sets the process global value of the name of the local
+ * host on which the process is running.
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+InitializeHostName(
+ char **valuePtr,
+ int *lengthPtr,
+ Tcl_Encoding *encodingPtr)
+{
+ WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1];
+ DWORD length = sizeof(wbuf) / sizeof(WCHAR);
+ Tcl_DString ds;
+
+ if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) {
+ /*
+ * Convert string from native to UTF then change to lowercase.
+ */
+
+ Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds));
+
+ } else {
+ Tcl_DStringInit(&ds);
+ if (TclpHasSockets(NULL) == TCL_OK) {
+ /*
+ * The buffer size of 256 is recommended by the MSDN page that
+ * documents gethostname() as being always adequate.
+ */
+
+ Tcl_DString inDs;
+
+ Tcl_DStringInit(&inDs);
+ Tcl_DStringSetLength(&inDs, 256);
+ if (gethostname(Tcl_DStringValue(&inDs),
+ Tcl_DStringLength(&inDs)) == 0) {
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
+ &ds);
+ }
+ Tcl_DStringFree(&inDs);
}
}
- return 0;
+
+ *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
+ *lengthPtr = Tcl_DStringLength(&ds);
+ *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
+ memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
+ Tcl_DStringFree(&ds);
}
/*
@@ -3218,11 +2523,10 @@ 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.
+ * These functions are wrappers that let us bind the WinSock API
+ * dynamically so we can run on systems that don't have the wsock32.dll.
+ * We need wrappers for these interfaces because they are called from the
+ * generic Tcl code.
*
* Results:
* As defined for each function.
@@ -3235,35 +2539,26 @@ FindFDInList(
#undef TclWinGetSockOpt
int
-TclWinGetSockOpt(
- SOCKET s,
- int level,
- int optname,
- char *optval,
- int *optlen)
+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,
+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)
+TclpInetNtoa(struct in_addr addr)
{
return inet_ntoa(addr);
}
+
#undef TclWinGetServByName
struct servent *
TclWinGetServByName(
@@ -3295,7 +2590,7 @@ TcpThreadActionProc(
int action)
{
ThreadSpecificData *tsdPtr;
- TcpState *statePtr = instanceData;
+ SocketInfo *infoPtr = (SocketInfo *) instanceData;
int notifyCmd;
if (action == TCL_CHANNEL_THREAD_INSERT) {
@@ -3311,18 +2606,18 @@ TcpThreadActionProc(
tsdPtr = TCL_TSD_INIT(&dataKey);
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- statePtr->nextPtr = tsdPtr->socketList;
- tsdPtr->socketList = statePtr;
-
- if (statePtr == tsdPtr->pendingTcpState) {
- tsdPtr->pendingTcpState = NULL;
+ infoPtr->nextPtr = tsdPtr->socketList;
+ tsdPtr->socketList = infoPtr;
+
+ if (infoPtr == tsdPtr->pendingSocketInfo) {
+ tsdPtr->pendingSocketInfo = NULL;
}
-
+
SetEvent(tsdPtr->socketListLock);
notifyCmd = SELECT;
} else {
- TcpState **nextPtrPtr;
+ SocketInfo **nextPtrPtr;
int removed = 0;
tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -3335,8 +2630,8 @@ TcpThreadActionProc(
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
- if ((*nextPtrPtr) == statePtr) {
- (*nextPtrPtr) = statePtr->nextPtr;
+ if ((*nextPtrPtr) == infoPtr) {
+ (*nextPtrPtr) = infoPtr->nextPtr;
removed = 1;
break;
}
@@ -3362,7 +2657,7 @@ TcpThreadActionProc(
*/
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) notifyCmd, (LPARAM) statePtr);
+ (WPARAM) notifyCmd, (LPARAM) infoPtr);
}
/*
@@ -3370,7 +2665,5 @@ TcpThreadActionProc(
* mode: c
* c-basic-offset: 4
* fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
* End:
*/
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index b3ad626..e493fbf 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -9,15 +9,12 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
#include "tclInt.h"
/*
* For TestplatformChmod on Windows
*/
-#ifdef _WIN32
+#ifdef __WIN32__
#include <aclapi.h>
#endif
@@ -32,8 +29,9 @@
* Forward declarations of functions defined later in this file:
*/
-static int TesteventloopCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
+int TclplatformtestInit(Tcl_Interp *interp);
+static int TesteventloopCmd(ClientData dummy, Tcl_Interp *interp,
+ int argc, const char **argv);
static int TestvolumetypeCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -43,8 +41,8 @@ static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp,
int objc, Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc TestExceptionCmd;
static int TestplatformChmod(const char *nativePath, int pmode);
-static int TestchmodCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
+static int TestchmodCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
/*
*----------------------------------------------------------------------
@@ -71,8 +69,8 @@ TclplatformtestInit(
* Add commands for platform specific tests for Windows here.
*/
- Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL);
+ Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, NULL, NULL);
+ Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL);
@@ -103,20 +101,21 @@ static int
TesteventloopCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
static int *framePtr = NULL;/* Pointer to integer on stack frame of
* innermost invocation of the "wait"
* subcommand. */
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ...");
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " option ... \"", NULL);
return TCL_ERROR;
}
- if (strcmp(Tcl_GetString(objv[1]), "done") == 0) {
+ if (strcmp(argv[1], "done") == 0) {
*framePtr = 1;
- } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) {
+ } else if (strcmp(argv[1], "wait") == 0) {
int *oldFramePtr, done;
int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
@@ -151,7 +150,7 @@ TesteventloopCmd(
(void) Tcl_SetServiceMode(oldMode);
framePtr = oldFramePtr;
} else {
- Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be done or wait", NULL);
return TCL_ERROR;
}
@@ -185,7 +184,7 @@ TestvolumetypeCmd(
#define VOL_BUF_SIZE 32
int found;
char volType[VOL_BUF_SIZE];
- const char *path;
+ char *path;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?name?");
@@ -210,7 +209,7 @@ TestvolumetypeCmd(
TclWinConvertError(GetLastError());
return TCL_ERROR;
}
- Tcl_AppendResult(interp, volType, NULL);
+ Tcl_SetResult(interp, volType, TCL_VOLATILE);
return TCL_OK;
#undef VOL_BUF_SIZE
}
@@ -340,7 +339,7 @@ TestExceptionCmd(
int objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
{
- static const char *const cmds[] = {
+ static const char *cmds[] = {
"access_violation", "datatype_misalignment", "array_bounds",
"float_denormal", "float_divbyzero", "float_inexact",
"float_invalidop", "float_overflow", "float_stack", "float_underflow",
@@ -397,6 +396,28 @@ TestplatformChmod(
const char *nativePath,
int pmode)
{
+ typedef DWORD (WINAPI *getSidLengthRequiredDef)(UCHAR);
+ typedef BOOL (WINAPI *initializeSidDef)(PSID, PSID_IDENTIFIER_AUTHORITY,
+ BYTE);
+ typedef PDWORD (WINAPI *getSidSubAuthorityDef)(PSID, DWORD);
+ typedef DWORD (WINAPI *setNamedSecurityInfoADef)(IN LPSTR,
+ IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID,
+ IN PACL, IN PACL);
+ typedef BOOL (WINAPI *getAceDef)(PACL, DWORD, LPVOID *);
+ typedef BOOL (WINAPI *addAceDef)(PACL, DWORD, DWORD, LPVOID, DWORD);
+ typedef BOOL (WINAPI *equalSidDef)(PSID, PSID);
+ typedef BOOL (WINAPI *addAccessDeniedAceDef)(PACL, DWORD, DWORD, PSID);
+ typedef BOOL (WINAPI *initializeAclDef)(PACL, DWORD, DWORD);
+ typedef DWORD (WINAPI *getLengthSidDef)(PSID);
+ typedef BOOL (WINAPI *getAclInformationDef)(PACL, LPVOID, DWORD,
+ ACL_INFORMATION_CLASS);
+ typedef BOOL (WINAPI *getSecurityDescriptorDaclDef)(PSECURITY_DESCRIPTOR,
+ LPBOOL, PACL *, LPBOOL);
+ typedef BOOL (WINAPI *lookupAccountNameADef)(LPCSTR, LPCSTR, PSID,
+ PDWORD, LPSTR, LPDWORD, PSID_NAME_USE);
+ typedef BOOL (WINAPI *getFileSecurityADef)(LPCSTR, SECURITY_INFORMATION,
+ PSECURITY_DESCRIPTOR, DWORD, LPDWORD);
+
static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
| GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
@@ -407,6 +428,22 @@ TestplatformChmod(
* References to security functions (only available on NT and later).
*/
+ static getSidLengthRequiredDef getSidLengthRequiredProc;
+ static initializeSidDef initializeSidProc;
+ static getSidSubAuthorityDef getSidSubAuthorityProc;
+ static setNamedSecurityInfoADef setNamedSecurityInfoProc;
+ static getAceDef getAceProc;
+ static addAceDef addAceProc;
+ static equalSidDef equalSidProc;
+ static addAccessDeniedAceDef addAccessDeniedAceProc;
+ static initializeAclDef initializeAclProc;
+ static getLengthSidDef getLengthSidProc;
+ static getAclInformationDef getAclInformationProc;
+ static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc;
+ static lookupAccountNameADef lookupAccountNameProc;
+ static getFileSecurityADef getFileSecurityProc;
+ static int initialized = 0;
+
const BOOL set_readOnly = !(pmode & 0222);
BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted;
SID_IDENTIFIER_AUTHORITY userSidAuthority = {
@@ -418,14 +455,72 @@ TestplatformChmod(
PACL curAcl, newAcl = 0;
WORD j;
SID *userSid = 0;
- char *userDomain = 0;
+ TCHAR *userDomain = 0;
int res = 0;
/*
+ * One time initialization, dynamically load Windows NT features
+ */
+
+ if (!initialized) {
+ TCL_DECLARE_MUTEX(initializeMutex)
+ Tcl_MutexLock(&initializeMutex);
+ if (!initialized) {
+ HINSTANCE hInstance = LoadLibrary("Advapi32");
+
+ if (hInstance != NULL) {
+ setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
+ GetProcAddress(hInstance, "SetNamedSecurityInfoA");
+ getFileSecurityProc = (getFileSecurityADef)
+ GetProcAddress(hInstance, "GetFileSecurityA");
+ getAceProc = (getAceDef)
+ GetProcAddress(hInstance, "GetAce");
+ addAceProc = (addAceDef)
+ GetProcAddress(hInstance, "AddAce");
+ equalSidProc = (equalSidDef)
+ GetProcAddress(hInstance, "EqualSid");
+ addAccessDeniedAceProc = (addAccessDeniedAceDef)
+ GetProcAddress(hInstance, "AddAccessDeniedAce");
+ initializeAclProc = (initializeAclDef)
+ GetProcAddress(hInstance, "InitializeAcl");
+ getLengthSidProc = (getLengthSidDef)
+ GetProcAddress(hInstance, "GetLengthSid");
+ getAclInformationProc = (getAclInformationDef)
+ GetProcAddress(hInstance, "GetAclInformation");
+ getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef)
+ GetProcAddress(hInstance, "GetSecurityDescriptorDacl");
+ lookupAccountNameProc = (lookupAccountNameADef)
+ GetProcAddress(hInstance, "LookupAccountNameA");
+ getSidLengthRequiredProc = (getSidLengthRequiredDef)
+ GetProcAddress(hInstance, "GetSidLengthRequired");
+ initializeSidProc = (initializeSidDef)
+ GetProcAddress(hInstance, "InitializeSid");
+ getSidSubAuthorityProc = (getSidSubAuthorityDef)
+ GetProcAddress(hInstance, "GetSidSubAuthority");
+
+ if (setNamedSecurityInfoProc && getAceProc && addAceProc
+ && equalSidProc && addAccessDeniedAceProc
+ && initializeAclProc && getLengthSidProc
+ && getAclInformationProc
+ && getSecurityDescriptorDaclProc
+ && lookupAccountNameProc && getFileSecurityProc
+ && getSidLengthRequiredProc && initializeSidProc
+ && getSidSubAuthorityProc) {
+ initialized = 1;
+ }
+ }
+ if (!initialized) {
+ initialized = -1;
+ }
+ }
+ Tcl_MutexUnlock(&initializeMutex);
+ }
+
+ /*
* Process the chmod request.
*/
- attr = GetFileAttributesA(nativePath);
+ attr = GetFileAttributes(nativePath);
/*
* nativePath not found
@@ -437,10 +532,11 @@ TestplatformChmod(
}
/*
- * If nativePath is not a directory, there is no special handling.
+ * If no ACL API is present or nativePath is not a directory, there is no
+ * special handling.
*/
- if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
+ if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
goto done;
}
@@ -456,15 +552,15 @@ TestplatformChmod(
* obtains the size of the security descriptor.
*/
- if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
+ if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) {
DWORD secDescLen2 = 0;
if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
goto done;
}
- secDesc = ckalloc(secDescLen);
- if (!GetFileSecurityA(nativePath, infoBits,
+ secDesc = (BYTE *) ckalloc(secDescLen);
+ if (!getFileSecurityProc(nativePath, infoBits,
(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
|| (secDescLen < secDescLen2)) {
goto done;
@@ -475,22 +571,22 @@ TestplatformChmod(
* Get the World SID.
*/
- userSid = ckalloc(GetSidLengthRequired((UCHAR) 1));
- InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
- *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;
+ userSid = (SID *) ckalloc(getSidLengthRequiredProc((UCHAR) 1));
+ initializeSidProc(userSid, &userSidAuthority, (BYTE) 1);
+ *(getSidSubAuthorityProc(userSid, 0)) = SECURITY_WORLD_RID;
/*
* If curAclPresent == false then curAcl and curAclDefaulted not valid.
*/
- if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc,
+ if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR) secDesc,
&curAclPresent, &curAcl, &curAclDefaulted)) {
goto done;
}
if (!curAclPresent || !curAcl) {
ACLSize.AclBytesInUse = 0;
ACLSize.AceCount = 0;
- } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize),
+ } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize),
AclSizeInformation)) {
goto done;
}
@@ -500,14 +596,14 @@ TestplatformChmod(
*/
newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
- + GetLengthSid(userSid) - sizeof(DWORD);
- newAcl = ckalloc(newAclSize);
+ + getLengthSidProc(userSid) - sizeof(DWORD);
+ newAcl = (ACL *) ckalloc(newAclSize);
/*
* Initialize the new ACL.
*/
- if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
+ if (!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) {
goto done;
}
@@ -515,7 +611,7 @@ TestplatformChmod(
* Add denied to make readonly, this will be known as a "read-only tag".
*/
- if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION,
+ if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION,
readOnlyMask, userSid)) {
goto done;
}
@@ -525,7 +621,7 @@ TestplatformChmod(
LPVOID pACE2;
ACE_HEADER *phACE2;
- if (!GetAce(curAcl, j, &pACE2)) {
+ if (!getAceProc(curAcl, j, &pACE2)) {
goto done;
}
@@ -548,7 +644,7 @@ TestplatformChmod(
ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2;
if (pACEd->Mask == readOnlyMask
- && EqualSid(userSid, (PSID) &pACEd->SidStart)) {
+ && equalSidProc(userSid, (PSID) &pACEd->SidStart)) {
acl_readOnly_found = TRUE;
continue;
}
@@ -558,7 +654,7 @@ TestplatformChmod(
* Copy the current ACE from the old to the new ACL.
*/
- if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
+ if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, (PACL *)pACE2,
((PACE_HEADER) pACE2)->AceSize)) {
goto done;
}
@@ -568,7 +664,7 @@ TestplatformChmod(
* Apply the new ACL.
*/
- if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
+ if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc(
(LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION,
NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
res = 0;
@@ -576,13 +672,13 @@ TestplatformChmod(
done:
if (secDesc) {
- ckfree(secDesc);
+ ckfree((char *) secDesc);
}
if (newAcl) {
- ckfree(newAcl);
+ ckfree((char *) newAcl);
}
if (userSid) {
- ckfree(userSid);
+ ckfree((char *) userSid);
}
if (userDomain) {
ckfree(userDomain);
@@ -622,25 +718,29 @@ static int
TestchmodCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Parameter count */
- Tcl_Obj *const * objv) /* Parameter vector */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
int i, mode;
+ char *rest;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
+ if (argc < 2) {
+ usage:
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " mode file ?file ...?", NULL);
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) {
- return TCL_ERROR;
+ mode = (int) strtol(argv[1], &rest, 8);
+ if ((rest == argv[1]) || (*rest != '\0')) {
+ goto usage;
}
- for (i = 2; i < objc; i++) {
+ for (i = 2; i < argc; i++) {
Tcl_DString buffer;
const char *translated;
- translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer);
+ translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
if (translated == NULL) {
return TCL_ERROR;
}
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 927e115..2413a78 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -5,7 +5,6 @@
*
* Copyright (c) 1998 by Sun Microsystems, Inc.
* Copyright (c) 1999 by Scriptics Corporation
- * Copyright (c) 2008 by George Peter Staplin
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -211,7 +210,7 @@ TclWinThreadStart(
int
TclpThreadCreate(
Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */
- Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */
+ Tcl_ThreadCreateProc proc, /* Main() function of the thread. */
ClientData clientData, /* The one argument to Main(). */
int stackSize, /* Size of stack for the new thread. */
int flags) /* Flags controlling behaviour of the new
@@ -335,7 +334,7 @@ TclpThreadExit(
Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
- return (Tcl_ThreadId)(size_t)GetCurrentThreadId();
+ return (Tcl_ThreadId) INT2PTR(GetCurrentThreadId());
}
/*
@@ -569,8 +568,6 @@ Tcl_MutexLock(
{
CRITICAL_SECTION *csPtr;
-retry:
-
if (*mutexPtr == NULL) {
MASTER_LOCK;
@@ -579,18 +576,14 @@ retry:
*/
if (*mutexPtr == NULL) {
- csPtr = ckalloc(sizeof(CRITICAL_SECTION));
+ csPtr = (CRITICAL_SECTION *) ckalloc(sizeof(CRITICAL_SECTION));
InitializeCriticalSection(csPtr);
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
}
MASTER_UNLOCK;
}
-
csPtr = *((CRITICAL_SECTION **)mutexPtr);
- if (csPtr == NULL) {
- goto retry;
- }
EnterCriticalSection(csPtr);
}
@@ -644,7 +637,7 @@ TclpFinalizeMutex(
if (csPtr != NULL) {
DeleteCriticalSection(csPtr);
- ckfree(csPtr);
+ ckfree((char *) csPtr);
*mutexPtr = NULL;
}
}
@@ -675,7 +668,7 @@ void
Tcl_ConditionWait(
Tcl_Condition *condPtr, /* Really (WinCondition **) */
Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */
- const Tcl_Time *timePtr) /* Timeout on waiting period */
+ Tcl_Time *timePtr) /* Timeout on waiting period */
{
WinCondition *winCondPtr; /* Per-condition queue head */
CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */
@@ -714,7 +707,8 @@ Tcl_ConditionWait(
* and initializing that may drop back into the Master Lock.
*/
- Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr);
+ Tcl_CreateThreadExitHandler(FinalizeConditionEvent,
+ (ClientData) tsdPtr);
}
}
@@ -726,7 +720,7 @@ Tcl_ConditionWait(
*/
if (*condPtr == NULL) {
- winCondPtr = ckalloc(sizeof(WinCondition));
+ winCondPtr = (WinCondition *) ckalloc(sizeof(WinCondition));
InitializeCriticalSection(&winCondPtr->condLock);
winCondPtr->firstPtr = NULL;
winCondPtr->lastPtr = NULL;
@@ -775,8 +769,7 @@ Tcl_ConditionWait(
while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) {
ResetEvent(tsdPtr->condEvent);
LeaveCriticalSection(&winCondPtr->condLock);
- if (WaitForSingleObjectEx(tsdPtr->condEvent, wtime,
- TRUE) == WAIT_TIMEOUT) {
+ if (WaitForSingleObject(tsdPtr->condEvent, wtime) == WAIT_TIMEOUT) {
timeout = 1;
}
EnterCriticalSection(&winCondPtr->condLock);
@@ -937,7 +930,7 @@ TclpFinalizeCondition(
if (winCondPtr != NULL) {
DeleteCriticalSection(&winCondPtr->condLock);
- ckfree(winCondPtr);
+ ckfree((char *) winCondPtr);
*condPtr = NULL;
}
}
@@ -980,7 +973,7 @@ TclpFreeAllocMutex(
void *
TclpGetAllocCache(void)
{
- void *result;
+ VOID *result;
if (!once) {
/*
@@ -1045,61 +1038,6 @@ TclpFreeAllocCache(
}
#endif /* USE_THREAD_ALLOC */
-
-
-void *
-TclpThreadCreateKey(void)
-{
- DWORD *key;
-
- key = TclpSysAlloc(sizeof *key, 0);
- if (key == NULL) {
- Tcl_Panic("unable to allocate thread key!");
- }
-
- *key = TlsAlloc();
-
- if (*key == TLS_OUT_OF_INDEXES) {
- Tcl_Panic("unable to allocate thread-local storage");
- }
-
- return key;
-}
-
-void
-TclpThreadDeleteKey(
- void *keyPtr)
-{
- DWORD *key = keyPtr;
-
- if (!TlsFree(*key)) {
- Tcl_Panic("unable to delete key");
- }
-
- TclpSysFree(keyPtr);
-}
-
-void
-TclpThreadSetMasterTSD(
- void *tsdKeyPtr,
- void *ptr)
-{
- DWORD *key = tsdKeyPtr;
-
- if (!TlsSetValue(*key, ptr)) {
- Tcl_Panic("unable to set master TSD value");
- }
-}
-
-void *
-TclpThreadGetMasterTSD(
- void *tsdKeyPtr)
-{
- DWORD *key = tsdKeyPtr;
-
- return TlsGetValue(*key);
-}
-
#endif /* TCL_THREADS */
/*
diff --git a/win/tclWinThrd.h b/win/tclWinThrd.h
new file mode 100644
index 0000000..41bc7aa
--- /dev/null
+++ b/win/tclWinThrd.h
@@ -0,0 +1,19 @@
+/*
+ * tclWinThrd.h --
+ *
+ * This header file defines things for thread support.
+ *
+ * Copyright (c) 1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TCLWINTHRD
+#define _TCLWINTHRD
+
+#ifdef TCL_THREADS
+
+#endif /* TCL_THREADS */
+
+#endif /* _TCLWINTHRD */
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index 7045c72..0163723 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -87,7 +87,7 @@ typedef struct TimeInfo {
} TimeInfo;
static TimeInfo timeInfo = {
- { NULL, 0, 0, NULL, NULL, 0 },
+ { NULL },
0,
0,
(HANDLE) NULL,
@@ -156,7 +156,7 @@ TclpGetSeconds(void)
{
Tcl_Time t;
- tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */
+ (*tclGetTimeProcPtr) (&t, tclTimeClientData); /* Tcl_GetTime inlined. */
return t.sec;
}
@@ -190,7 +190,7 @@ TclpGetClicks(void)
Tcl_Time now; /* Current Tcl time */
unsigned long retval; /* Value to return */
- tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */
+ (*tclGetTimeProcPtr) (&now, tclTimeClientData); /* Tcl_GetTime inlined */
retval = (now.sec * 1000000) + now.usec;
return retval;
@@ -200,6 +200,35 @@ TclpGetClicks(void)
/*
*----------------------------------------------------------------------
*
+ * TclpGetTimeZone --
+ *
+ * Determines the current timezone. The method varies wildly between
+ * different Platform implementations, so its hidden in this function.
+ *
+ * Results:
+ * Minutes west of GMT.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpGetTimeZone(
+ unsigned long currentTime)
+{
+ int timeZone;
+
+ tzset();
+ timeZone = timezone / 60;
+
+ return timeZone;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetTime --
*
* Gets the current system time in seconds and microseconds since the
@@ -223,7 +252,7 @@ void
Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
- tclGetTimeProcPtr(timePtr, tclTimeClientData);
+ (*tclGetTimeProcPtr) (timePtr, tclTimeClientData);
}
/*
@@ -385,7 +414,7 @@ NativeGetTime(
WaitForSingleObject(timeInfo.readyEvent, INFINITE);
CloseHandle(timeInfo.readyEvent);
- Tcl_CreateExitHandler(StopCalibration, NULL);
+ Tcl_CreateExitHandler(StopCalibration, (ClientData) NULL);
}
timeInfo.initialized = TRUE;
}
@@ -489,6 +518,93 @@ StopCalibration(
/*
*----------------------------------------------------------------------
*
+ * TclpGetTZName --
+ *
+ * Gets the current timezone string.
+ *
+ * Results:
+ * Returns a pointer to a static string, or NULL on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpGetTZName(
+ int dst)
+{
+ int len;
+ char *zone, *p;
+ TIME_ZONE_INFORMATION tz;
+ Tcl_Encoding encoding;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ char *name = tsdPtr->tzName;
+
+ /*
+ * tzset() under Borland doesn't seem to set up tzname[] at all.
+ * tzset() under MSVC has the following weird observed behavior:
+ * First time we call "clock format [clock seconds] -format %Z -gmt 1"
+ * we get "GMT", but on all subsequent calls we get the current time
+ * ezone string, even though env(TZ) is GMT and the variable _timezone
+ * is 0.
+ */
+
+ name[0] = '\0';
+
+ zone = getenv("TZ");
+ if (zone != NULL) {
+ /*
+ * TZ is of form "NST-4:30NDT", where "NST" would be the name of the
+ * standard time zone for this area, "-4:30" is the offset from GMT in
+ * hours, and "NDT is the name of the daylight savings time zone in
+ * this area. The offset and DST strings are optional.
+ */
+
+ len = strlen(zone);
+ if (len > 3) {
+ len = 3;
+ }
+ if (dst != 0) {
+ /*
+ * Skip the offset string and get the DST string.
+ */
+
+ p = zone + len;
+ p += strspn(p, "+-:0123456789");
+ if (*p != '\0') {
+ zone = p;
+ len = strlen(zone);
+ if (len > 3) {
+ len = 3;
+ }
+ }
+ }
+ Tcl_ExternalToUtf(NULL, NULL, zone, len, 0, NULL, name,
+ sizeof(tsdPtr->tzName), NULL, NULL, NULL);
+ }
+ if (name[0] == '\0') {
+ if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) {
+ /*
+ * MSDN: On NT this is returned if DST is not used in the current
+ * TZ
+ */
+
+ dst = 0;
+ }
+ encoding = Tcl_GetEncoding(NULL, "unicode");
+ Tcl_ExternalToUtf(NULL, encoding,
+ (char *) ((dst) ? tz.DaylightName : tz.StandardName), -1,
+ 0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL);
+ Tcl_FreeEncoding(encoding);
+ }
+ return name;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpGetDate --
*
* This function converts between seconds and struct tm. If useGMT is
@@ -506,7 +622,7 @@ StopCalibration(
struct tm *
TclpGetDate(
- const time_t *t,
+ CONST time_t *t,
int useGMT)
{
struct tm *tmPtr;
@@ -1052,7 +1168,7 @@ AccumulateSample(
struct tm *
TclpGmtime(
- const time_t *timePtr) /* Pointer to the number of seconds since the
+ CONST time_t *timePtr) /* Pointer to the number of seconds since the
* local system's epoch */
{
/*
@@ -1083,8 +1199,9 @@ TclpGmtime(
struct tm *
TclpLocaltime(
- const time_t *timePtr) /* Pointer to the number of seconds since the
+ 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
diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh
deleted file mode 100644
index 55fe75f..0000000
--- a/win/tclooConfig.sh
+++ /dev/null
@@ -1,19 +0,0 @@
-# tclooConfig.sh --
-#
-# This shell script (for sh) is generated automatically by TclOO's configure
-# script, or would be except it has no values that we substitute. It will
-# create shell variables for most of the configuration options discovered by
-# the configure script. This script is intended to be included by TEA-based
-# configure scripts for TclOO extensions so that they don't have to figure
-# this all out for themselves.
-#
-# The information in this file is specific to a single platform.
-
-# These are mostly empty because no special steps are ever needed from Tcl 8.6
-# onwards; all libraries and include files are just part of Tcl.
-TCLOO_LIB_SPEC=""
-TCLOO_STUB_LIB_SPEC=""
-TCLOO_INCLUDE_SPEC=""
-TCLOO_PRIVATE_INCLUDE_SPEC=""
-TCLOO_CFLAGS=""
-TCLOO_VERSION=1.0.3
diff --git a/win/tclsh.ico b/win/tclsh.ico
index e254318..8bcaf48 100644
--- a/win/tclsh.ico
+++ b/win/tclsh.ico
Binary files differ