summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in333
-rw-r--r--win/README11
-rwxr-xr-x[-rw-r--r--]win/buildall.vc.bat33
-rw-r--r--win/cat.c9
-rw-r--r--win/coffbase.txt9
-rwxr-xr-xwin/configure493
-rw-r--r--win/configure.in118
-rw-r--r--win/makefile.bc82
-rw-r--r--win/makefile.vc297
-rw-r--r--win/nmakehlp.c74
-rw-r--r--win/rules.vc51
-rw-r--r--win/stub16.c195
-rw-r--r--win/tcl.dsp16
-rw-r--r--win/tcl.hpj.in4
-rw-r--r--win/tcl.m4110
-rw-r--r--win/tclAppInit.c207
-rw-r--r--win/tclWin32Dll.c538
-rw-r--r--win/tclWinChan.c61
-rw-r--r--win/tclWinConsole.c473
-rw-r--r--win/tclWinDde.c183
-rw-r--r--win/tclWinError.c7
-rw-r--r--win/tclWinFCmd.c323
-rw-r--r--win/tclWinFile.c815
-rw-r--r--win/tclWinInit.c79
-rw-r--r--win/tclWinInt.h135
-rw-r--r--win/tclWinLoad.c185
-rw-r--r--win/tclWinNotify.c451
-rw-r--r--win/tclWinPipe.c328
-rw-r--r--win/tclWinPort.h277
-rw-r--r--win/tclWinReg.c568
-rw-r--r--win/tclWinSerial.c123
-rw-r--r--win/tclWinSock.c616
-rw-r--r--win/tclWinTest.c151
-rw-r--r--win/tclWinThrd.c78
-rw-r--r--win/tclWinThrd.h19
-rw-r--r--win/tclWinTime.c23
-rw-r--r--win/tclooConfig.sh19
-rw-r--r--win/tclsh.icobin3630 -> 57022 bytes
38 files changed, 3836 insertions, 3658 deletions
diff --git a/win/Makefile.in b/win/Makefile.in
index d3c9c80..8492b8f 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -80,7 +80,7 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
#CFLAGS = $(CFLAGS_DEBUG)
#CFLAGS = $(CFLAGS_OPTIMIZE)
#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
-CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
+CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE
# To enable compilation debugging reverse the comment characters on one of the
# following lines.
@@ -88,15 +88,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@/..
-GENERIC_DIR = @srcdir@/../generic
-TOMMATH_DIR = @srcdir@/../libtommath
-WIN_DIR = @srcdir@
-COMPAT_DIR = @srcdir@/../compat
+TOP_DIR = $(shell cd @srcdir@/..; pwd)
+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
# Converts a POSIX path to a Windows native path.
CYGPATH = @CYGPATH@
@@ -129,32 +129,34 @@ 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 = tcldde$(DDEVER)${LIBSUFFIX}
+DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX}
REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX}
-REG_LIB_FILE = tclreg$(REGVER)${LIBSUFFIX}
-PIPE_DLL_FILE = tclpip$(VER)${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
-SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \
- $(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE)
+SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_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)
+VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR):$(ZLIB_DIR)
AR = @AR@
RANLIB = @RANLIB@
@@ -172,10 +174,10 @@ EXEEXT = @EXEEXT@
OBJEXT = @OBJEXT@
STLIB_LD = @STLIB_LD@
SHLIB_LD = @SHLIB_LD@
-SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(LIBS)
+SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
SHLIB_CFLAGS = @SHLIB_CFLAGS@
SHLIB_SUFFIX = @SHLIB_SUFFIX@
-LIBS = @LIBS@
+LIBS = @LIBS@ @ZLIB_LIBS@
RMDIR = rm -rf
MKDIR = mkdir -p
@@ -183,7 +185,7 @@ SHELL = @SHELL@
RM = rm -f
COPY = cp
-CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
+CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} -I"${ZLIB_DIR}" \
-I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \
-I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
${COMPILE_DEBUG_FLAGS}
@@ -201,8 +203,7 @@ TCLTEST_OBJS = \
tclTestObj.$(OBJEXT) \
tclTestProcBodyObj.$(OBJEXT) \
tclThreadTest.$(OBJEXT) \
- tclWinTest.$(OBJEXT) \
- testMain.$(OBJEXT)
+ tclWinTest.$(OBJEXT)
GENERIC_OBJS = \
regcomp.$(OBJEXT) \
@@ -210,6 +211,7 @@ GENERIC_OBJS = \
regfree.$(OBJEXT) \
regerror.$(OBJEXT) \
tclAlloc.$(OBJEXT) \
+ tclAssembly.$(OBJEXT) \
tclAsync.$(OBJEXT) \
tclBasic.$(OBJEXT) \
tclBinary.$(OBJEXT) \
@@ -219,12 +221,14 @@ GENERIC_OBJS = \
tclCmdIL.$(OBJEXT) \
tclCmdMZ.$(OBJEXT) \
tclCompCmds.$(OBJEXT) \
+ tclCompCmdsSZ.$(OBJEXT) \
tclCompExpr.$(OBJEXT) \
tclCompile.$(OBJEXT) \
tclConfig.$(OBJEXT) \
tclDate.$(OBJEXT) \
tclDictObj.$(OBJEXT) \
tclEncoding.$(OBJEXT) \
+ tclEnsemble.$(OBJEXT) \
tclEnv.$(OBJEXT) \
tclEvent.$(OBJEXT) \
tclExecute.$(OBJEXT) \
@@ -239,6 +243,7 @@ GENERIC_OBJS = \
tclIOCmd.$(OBJEXT) \
tclIOGT.$(OBJEXT) \
tclIORChan.$(OBJEXT) \
+ tclIORTrans.$(OBJEXT) \
tclIOSock.$(OBJEXT) \
tclIOUtil.$(OBJEXT) \
tclLink.$(OBJEXT) \
@@ -246,8 +251,16 @@ 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) \
tclPanic.$(OBJEXT) \
tclParse.$(OBJEXT) \
@@ -265,7 +278,6 @@ GENERIC_OBJS = \
tclStringObj.$(OBJEXT) \
tclStrToD.$(OBJEXT) \
tclStubInit.$(OBJEXT) \
- tclStubLib.$(OBJEXT) \
tclThread.$(OBJEXT) \
tclThreadAlloc.$(OBJEXT) \
tclThreadJoin.$(OBJEXT) \
@@ -275,7 +287,8 @@ GENERIC_OBJS = \
tclTrace.$(OBJEXT) \
tclUtf.$(OBJEXT) \
tclUtil.$(OBJEXT) \
- tclVar.$(OBJEXT)
+ tclVar.$(OBJEXT) \
+ tclZlib.$(OBJEXT)
TOMMATH_OBJS = \
bncore.${OBJEXT} \
@@ -360,45 +373,51 @@ WIN_OBJS = \
tclWinThrd.$(OBJEXT) \
tclWinTime.$(OBJEXT)
-PIPE_OBJS = stub16.$(OBJEXT)
-
DDE_OBJS = tclWinDde.$(OBJEXT)
REG_OBJS = tclWinReg.$(OBJEXT)
-STUB_OBJS = tclStubLib.$(OBJEXT)
+STUB_OBJS = \
+ tclStubLib.$(OBJEXT) \
+ tclTomMathStubLib.$(OBJEXT) \
+ tclOOStubLib.$(OBJEXT)
TCLSH_OBJS = tclAppInit.$(OBJEXT)
-TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS}
+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_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]
-all: binaries libraries doc
+all: binaries libraries doc packages
tcltest: $(TCLTEST)
-binaries: @LIBRARIES@ $(TCLSH)
+binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH)
libraries:
doc:
-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): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
+ $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_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) \
+$(TCLTEST): testMain.$(OBJEXT) ${TEST_DLL_FILE} @LIBRARIES@ $(TCL_STUB_LIB_FILE) $(CAT32) tclsh.$(RES)
+ $(CC) $(CFLAGS) testMain.$(OBJEXT) ${TEST_LIB_FILE} $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
@VC_MANIFEST_EMBED_EXE@
@@ -416,8 +435,8 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
@MAKE_LIB@ ${STUB_OBJS}
@POST_MAKE_LIB@
-${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES)
- @$(RM) ${TCL_DLL_FILE}
+${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@
+ @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE)
@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
@VC_MANIFEST_EMBED_DLL@
@@ -426,27 +445,45 @@ ${TCL_LIB_FILE}: ${TCL_OBJS}
@MAKE_LIB@ ${TCL_OBJS}
@POST_MAKE_LIB@
-${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE}
- @$(RM) ${DDE_DLL_FILE}
+# assume GNU make
+
+# To enable concurrent parallel make of tcl<x>.dll and tcl<x>.lib, the tcl<x>.dll
+# targets have to depend on tcl<x>.lib, this ensures that linking of tcl<x>.dll
+# does not execute concurrently with the renaming and recompiling of tcl<x>.lib
+
+${DDE_DLL_FILE}: ${DDE_OBJS} ${DDE_LIB_FILE} ${TCL_STUB_LIB_FILE}
+ @-$(RM) ${DDE_DLL_FILE} ${DDE_LIB_FILE}.sav
+ @-$(COPY) ${DDE_LIB_FILE} ${DDE_LIB_FILE}.sav
@MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
+ @-$(RM) ${DDE_LIB_FILE}
+ @-$(COPY) ${DDE_LIB_FILE}.sav ${DDE_LIB_FILE}
+ @-$(RM) ${DDE_LIB_FILE}.sav
-${DDE_LIB_FILE}: ${DDE_OBJS} ${TCL_LIB_FILE}
+${DDE_LIB_FILE}: ${DDE_OBJS}
@$(RM) ${DDE_LIB_FILE}
- @MAKE_LIB@ ${DDE_OBJS} ${TCL_LIB_FILE}
+ @MAKE_LIB@ ${DDE_OBJS}
+ @POST_MAKE_LIB@
-${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE}
- @$(RM) ${REG_DLL_FILE}
+${REG_DLL_FILE}: ${REG_OBJS} ${REG_LIB_FILE} ${TCL_STUB_LIB_FILE}
+ @-$(RM) ${REG_DLL_FILE} ${REG_LIB_FILE}.sav
+ @-$(COPY) ${REG_LIB_FILE} ${REG_LIB_FILE}.sav
@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
+ @-$(RM) ${REG_LIB_FILE}
+ @-$(COPY) ${REG_LIB_FILE}.sav ${REG_LIB_FILE}
+ @-$(RM) ${REG_LIB_FILE}.sav
-${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE}
+${REG_LIB_FILE}: ${REG_OBJS}
@$(RM) ${REG_LIB_FILE}
- @MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE}
+ @MAKE_LIB@ ${REG_OBJS}
+ @POST_MAKE_LIB@
-# PIPE_DLL_FILE is actually an executable, don't build it like a DLL.
+${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE}
+ @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
+ @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
-${PIPE_DLL_FILE}: ${PIPE_OBJS}
- @$(RM) ${PIPE_DLL_FILE}
- @MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS) $(LDFLAGS_CONSOLE)
+# use pre-built zlib1.dll
+${ZLIB_DLL_FILE}: $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE}
+ @$(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}
# Add the object extension to the implicit rules. By default .obj is not
# automatically added.
@@ -461,31 +498,13 @@ tclWinInit.${OBJEXT}: tclWinInit.c
$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tclWinPipe.${OBJEXT}: tclWinPipe.c
- $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \
- $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+ $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
testMain.${OBJEXT}: tclAppInit.c
$(CC) -c $(CC_SWITCHES) -DTCL_TEST @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)
+tclMain2.${OBJEXT}: tclMain.c
+ $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)
# TIP #59, embedding of configuration information into the binary library.
#
@@ -517,6 +536,11 @@ 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
@@ -546,7 +570,7 @@ gentommath_h:
"$(TOMMATH_DIR_NATIVE)\tommath.h" \
> "$(GENERIC_DIR_NATIVE)\tclTomMath.h"
-install: all install-binaries install-libraries install-doc
+install: all install-binaries install-libraries install-doc install-packages
install-binaries: binaries
@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
@@ -558,7 +582,7 @@ install-binaries: binaries
else true; \
fi; \
done;
- @for i in dde1.3 reg1.2; \
+ @for i in dde${DDEDOTVER} reg${REGDOTVER}; \
do \
if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
@@ -566,14 +590,14 @@ install-binaries: binaries
else true; \
fi; \
done;
- @for i in $(TCL_DLL_FILE) $(TCLSH) $(PIPE_DLL_FILE); \
+ @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH); \
do \
if [ -f $$i ]; then \
echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \
$(COPY) $$i "$(BIN_INSTALL_DIR)"; \
fi; \
done
- @for i in tclConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
+ @for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
do \
if [ -f $$i ]; then \
echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \
@@ -592,13 +616,13 @@ install-binaries: binaries
fi
@if [ -f $(REG_DLL_FILE) ]; then \
echo installing $(REG_DLL_FILE); \
- $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.2; \
+ $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.3; \
$(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/reg1.2; \
+ $(LIB_INSTALL_DIR)/reg1.3; \
fi
@if [ -f $(REG_LIB_FILE) ]; then \
echo installing $(REG_LIB_FILE); \
- $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.2; \
+ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.3; \
fi
install-libraries: libraries install-tzdata install-msgs
@@ -611,7 +635,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; \
+ @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
@@ -621,6 +645,7 @@ 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"; \
@@ -637,8 +662,8 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
done;
- @echo "Installing package http 2.7.9 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.9.tm;
+ @echo "Installing package http 2.8.4 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.4.tm;
@echo "Installing library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
@@ -659,14 +684,12 @@ install-libraries: libraries install-tzdata install-msgs
install-tzdata:
@echo "Installing time zone data"
- @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \
- ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \
+ @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
"$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
install-msgs:
@echo "Installing message catalogs"
- @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \
- ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \
+ @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
"$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
install-doc: doc
@@ -684,6 +707,7 @@ 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)"; \
@@ -693,7 +717,9 @@ install-private-headers: libraries
# tcltest, i.e.:
# % make test TESTFLAGS="-verbose bps -file fileName.test"
-test: binaries $(TCLTEST)
+test: test-tcl test-packages
+
+test-tcl: binaries $(TCLTEST)
TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
-load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \
@@ -725,16 +751,94 @@ Makefile: $(SRC_DIR)/Makefile.in
cleanhelp:
$(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe
-clean: cleanhelp
+clean: cleanhelp clean-packages
$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
$(RM) $(TCLSH) $(TCLTEST) $(CAT32)
$(RM) *.pch *.ilk *.pdb
-distclean: clean
+distclean: distclean-packages 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=`pwd`; \
+ 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 = `pwd`"; \
+ $$i/configure --with-tcl=$(PWD) --with-tclinclude=$(GENERIC_DIR) $(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`; \
+ 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`; \
+ 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/tcltest"; ) \
+ fi; \
+ fi; \
+ done; \
+ cd $$builddir
+
+clean-packages:
+ @builddir=`pwd`; \
+ 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`; \
+ 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.
#
@@ -748,5 +852,38 @@ 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
+# 'make' from getting confused when someone makes an error in a rule.
+#
+
+.PHONY: all tcltest binaries libraries doc gendate gentommath_h install
+.PHONY: install-binaries install-libraries install-tzdata install-msgs
+.PHONY: install-doc install-private-headers test test-tcl runtest shell
+.PHONY: gdb depend cleanhelp clean distclean packages install-packages
+.PHONY: test-packages clean-packages distclean-packages genstubs html
+.PHONY: html-tcl html-tk
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/win/README b/win/README
index 1929362..d1a4289 100644
--- a/win/README
+++ b/win/README
@@ -1,4 +1,4 @@
-Tcl 8.5 for Windows
+Tcl 8.6 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.5 Source Distribution (plus any patches)
+ Tcl 8.6 Source Distribution (plus any patches)
and
@@ -27,6 +27,9 @@ In order to compile Tcl for Windows, you need the following:
Msys + Mingw [http://www.mingw.org/download.shtml]
+Please note that building under Cygwin is NOT supported,
+do not file a bug report about building under Cygwin.
+
In practice, this release is built with Visual C++ 6.0 and the TEA
Makefile.
@@ -51,9 +54,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 tclsh85.exe, you must ensure that tcl85.dll is on
+Note that in order to run tclsh86.exe, you must ensure that tcl86.dll is on
your path, in the system directory, or in the directory containing
-tclsh85.exe.
+tclsh86.exe.
Note: Tcl no longer provides support for Win32s.
diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat
index 55b29ae..c33aefd 100644..100755
--- a/win/buildall.vc.bat
+++ b/win/buildall.vc.bat
@@ -22,17 +22,24 @@ goto OPTIONS_DONE
:: reset errorlevel
cd > nul
+:: You might have installed your developer studio to add itself to the
+:: path or have already run vcvars32.bat. Testing these envars proves
+:: cl.exe and friends are in your path.
+::
+if defined VCINSTALLDIR (goto :startBuilding)
+if defined MSDRVDIR (goto :startBuilding)
+if defined MSVCDIR (goto :startBuilding)
+if defined MSSDK (goto :startBuilding)
+
:: We need to run the development environment batch script that comes
-:: with developer studio (v4,5,6,7,etc...) All have it. These paths
-:: might not be correct. You may need to edit these.
+:: with developer studio (v4,5,6,7,etc...) All have it. This path
+:: might not be correct. You should call it yourself prior to running
+:: this batchfile.
::
-if not defined MSDevDir (
- call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
- ::call "C:\Program Files\Microsoft Developer Studio\vc\bin\vcvars32.bat"
- ::call c:\dev\devstudio60\vc98\bin\vcvars32.bat
- if errorlevel 1 goto no_vcvars
-)
+call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
+if errorlevel 1 (goto no_vcvars)
+:startBuilding
echo.
echo Sit back and have a cup of coffee while this grinds through ;)
@@ -52,7 +59,7 @@ if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl
::
set OPTS=none
if not %SYMBOLS%.==. set OPTS=symbols
-nmake -nologo -f makefile.vc release winhelp OPTS=%OPTS% %1
+nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1
if errorlevel 1 goto error
:: Build the static core, dlls and shell.
@@ -100,15 +107,15 @@ echo *** BOOM! ***
goto end
:no_vcvars
-echo vcvars32.bat not found. You'll need to edit this batch script.
+echo vcvars32.bat was not run prior to this batchfile, nor are the MS tools in your path.
goto out
:help
title buildall.vc.bat help message
echo usage:
-echo %0 : builds Tcl for all build types (do this first)
-echo %0 install : installs all the release builds (do this second)
-echo %0 symbols : builds Tcl for all debugging build types
+echo %0 : builds Tcl for all build types (do this first)
+echo %0 install : installs all the release builds (do this second)
+echo %0 symbols : builds Tcl for all debugging build types
echo %0 symbols install : install all the debug builds.
echo.
goto out
diff --git a/win/cat.c b/win/cat.c
index d413923..d49e37c 100644
--- a/win/cat.c
+++ b/win/cat.c
@@ -9,12 +9,19 @@
* 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
-main(void)
+_tmain(void)
{
char buf[1024];
int n;
diff --git a/win/coffbase.txt b/win/coffbase.txt
index 8d3f84b..7d19420 100644
--- a/win/coffbase.txt
+++ b/win/coffbase.txt
@@ -25,9 +25,16 @@ iocpsock 0x10700000 0x00080000
tls 0x10780000 0x00100000
winico 0x10880000 0x00010000
tile 0x10900000 0x00080000
-memchan 0x109D0000 0x00010000
+memchan 0x109D0000 0x00010000
tdom 0x109E0000 0x00080000
+tclvfs 0x10A70000 0x00010000
tkvideo 0x10B00000 0x00010000
+tclsdl 0x10B20000 0x00080000
+vqtcl 0x10C00000 0x00010000
+tdbc 0x10C40000 0x00010000
+;
+; insert new packages here
+;
snack 0x1E000000 0x00400000
sound 0x1E400000 0x00400000
snackogg 0x1E800000 0x00200000
diff --git a/win/configure b/win/configure
index 07a9436..0ed0012 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 CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE 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 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_DDE_PATCH_LEVEL TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION TCL_REG_PATCH_LEVEL 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 ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE 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 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_DDE_PATCH_LEVEL TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION TCL_REG_PATCH_LEVEL RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@@ -1308,10 +1308,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TCL_VERSION=8.5
+TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=5
-TCL_PATCH_LEVEL=".11"
+TCL_MINOR_VERSION=6
+TCL_PATCH_LEVEL="b2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.3
@@ -1320,12 +1320,14 @@ TCL_DDE_MINOR_VERSION=3
TCL_DDE_PATCH_LEVEL="2"
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
-TCL_REG_VERSION=1.2
+TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=2
-TCL_REG_PATCH_LEVEL="1"
+TCL_REG_MINOR_VERSION=3
+TCL_REG_PATCH_LEVEL="0"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
+PKG_CFG_ARGS=$@
+
#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
@@ -3045,75 +3047,6 @@ fi
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5
-echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6
-if test "${ac_cv_cygwin+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. */
-
-#ifdef __CYGWIN__
-#error cygwin
-#endif
-
-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
- ac_cv_cygwin=no
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_cygwin=yes
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5
-echo "${ECHO_T}$ac_cv_cygwin" >&6
-if test "$ac_cv_cygwin" = "yes" ; then
- { { echo "$as_me:$LINENO: error: Compiling under Cygwin is not currently supported.
-A maintainer for the Cygwin port of Tcl/Tk is needed. See the README
-file for information about building with Mingw." >&5
-echo "$as_me: error: Compiling under Cygwin is not currently supported.
-A maintainer for the Cygwin port of Tcl/Tk is needed. See the README
-file for information about building with Mingw." >&2;}
- { (exit 1); exit 1; }; }
-fi
-
-
echo "$as_me:$LINENO: checking for SEH support in compiler" >&5
echo $ECHO_N "checking for SEH support in compiler... $ECHO_C" >&6
if test "${tcl_cv_seh+set}" = set; then
@@ -3694,6 +3627,144 @@ _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_have_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_have_wspiapi_h=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_have_wspiapi_h=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $tcl_have_wspiapi_h" >&5
+echo "${ECHO_T}$tcl_have_wspiapi_h" >&6
+if test "$tcl_have_wspiapi_h" = "yes"; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_WSPIAPI_H 1
+_ACEOF
+
+fi
+
#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------
@@ -3713,7 +3784,7 @@ if test "${enable_threads+set}" = set; then
enableval="$enable_threads"
tcl_ok=$enableval
else
- tcl_ok=no
+ tcl_ok=yes
fi;
if test "$tcl_ok" = "yes"; then
@@ -3732,8 +3803,8 @@ _ACEOF
else
TCL_THREADS=0
- echo "$as_me:$LINENO: result: no (default)" >&5
-echo "${ECHO_T}no (default)" >&6
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
fi
@@ -3926,6 +3997,11 @@ 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
@@ -4002,6 +4078,72 @@ echo "${ECHO_T}yes" >&6
cyg_conftest=
fi
+ echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5
+echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6
+if test "${ac_cv_cygwin+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. */
+
+ #ifdef __CYGWIN__
+ #error cygwin
+ #endif
+
+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
+ ac_cv_cygwin=no
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_cygwin=yes
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5
+echo "${ECHO_T}$ac_cv_cygwin" >&6
+ if test "$ac_cv_cygwin" = "yes" ; then
+ { echo "$as_me:$LINENO: WARNING: Compiling under Cygwin is not currently supported.
+If you are not sure you want this, see the README
+file for information about building with Mingw." >&5
+echo "$as_me: WARNING: Compiling under Cygwin is not currently supported.
+If you are not sure you want this, see the README
+file for information about building with Mingw." >&2;}
+ fi
if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
DEPARG='"$<"'
else
@@ -4014,8 +4156,8 @@ echo "${ECHO_T}yes" >&6
echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
- SHLIB_LD_LIBS=""
- LIBS="-lws2_32"
+ SHLIB_LD_LIBS='${LIBS}'
+ LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -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'
@@ -4047,14 +4189,77 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
rm -f ac$$.o ac$$.c
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
+
if test "${SHARED_BUILD}" = "0" ; then
# static
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
@@ -4072,30 +4277,30 @@ 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. Make sure CFLAGS is
- # included so -mno-cygwin passed the correct libs to the linker.
- SHLIB_LD='${CC} -shared ${CFLAGS}'
- 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. Make sure CFLAGS is
+ # included so -mno-cygwin passed the correct libs to the linker.
+ SHLIB_LD='${CC} -shared ${CFLAGS}'
+ 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"
+ CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
@@ -4196,28 +4401,23 @@ 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.
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
- LIBSUFFIX="\${DBGX}.lib"
- LIBFLAGSUFFIX="\${DBGX}"
- EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
- SHLIB_LD_LIBS='${LIBS}'
+ EXESUFFIX="\${DBGX}.exe"
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.
@@ -4250,7 +4450,7 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
fi
fi
- LIBS="user32.lib advapi32.lib ws2_32.lib"
+ LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib"
if test "$do64bit" != "no" ; then
# The space-based-path will work for the Makefile, but will
# not work if AC_TRY_COMPILE is called. TEA has the
@@ -4448,6 +4648,7 @@ _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
@@ -4497,6 +4698,65 @@ _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 "$do64bit" = "yes"; then
+
+ tcl_ok=no
+
+else
+
+if test "${enable_shared+set}" = "set"; then
+
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+
+else
+
+ tcl_ok=yes
+
+fi
+
+
+fi
+
+if test "$tcl_ok" = "yes"; then
+
+ ZLIB_DLL_FILE=\${ZLIB_DLL_FILE}
+
+ ZLIB_LIBS=\${ZLIB_DIR}/win32/zdll.lib
+
+
+else
+
+ ZLIB_OBJS=\${ZLIB_OBJS}
+
+ cat >>confdefs.h <<_ACEOF
+#define NO_VIZ 1
+_ACEOF
+
+
+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
@@ -4920,12 +5180,6 @@ 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}\""
@@ -4933,6 +5187,10 @@ 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}\""
@@ -4985,6 +5243,12 @@ fi
+
+
+
+
+
+
# empty on win
@@ -5727,6 +5991,9 @@ 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
@@ -5735,8 +6002,14 @@ 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 1b8c25a..1b5f99f 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -11,10 +11,10 @@ AC_PREREQ(2.59)
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TCL_VERSION=8.5
+TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=5
-TCL_PATCH_LEVEL=".11"
+TCL_MINOR_VERSION=6
+TCL_PATCH_LEVEL="b2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.3
@@ -23,12 +23,14 @@ TCL_DDE_MINOR_VERSION=3
TCL_DDE_PATCH_LEVEL="2"
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
-TCL_REG_VERSION=1.2
+TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=2
-TCL_REG_PATCH_LEVEL="1"
+TCL_REG_MINOR_VERSION=3
+TCL_REG_PATCH_LEVEL="0"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
+PKG_CFG_ARGS=$@
+
#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
@@ -75,24 +77,6 @@ dnl under autoconf 2.5X.
dnl
dnl AC_CYGWIN
-AC_CACHE_CHECK(for Cygwin version of gcc,
- ac_cv_cygwin,
-AC_TRY_COMPILE([
-#ifdef __CYGWIN__
-#error cygwin
-#endif
-],
-[],
- ac_cv_cygwin=no,
- ac_cv_cygwin=yes)
-)
-if test "$ac_cv_cygwin" = "yes" ; then
- AC_MSG_ERROR([Compiling under Cygwin is not currently supported.
-A maintainer for the Cygwin port of Tcl/Tk is needed. See the README
-file for information about building with Mingw.])
-fi
-
-
AC_CACHE_CHECK(for SEH support in compiler,
tcl_cv_seh,
AC_TRY_RUN([
@@ -285,6 +269,42 @@ if test "$tcl_cv_mwmo_alertable" = "no"; then
[Defined when MWMO_ALERTABLE is missing from winuser.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_have_wspiapi_h,
+AC_TRY_COMPILE([
+#include <wspiapi.h>
+], [],
+ tcl_have_wspiapi_h=yes,
+ tcl_have_wspiapi_h=no)
+)
+if test "$tcl_have_wspiapi_h" = "yes"; then
+ AC_DEFINE(HAVE_WSPIAPI_H, 1,
+ [Defined when wspiapi.h exists])
+fi
+
#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------
@@ -319,6 +339,40 @@ 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 "$do64bit" = "yes"], [
+ tcl_ok=no
+], [
+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}])
+ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win32/zdll.lib])
+], [
+ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
+ AC_DEFINE_UNQUOTED(NO_VIZ, 1)
+])
+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, [
@@ -384,12 +438,6 @@ 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}\""
@@ -397,6 +445,10 @@ 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}\""
@@ -446,9 +498,15 @@ 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 6ba4420..12ba603 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -50,7 +50,6 @@
#
# 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.
#
@@ -124,14 +123,14 @@ CFG_ENCODING = \"cp1252\"
NAMEPREFIX = tcl
STUBPREFIX = $(NAMEPREFIX)stub
-DOTVERSION = 8.5
-VERSION = 85
+DOTVERSION = 8.6
+VERSION = 86
DDEVERSION = 13
DDEDOTVERSION = 1.3
-REGVERSION = 12
-REGDOTVERSION = 1.2
+REGVERSION = 13
+REGDOTVERSION = 1.3
BINROOT = ..
!IF "$(NODEBUG)" == "1"
@@ -160,8 +159,6 @@ 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
@@ -203,12 +200,14 @@ TCLOBJS = \
$(TMPDIR)\tclCmdIL.obj \
$(TMPDIR)\tclCmdMZ.obj \
$(TMPDIR)\tclCompCmds.obj \
+ $(TMPDIR)\tclCompCmdsSZ.obj \
$(TMPDIR)\tclCompExpr.obj \
$(TMPDIR)\tclCompile.obj \
$(TMPDIR)\tclConfig.obj \
$(TMPDIR)\tclDate.obj \
$(TMPDIR)\tclDictObj.obj \
$(TMPDIR)\tclEncoding.obj \
+ $(TMPDIR)\tclEnsemble.obj \
$(TMPDIR)\tclEnv.obj \
$(TMPDIR)\tclEvent.obj \
$(TMPDIR)\tclExecute.obj \
@@ -231,6 +230,13 @@ 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)\tclPanic.obj \
$(TMPDIR)\tclParse.obj \
@@ -246,7 +252,6 @@ TCLOBJS = \
$(TMPDIR)\tclScan.obj \
$(TMPDIR)\tclStringObj.obj \
$(TMPDIR)\tclStubInit.obj \
- $(TMPDIR)\tclStubLib.obj \
$(TMPDIR)\tclThread.obj \
$(TMPDIR)\tclThreadJoin.obj \
$(TMPDIR)\tclTimer.obj \
@@ -267,9 +272,13 @@ TCLOBJS = \
$(TMPDIR)\tclWinPipe.obj \
$(TMPDIR)\tclWinSock.obj \
$(TMPDIR)\tclWinThrd.obj \
- $(TMPDIR)\tclWinTime.obj
+ $(TMPDIR)\tclWinTime.obj \
+ $(TMPDIR)\tclZlib.obj
-TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj
+TCLSTUBOBJS = \
+ $(TMPDIR)\tclStubLib.obj \
+ $(TMPDIR)\tclTomMathStubLib.obj \
+ $(TMPDIR)\tclOOStubLib.obj
WINDIR = $(ROOT)\win
GENERICDIR = $(ROOT)\generic
@@ -278,6 +287,7 @@ 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
@@ -330,7 +340,7 @@ LNLIBS = import32 cw32mt
######################################################################
release: setup $(TCLSH) dlls
-dlls: setup $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL)
+dlls: setup $(TCLREGDLL) $(TCLDDEDLL)
all: setup $(TCLSH) dlls $(CAT32)
tcltest: setup $(TCLTEST) dlls $(CAT32)
plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
@@ -379,11 +389,6 @@ $(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),, \
@@ -407,10 +412,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)"
@@ -420,10 +425,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.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 http2.8
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.8"
+ -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8"
+ -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8"
@echo installing opt0.4
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
-@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
@@ -447,7 +452,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.2"
+ -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.3"
-@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2"
@echo installing encoding files
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
@@ -455,6 +460,8 @@ 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)"
@@ -474,29 +481,6 @@ 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
@@ -542,6 +526,12 @@ $(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
diff --git a/win/makefile.vc b/win/makefile.vc
index d982284..bc16584 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -5,7 +5,7 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
+#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2001-2005 ActiveState Corporation.
@@ -44,8 +44,7 @@ the build instructions.
#
# 3) Targets are:
# release -- Builds the core, the shell and the dlls. (default)
-# dlls -- Just builds the windows extensions and the 16-bit DOS
-# pipe/thunk helper app.
+# dlls -- Just builds the windows extensions
# shell -- Just builds the shell and the core.
# core -- Only builds the core [tclXX.(dll|lib)].
# all -- Builds everything.
@@ -59,15 +58,21 @@ the build instructions.
# makefile. Helpful to avoid problems when the sources are
# refreshed and you rebuild, but can "overbuild" when common
# headers like tclInt.h just get small changes.
-# winhelp -- Builds the windows .hlp file for Tcl from the troff man
-# files found in $(ROOT)\doc .
+# htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the
+# 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)
#
# 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=static,msvcrt,staticpkg,threads,symbols,profile,loimpact,unchecked,none
+# OPTS=static,msvcrt,staticpkg,nothreads,symbols,profile,loimpact,unchecked,pdbs,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.
@@ -81,12 +86,15 @@ the build instructions.
# staticpkg = Affects the static option only to switch
# tclshXX.exe to have the dde and reg extension linked
# inside it.
-# 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.
-# loimpact = Adds a flag for how NT treats the heap to keep memory
+# nothreads = Turns off full multithreading support.
+# thrdalloc = Use the thread allocator (shared global free pool)
+# This is the default on threaded builds.
+# tclalloc = Use the old non-thread allocator
+# symbols = Debug build. Links to the debug C runtime, disables
+# optimizations and creates pdb symbols files.
+# pdbs = Build detached symbols for release builds.
+# profile = Adds profiling hooks. Map file is assumed.
+# loimpact = Adds a flag for how NT treats the heap to keep memory
# in use, low. This is said to impact alloc performance.
# unchecked = Allows a symbols build to not use the debug
# enabled runtime (msvcrt.dll not msvcrtd.dll
@@ -105,7 +113,7 @@ the build instructions.
# Sets special macros for checking compatability.
#
# nodep = Turns off compatability macros to ensure the core
-# isn't being built with deprecated functions.
+# isn't being built with deprecated functions.
# fullwarn = Builds with full compiler and link warnings enabled.
# Very verbose.
# 64bit = Enable 64bit portability warnings (if available)
@@ -119,7 +127,7 @@ the build instructions.
# TMP_DIR=<path>
# OUT_DIR=<path>
# Hooks to allow the intermediate and output directories to be
-# changed. $(OUT_DIR) is assumed to be
+# changed. $(OUT_DIR) is assumed to be
# $(BINROOT)\(Release|Debug) based on if symbols are requested.
# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
#
@@ -181,11 +189,11 @@ VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
DDEDOTVERSION = 1.3
DDEVERSION = $(DDEDOTVERSION:.=)
-REGDOTVERSION = 1.2
+REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)
-BINROOT = .
-ROOT = ..
+BINROOT = $(MAKEDIR) # originally .
+ROOT = $(MAKEDIR)\.. # originally ..
TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
@@ -196,8 +204,6 @@ 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)
@@ -244,12 +250,13 @@ TCLTESTOBJS = \
!endif
$(TMP_DIR)\testMain.obj
-TCLOBJS = \
+COREOBJS = \
$(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 \
@@ -259,12 +266,14 @@ TCLOBJS = \
$(TMP_DIR)\tclCmdIL.obj \
$(TMP_DIR)\tclCmdMZ.obj \
$(TMP_DIR)\tclCompCmds.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)\tclEncoding.obj \
+ $(TMP_DIR)\tclEnsemble.obj \
$(TMP_DIR)\tclEnv.obj \
$(TMP_DIR)\tclEvent.obj \
$(TMP_DIR)\tclExecute.obj \
@@ -281,13 +290,22 @@ TCLOBJS = \
$(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)\tclPanic.obj \
$(TMP_DIR)\tclParse.obj \
@@ -305,7 +323,6 @@ TCLOBJS = \
$(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 \
@@ -316,20 +333,22 @@ TCLOBJS = \
$(TMP_DIR)\tclUtf.obj \
$(TMP_DIR)\tclUtil.obj \
$(TMP_DIR)\tclVar.obj \
- $(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)\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)\bncore.obj \
$(TMP_DIR)\bn_reverse.obj \
$(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \
@@ -393,12 +412,34 @@ TCLOBJS = \
$(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 \
+ $(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)\tcl.res
!endif
-TCLSTUBOBJS = $(TMP_DIR)\tclStubLib.obj
+
+TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
+
+TCLSTUBOBJS = \
+ $(TMP_DIR)\tclStubLib.obj \
+ $(TMP_DIR)\tclTomMathStubLib.obj \
+ $(TMP_DIR)\tclOOStubLib.obj
### The following paths CANNOT have spaces in them.
COMPATDIR = $(ROOT)\compat
@@ -407,7 +448,7 @@ GENERICDIR = $(ROOT)\generic
TOMMATHDIR = $(ROOT)\libtommath
TOOLSDIR = $(ROOT)\tools
WINDIR = $(ROOT)\win
-
+PKGSDIR = $(ROOT)\pkgs
#---------------------------------------------------------------------
# Compile flags
@@ -449,12 +490,11 @@ crt = -MT
!endif
TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
-TCL_DEFINES = -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline
+TCL_DEFINES = -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1
BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE
TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES)
-### Stubs files should not be compiled with -GL
-STUB_CFLAGS = $(cflags) $(cdebug:-GL=) $(OPTDEFINES)
+STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES)
#---------------------------------------------------------------------
@@ -493,7 +533,7 @@ dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
-baselibs = kernel32.lib user32.lib ws2_32.lib
+baselibs = netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
@@ -515,19 +555,19 @@ TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
# Project specific targets
#---------------------------------------------------------------------
-release: setup $(TCLSH) $(TCLSTUBLIB) dlls
+release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
core: setup $(TCLLIB) $(TCLSTUBLIB)
shell: setup $(TCLSH)
-dlls: setup $(TCLPIPEDLL) $(TCLREGLIB) $(TCLDDELIB)
-all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32)
+dlls: setup $(TCLREGLIB) $(TCLDDELIB)
+all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs
tcltest: setup $(TCLTEST) dlls $(CAT32)
-install: install-binaries install-libraries install-docs
-
+install: install-binaries install-libraries install-docs install-pkgs
-test: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT)/library
+test: test-core test-pkgs
+test-core: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT:\=/)/../library
!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
- $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
+ $(DEBUGGER) $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
set ::ddelib [file normalize $(TCLDDELIB:\=/)]
set ::reglib [file normalize $(TCLREGLIB:\=/)]
<<
@@ -542,7 +582,11 @@ test: setup $(TCLTEST) dlls $(CAT32)
runtest: setup $(TCLTEST) dlls $(CAT32)
set TCL_LIBRARY=$(ROOT)/library
- $(DEBUGGER) $(TCLTEST)
+ $(DEBUGGER) $(TCLTEST) $(SCRIPT)
+
+runshell: setup $(TCLSH) dlls
+ set TCL_LIBRARY=$(ROOT)/library
+ $(DEBUGGER) $(TCLSH) $(SCRIPT)
setup:
@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
@@ -554,7 +598,7 @@ $(TCLIMPLIB): $(TCLLIB)
$(TCLLIB): $(TCLOBJS)
!if $(STATIC_BUILD)
- $(lib32) -nologo -out:$@ @<<
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ @<<
$**
<<
!else
@@ -563,49 +607,71 @@ $**
$**
<<
$(_VC_MANIFEST_EMBED_DLL)
- -@del $*.exp
!endif
$(TCLSTUBLIB): $(TCLSTUBOBJS)
- $(lib32) -nologo -out:$@ $(TCLSTUBOBJS)
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ $(TCLSTUBOBJS)
-$(TCLSH): $(TCLSHOBJS) $(TCLIMPLIB)
+$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
$(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
$(_VC_MANIFEST_EMBED_EXE)
-$(TCLTEST): $(TCLTESTOBJS) $(TCLIMPLIB)
+$(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 -out:$@ $**
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
!else
$(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)
$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
- $(lib32) -nologo -out:$@ $**
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
!else
$(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 \
@@ -623,6 +689,8 @@ genstubs:
$(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
$(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \
$(GENERICDIR:\=/)/tclTomMath.decls
+ $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
+ $(GENERICDIR:\=/)/tclOO.decls
!endif
@@ -642,9 +710,49 @@ gentommath_h:
!endif
#---------------------------------------------------------------------
-# Build the windows help file.
+# Build the Windows HTML help file.
#---------------------------------------------------------------------
+# NOTE: you can define HHC on the command-line to override this
+!ifndef HHC
+HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe""
+!endif
+HTMLDIR=$(ROOT)\html
+HTMLBASE=TclTk$(VERSION)
+HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
+CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm
+
+htmlhelp: chmsetup $(CHMFILE)
+
+$(CHMFILE): $(DOCDIR)\*
+ @$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl
+ @echo Compiling HTML help project
+ @$(HHC) <<$(HHPFILE) >NUL
+[OPTIONS]
+Compatibility=1.1 or later
+Compiled file=$(HTMLBASE).chm
+Display compile progress=no
+Error log file=$(HTMLBASE).log
+Language=0x409 English (United States)
+Title=Tcl/Tk $(DOT_VERSION) Help
+[FILES]
+contents.htm
+docs.css
+Keywords
+TclCmd
+TclLib
+TkCmd
+TkLib
+UserCmd
+<<
+
+chmsetup:
+ @if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR)
+
+#-------------------------------------------------------------------------
+# Build the old-style Windows .hlp file
+#-------------------------------------------------------------------------
+
TCLHLPBASE = $(PROJECT)$(VERSION)
HELPFILE = $(OUT_DIR)\$(TCLHLPBASE).hlp
HELPCNT = $(OUT_DIR)\$(TCLHLPBASE).cnt
@@ -702,11 +810,17 @@ $(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\*
$(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/)
install-docs:
-!if exist($(HELPFILE))
+!if exist("$(CHMFILE)")
+ @echo Installing compiled HTML help
+ @$(CPY) "$(CHMFILE)" "$(DOC_INSTALL_DIR)\"
+!endif
+!if exist("$(HELPFILE)")
+ @echo Installing Windows help
@$(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
@$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
!endif
+#"
#---------------------------------------------------------------------
# Build tclConfig.sh for the TEA build system.
#---------------------------------------------------------------------
@@ -733,8 +847,8 @@ $(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
@LIBS@ $(baselibs)
@prefix@ $(_INSTALLDIR)
@exec_prefix@ $(BIN_INSTALL_DIR)
-@SHLIB_CFLAGS@
-@STLIB_CFLAGS@
+@SHLIB_CFLAGS@
+@STLIB_CFLAGS@
@CFLAGS_WARNING@ -W3
@EXTRA_CFLAGS@ -YX
@SHLIB_LD@ $(link32) $(dlllflags)
@@ -752,7 +866,7 @@ $(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
@TCL_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR)
@TCL_LIB_VERSIONS_OK@
@TCL_SRC_DIR@ $(ROOT)
-@TCL_PACKAGE_PATH@
+@TCL_PACKAGE_PATH@
@TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_FLAG@ $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_SPEC@ -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)
@@ -772,7 +886,7 @@ $(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
#---------------------------------------------------------------------
-# The following target generates the file generic/tclDate.c
+# The following target generates the file generic/tclDate.c
# from the yacc grammar found in generic/tclGetDate.y. This is
# only run by hand as yacc is not available in all environments.
# The name of the .c file is different than the name of the .y file
@@ -793,6 +907,10 @@ $(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$@ $?
@@ -802,6 +920,9 @@ $(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:\=\\)\"" \
@@ -847,6 +968,12 @@ $(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$@ $?
+
#---------------------------------------------------------------------
# Generate the source dependencies. Having dependency rules will
# improve incremental build accuracy without having to resort to a
@@ -882,7 +1009,9 @@ $(TCLOBJS)
#---------------------------------------------------------------------
-# Implicit rules
+# Implicit rules. A limitation exists with nmake that requires that
+# source directory can not contain spaces in the path. This an
+# absolute.
#---------------------------------------------------------------------
{$(WINDIR)}.c{$(TMP_DIR)}.obj::
@@ -905,6 +1034,11 @@ $<
$<
<<
+{$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
{$(WINDIR)}.rc{$(TMP_DIR)}.res:
$(rc32) -fo $@ -r -i "$(GENERICDIR)" \
-d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
@@ -931,10 +1065,6 @@ 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)\"
@@ -955,9 +1085,13 @@ 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)\"
@@ -975,6 +1109,7 @@ 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\"
@@ -983,7 +1118,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.4\http-$(PKG_HTTP_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\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"
@@ -1054,7 +1189,7 @@ tidy:
@echo Removing $(TCLREGLIB) ...
@if exist $(TCLREGLIB) del $(TCLREGLIB)
-clean:
+clean: clean-pkgs
@echo Cleaning $(TMP_DIR)\* ...
@if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
@echo Cleaning $(WINDIR)\nmakehlp.obj ...
@@ -1070,6 +1205,8 @@ clean:
@echo Cleaning $(WINDIR)\versions.vc ...
@if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
+realclean: hose
+
hose:
@echo Hosing $(OUT_DIR)\* ...
@if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index f1b5f34..b5e0788 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -20,10 +20,10 @@
#include <math.h>
/*
- * This library is required for x64 builds with _some_ versions
+ * This library is required for x64 builds with _some_ versions of MSVC
*/
#if defined(_M_IA64) || defined(_M_AMD64)
-#if _MSC_FULL_VER > 140000000 && _MSC_FULL_VER <= 140040310
+#if _MSC_VER >= 1400 && _MSC_VER < 1500
#pragma comment(lib, "bufferoverflowU")
#endif
#endif
@@ -40,7 +40,6 @@
int CheckForCompilerFeature(const char *option);
int CheckForLinkerFeature(const char *option);
int IsIn(const char *string, const char *substring);
-int GrepForDefine(const char *file, const char *string);
int SubstituteFile(const char *substs, const char *filename);
const char * GetVersionFromFile(const char *filename, const char *match);
DWORD WINAPI ReadFromPipe(LPVOID args);
@@ -125,18 +124,6 @@ main(
} else {
return IsIn(argv[2], argv[3]);
}
- case 'g':
- if (argc == 2) {
- chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -g <file> <string>\n"
- "grep for a #define\n"
- "exitcodes: integer of the found string (no decimals)\n",
- argv[0]);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
- &dwWritten, NULL);
- return 2;
- }
- return GrepForDefine(argv[2], argv[3]);
case 's':
if (argc == 2) {
chars = snprintf(msg, sizeof(msg) - 1,
@@ -466,63 +453,6 @@ IsIn(
}
/*
- * Find a specified #define by name.
- *
- * If the line is '#define TCL_VERSION "8.5"', it returns 85 as the result.
- */
-
-int
-GrepForDefine(
- const char *file,
- const char *string)
-{
- char s1[51], s2[51], s3[51];
- FILE *f = fopen(file, "rt");
-
- if (f == NULL) {
- return 0;
- }
-
- do {
- int r = fscanf(f, "%50s", s1);
-
- if (r == 1 && !strcmp(s1, "#define")) {
- /*
- * Get next two words.
- */
-
- r = fscanf(f, "%50s %50s", s2, s3);
- if (r != 2) {
- continue;
- }
-
- /*
- * Is the first word what we're looking for?
- */
-
- if (!strcmp(s2, string)) {
- double d1;
-
- fclose(f);
-
- /*
- * Add 1 past first double quote char. "8.5"
- */
-
- d1 = atof(s3 + 1); /* 8.5 */
- while (floor(d1) != d1) {
- d1 *= 10.0;
- }
- return ((int) d1); /* 85 */
- }
- }
- } while (!feof(f));
-
- fclose(f);
- return 0;
-}
-
-/*
* GetVersionFromFile --
* Looks for a match string in a file and then returns the version
* following the match where a version is anything acceptable to
diff --git a/win/rules.vc b/win/rules.vc
index e18dca9..01e44e0 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -6,7 +6,7 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
+#
# Copyright (c) 2001-2003 David Gravereaux.
# Copyright (c) 2003-2007 Patrick Thoyts
#------------------------------------------------------------------------------
@@ -159,7 +159,7 @@ DEBUGFLAGS = $(DEBUGFLAGS) -RTC1
DEBUGFLAGS = $(DEBUGFLAGS) -GZ
!endif
-COMPILERFLAGS =-W3
+COMPILERFLAGS =-W3 -DUNICODE -D_UNICODE
# In v13 -GL and -YX are incompatible.
!if [nmakehlp -c -YX]
@@ -213,14 +213,15 @@ LINKERFLAGS =-ltcg
!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
STATIC_BUILD = 0
-TCL_THREADS = 0
+TCL_THREADS = 1
DEBUG = 0
SYMBOLS = 0
PROFILE = 0
+PGO = 0
MSVCRT = 0
LOIMPACT = 0
TCL_USE_STATIC_PACKAGES = 0
-USE_THREAD_ALLOC = 0
+USE_THREAD_ALLOC = 1
UNCHECKED = 0
!else
!if [nmakehlp -f $(OPTS) "static"]
@@ -241,11 +242,12 @@ TCL_USE_STATIC_PACKAGES = 1
!else
TCL_USE_STATIC_PACKAGES = 0
!endif
-!if [nmakehlp -f $(OPTS) "threads"]
+!if [nmakehlp -f $(OPTS) "nothreads"]
+TCL_THREADS = 0
+!else
!message *** Doing threads
TCL_THREADS = 1
-!else
-TCL_THREADS = 0
+USE_THREAD_ALLOC= 1
!endif
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols
@@ -265,6 +267,15 @@ PROFILE = 1
!else
PROFILE = 0
!endif
+!if [nmakehlp -f $(OPTS) "pgi"]
+!message *** Doing profile guided optimization instrumentation
+PGO = 1
+!elseif [nmakehlp -f $(OPTS) "pgo"]
+!message *** Doing profile guided optimization
+PGO = 2
+!else
+PGO = 0
+!endif
!if [nmakehlp -f $(OPTS) "loimpact"]
!message *** Doing loimpact
LOIMPACT = 1
@@ -274,7 +285,9 @@ LOIMPACT = 0
!if [nmakehlp -f $(OPTS) "thrdalloc"]
!message *** Doing thrdalloc
USE_THREAD_ALLOC = 1
-!else
+!endif
+!if [nmakehlp -f $(OPTS) "tclalloc"]
+!message *** Doing thrdalloc
USE_THREAD_ALLOC = 0
!endif
!if [nmakehlp -f $(OPTS) "unchecked"]
@@ -417,6 +430,24 @@ WARNINGS = $(WARNINGS) -Wp64
!endif
!endif
+!if $(PGO) > 1
+!if [nmakehlp -l -ltcg:pgoptimize]
+LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize
+!else
+MSG=^
+This compiler does not support profile guided optimization.
+!error $(MSG)
+!endif
+!elseif $(PGO) > 0
+!if [nmakehlp -l -ltcg:pginstrument]
+LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument
+!else
+MSG=^
+This compiler does not support profile guided optimization.
+!error $(MSG)
+!endif
+!endif
+
#----------------------------------------------------------
# Set our defines now armed with our options.
#----------------------------------------------------------
@@ -563,7 +594,7 @@ 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\tclreg12$(SUFX:t=).lib"
+TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(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
@@ -576,7 +607,7 @@ 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)\tclreg12$(SUFX:t=).lib"
+TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib"
TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
COFFBASE = "$(_TCLDIR)\win\coffbase.txt"
TCLTOOLSDIR = $(_TCLDIR)\tools
diff --git a/win/stub16.c b/win/stub16.c
deleted file mode 100644
index 70fc051..0000000
--- a/win/stub16.c
+++ /dev/null
@@ -1,195 +0,0 @@
-/*
- * 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 b3de0ff..57ec6bf 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -1300,6 +1300,14 @@ 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
@@ -1452,10 +1460,6 @@ 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
@@ -1556,10 +1560,6 @@ 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 0d01f35..3bdccbe 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=tcl85.cnt
+CNT=tcl86.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
-HLP=tcl85.hlp
+HLP=tcl86.hlp
[FILES]
tcl.rtf
diff --git a/win/tcl.m4 b/win/tcl.m4
index 83a4ea3..e57788e 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -20,15 +20,15 @@
AC_DEFUN([SC_PATH_TCLCONFIG], [
AC_MSG_CHECKING([the location of tclConfig.sh])
- if test -d ../../tcl8.5$1/win; then
- TCL_BIN_DIR_DEFAULT=../../tcl8.5$1/win
- elif test -d ../../tcl8.5/win; then
- TCL_BIN_DIR_DEFAULT=../../tcl8.5/win
+ if test -d ../../tcl8.6$1/win; then
+ TCL_BIN_DIR_DEFAULT=../../tcl8.6$1/win
+ elif test -d ../../tcl8.6/win; then
+ TCL_BIN_DIR_DEFAULT=../../tcl8.6/win
else
TCL_BIN_DIR_DEFAULT=../../tcl/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 binaries from DIR],
TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
@@ -60,15 +60,15 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [
AC_DEFUN([SC_PATH_TKCONFIG], [
AC_MSG_CHECKING([the location of tkConfig.sh])
- if test -d ../../tk8.5$1/win; then
- TK_BIN_DIR_DEFAULT=../../tk8.5$1/win
- elif test -d ../../tk8.5/win; then
- TK_BIN_DIR_DEFAULT=../../tk8.5/win
+ if test -d ../../tk8.6$1/win; then
+ TK_BIN_DIR_DEFAULT=../../tk8.6$1/win
+ elif test -d ../../tk8.6/win; then
+ TK_BIN_DIR_DEFAULT=../../tk8.6/win
else
TK_BIN_DIR_DEFAULT=../../tk/win
fi
- AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.5 binaries from DIR],
+ AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.6 binaries from DIR],
TK_BIN_DIR=$withval, TK_BIN_DIR=`cd $TK_BIN_DIR_DEFAULT; pwd`)
if test ! -d $TK_BIN_DIR; then
AC_MSG_ERROR(Tk directory $TK_BIN_DIR does not exist)
@@ -248,7 +248,7 @@ 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],
- [tcl_ok=$enableval], [tcl_ok=no])
+ [tcl_ok=$enableval], [tcl_ok=yes])
if test "$tcl_ok" = "yes"; then
AC_MSG_RESULT(yes)
@@ -259,7 +259,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [
AC_DEFINE(USE_THREAD_ALLOC)
else
TCL_THREADS=0
- AC_MSG_RESULT([no (default)])
+ AC_MSG_RESULT(no)
fi
AC_SUBST(TCL_THREADS)
])
@@ -402,6 +402,7 @@ 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 -w, echo)
@@ -436,6 +437,22 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
cyg_conftest=
fi
+ AC_CACHE_CHECK(for Cygwin version of gcc,
+ ac_cv_cygwin,
+ AC_TRY_COMPILE([
+ #ifdef __CYGWIN__
+ #error cygwin
+ #endif
+ ],
+ [],
+ ac_cv_cygwin=no,
+ ac_cv_cygwin=yes)
+ )
+ if test "$ac_cv_cygwin" = "yes" ; then
+ AC_MSG_WARN([Compiling under Cygwin is not currently supported.
+If you are not sure you want this, see the README
+file for information about building with Mingw.])
+ fi
if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
DEPARG='"$<"'
else
@@ -447,8 +464,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AC_MSG_CHECKING([compiler flags])
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
- SHLIB_LD_LIBS=""
- LIBS="-lws2_32"
+ SHLIB_LD_LIBS='${LIBS}'
+ LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -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'
@@ -480,13 +497,28 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
rm -f ac$$.o ac$$.c
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
+
if test "${SHARED_BUILD}" = "0" ; then
# 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
@@ -500,30 +532,30 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
runtime=
- # Link with gcc since ld does not link to default libs like
- # -luser32 and -lmsvcrt by default. Make sure CFLAGS is
- # included so -mno-cygwin passed the correct libs to the linker.
- SHLIB_LD='${CC} -shared ${CFLAGS}'
- 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. Make sure CFLAGS is
+ # included so -mno-cygwin passed the correct libs to the linker.
+ SHLIB_LD='${CC} -shared ${CFLAGS}'
+ 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"
+ CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
@@ -578,27 +610,22 @@ 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.
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
- LIBSUFFIX="\${DBGX}.lib"
- LIBFLAGSUFFIX="\${DBGX}"
- EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
- SHLIB_LD_LIBS='${LIBS}'
+ EXESUFFIX="\${DBGX}.exe"
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.
@@ -628,7 +655,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
fi
- LIBS="user32.lib advapi32.lib ws2_32.lib"
+ LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib"
if test "$do64bit" != "no" ; then
# The space-based-path will work for the Makefile, but will
# not work if AC_TRY_COMPILE is called. TEA has the
@@ -753,6 +780,7 @@ 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
@@ -817,13 +845,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
#------------------------------------------------------------------------
AC_DEFUN([SC_WITH_TCL], [
- if test -d ../../tcl8.5$1/win; then
- TCL_BIN_DEFAULT=../../tcl8.5$1/win
+ if test -d ../../tcl8.6$1/win; then
+ TCL_BIN_DEFAULT=../../tcl8.6$1/win
else
- TCL_BIN_DEFAULT=../../tcl8.5/win
+ TCL_BIN_DEFAULT=../../tcl8.6/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 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 289a3c3..d6da500 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -2,30 +2,60 @@
* tclAppInit.c --
*
* Provides a default version of the main program and Tcl_AppInit
- * function for Tcl applications (without Tk). Note that this program
- * must be built in Win32 console mode to work properly.
+ * procedure for tclsh and other Tcl-based applications (without Tk).
+ * Note that this program must be built in Win32 console mode to work properly.
*
- * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 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
#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
#include <locale.h>
+#include <stdlib.h>
+#include <tchar.h>
#ifdef TCL_TEST
-extern Tcl_PackageInitProc Procbodytest_Init;
-extern Tcl_PackageInitProc Procbodytest_SafeInit;
-extern Tcl_PackageInitProc Tcltest_Init;
-extern Tcl_PackageInitProc TclObjTest_Init;
+extern Tcl_PackageInitProc Tcltest_Init;
+extern Tcl_PackageInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */
-#if defined(__GNUC__)
-static void setargv(int *argcPtr, char ***argvPtr);
-#endif /* __GNUC__ */
+#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
+static void setargv(int *argcPtr, TCHAR ***argvPtr);
+#endif
+
+/*
+ * 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
+extern int TCL_LOCAL_APPINIT(Tcl_Interp *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
+extern int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
+#endif
/*
*----------------------------------------------------------------------
@@ -35,61 +65,53 @@ static void setargv(int *argcPtr, char ***argvPtr);
* This is the main program for the application.
*
* Results:
- * None: Tcl_Main never returns here, so this function never returns
+ * None: Tcl_Main never returns here, so this procedure never returns
* either.
*
* Side effects:
- * Whatever the application does.
+ * Just about anything, since from here we call arbitrary Tcl code.
*
*----------------------------------------------------------------------
*/
+#ifdef TCL_BROKEN_MAINARGS
int
main(
int argc,
- char *argv[])
+ char *dummy[])
+{
+ TCHAR **argv;
+#else
+int
+_tmain(
+ int argc,
+ TCHAR *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
- extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
+ TCHAR *p;
/*
- * 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()
+ * Set up the default locale to be standard "C" locale so parsing is
+ * performed correctly.
*/
-#ifdef TCL_LOCAL_MAIN_HOOK
- extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
-#endif
-
- char *p;
+ setlocale(LC_ALL, "C");
+#ifdef TCL_BROKEN_MAINARGS
/*
- * Set up the default locale to be standard "C" locale so parsing is
- * performed correctly.
+ * Get our args from the c-runtime. Ignore lpszCmdLine.
*/
-#if defined(__GNUC__)
- setargv( &argc, &argv );
+ setargv(&argc, &argv);
#endif
- setlocale(LC_ALL, "C");
/*
* Forward slashes substituted for backslashes.
*/
- for (p = argv[0]; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
+ for (p = argv[0]; *p != TEXT('\0'); p++) {
+ if (*p == TEXT('\\')) {
+ *p = TEXT('/');
}
}
@@ -98,7 +120,6 @@ main(
#endif
Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
-
return 0; /* Needed only to prevent compiler warning. */
}
@@ -107,9 +128,9 @@ main(
*
* Tcl_AppInit --
*
- * This function performs application-specific initialization. Most
+ * This procedure performs application-specific initialization. Most
* applications, especially those that incorporate additional packages,
- * will have their own version of this function.
+ * will have their own version of this procedure.
*
* Results:
* Returns a standard Tcl completion code, and leaves an error message in
@@ -125,67 +146,54 @@ int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
- if (Tcl_Init(interp) == TCL_ERROR) {
+ if ((Tcl_Init)(interp) == TCL_ERROR) {
return TCL_ERROR;
}
-#ifdef TCL_TEST
- if (Tcltest_Init(interp) == TCL_ERROR) {
+#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
+ if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL);
- if (TclObjTest_Init(interp) == TCL_ERROR) {
+ Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
+
+ if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- if (Procbodytest_Init(interp) == TCL_ERROR) {
+ Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
+#endif
+
+#ifdef TCL_TEST
+ if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
- Procbodytest_SafeInit);
+ Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_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 functions for included packages. Each call should look
+ * Call the init procedures 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.
+ * where "Mod" is the name of the module. (Dynamically-loadable packages
+ * should have the same entry-point name.)
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if they
- * weren't already created by the init functions called above.
+ * weren't already created by the init procedures called above.
*/
/*
* Specify a user-specific startup file to invoke if the application is
* run interactively. Typically the startup file is "~/.apprc" where "app"
- * is the name of the application. If this line is deleted then no
- * user-specific startup file will be run under any conditions.
+ * is the name of the application. If this line is deleted then no user-
+ * specific startup file will be run under any conditions.
*/
- Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
+ (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
return TCL_OK;
}
@@ -216,17 +224,17 @@ Tcl_AppInit(
*--------------------------------------------------------------------------
*/
-#if defined(__GNUC__)
+#ifdef TCL_BROKEN_MAINARGS
static void
setargv(
int *argcPtr, /* Filled with number of argument strings. */
- char ***argvPtr) /* Filled with argument strings (malloc'd). */
+ TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */
{
- char *cmdLine, *p, *arg, *argSpace;
- char **argv;
+ TCHAR *cmdLine, *p, *arg, *argSpace;
+ TCHAR **argv;
int argc, size, inquote, copy, slashes;
- cmdLine = GetCommandLine(); /* INTL: BUG */
+ cmdLine = GetCommandLine();
/*
* Precompute an overly pessimistic guess at the number of arguments in
@@ -234,30 +242,35 @@ setargv(
*/
size = 2;
- for (p = cmdLine; *p != '\0'; p++) {
- if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ for (p = cmdLine; *p != TEXT('\0'); p++) {
+ if ((*p == TEXT(' ')) || (*p == TEXT('\t'))) { /* INTL: ISO space. */
size++;
- while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ while ((*p == TEXT(' ')) || (*p == TEXT('\t'))) { /* INTL: ISO space. */
p++;
}
- if (*p == '\0') {
+ if (*p == TEXT('\0')) {
break;
}
}
}
- argSpace = (char *) ckalloc(
- (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
- argv = (char **) argSpace;
- argSpace += size * sizeof(char *);
+
+ /* 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));
size--;
p = cmdLine;
for (argc = 0; argc < size; argc++) {
argv[argc] = arg = argSpace;
- while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+ while ((*p == TEXT(' ')) || (*p == TEXT('\t'))) { /* INTL: ISO space. */
p++;
}
- if (*p == '\0') {
+ if (*p == TEXT('\0')) {
break;
}
@@ -265,14 +278,14 @@ setargv(
slashes = 0;
while (1) {
copy = 1;
- while (*p == '\\') {
+ while (*p == TEXT('\\')) {
slashes++;
p++;
}
- if (*p == '"') {
+ if (*p == TEXT('"')) {
if ((slashes & 1) == 0) {
copy = 0;
- if ((inquote) && (p[1] == '"')) {
+ if ((inquote) && (p[1] == TEXT('"'))) {
p++;
copy = 1;
} else {
@@ -283,13 +296,13 @@ setargv(
}
while (slashes) {
- *arg = '\\';
+ *arg = TEXT('\\');
arg++;
slashes--;
}
- if ((*p == '\0') || (!inquote &&
- ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
+ if ((*p == TEXT('\0')) || (!inquote &&
+ ((*p == TEXT(' ')) || (*p == TEXT('\t'))))) { /* INTL: ISO space. */
break;
}
if (copy != 0) {
@@ -306,7 +319,7 @@ setargv(
*argcPtr = argc;
*argvPtr = argv;
}
-#endif /* __GNUC__ */
+#endif /* TCL_BROKEN_MAINARGS */
/*
* Local Variables:
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 6c863b9..019d76f 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -12,30 +12,9 @@
*/
#include "tclWinInt.h"
-
-#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);
+#if defined(HAVE_INTRIN_H)
+# include <intrin.h>
+#endif
/*
* The following variables keep track of information about this DLL on a
@@ -71,150 +50,14 @@ typedef struct EXCEPTION_REGISTRATION {
#define cpuid __asm __emit 0fh __asm __emit 0a2h
#endif
-/*
- * 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,
+static Tcl_Encoding winTCharEncoding = NULL;
- /*
- * 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
@@ -223,8 +66,8 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
*/
typedef struct MountPointMap {
- CONST WCHAR *volumeName; /* Native wide string volume name. */
- char driveLetter; /* Drive letter corresponding to the volume
+ const TCHAR *volumeName; /* Native wide string volume name. */
+ TCHAR driveLetter; /* Drive letter corresponding to the volume
* name. */
struct MountPointMap *nextPtr;
/* Pointer to next structure in list, or
@@ -243,8 +86,6 @@ TCL_DECLARE_MUTEX(mountPointMap)
* We will need this below.
*/
-extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
-
#ifdef __WIN32__
#ifndef STATIC_BUILD
@@ -287,10 +128,7 @@ DllEntryPoint(
* TRUE on sucess, FALSE on failure.
*
* Side effects:
- * 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."
+ * Initializes most rudimentary Windows bits.
*
*----------------------------------------------------------------------
*/
@@ -301,105 +139,16 @@ DllMain(
DWORD reason, /* Reason this function is being called. */
LPVOID reserved) /* Not used. */
{
-#if defined(HAVE_NO_SEH) && !defined(_WIN64)
- EXCEPTION_REGISTRATION registration;
-#endif
-
switch (reason) {
case DLL_PROCESS_ATTACH:
DisableThreadLibraryCalls(hInst);
TclWinInit(hInst);
return TRUE;
- case DLL_PROCESS_DETACH:
/*
- * 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.
+ * DLL_PROCESS_DETACH is unnecessary as the user should call
+ * Tcl_Finalize explicitly before unloading Tcl.
*/
-
-#if defined(HAVE_NO_SEH) && !defined(_WIN64)
- __asm__ __volatile__ (
-
- /*
- * Construct an EXCEPTION_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 EXCEPTION_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 EXCEPTION_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 EXCEPTION_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
- * EXCEPTION_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;
@@ -457,15 +206,18 @@ TclWinInit(
platformId = os.dwPlatformId;
/*
- * We no longer support Win32s, so just in case someone manages to get a
- * runtime there, make sure they know that.
+ * We no longer support Win32s or Win9x, 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");
+ }
- tclWinProcs = &asciiProcs;
+ TclWinResetInterfaces();
}
/*
@@ -478,9 +230,10 @@ 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.
- * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP
+ * 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
*
* Side effects:
* None.
@@ -526,83 +279,6 @@ 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
-
-
-/*
*---------------------------------------------------------------------------
*
* TclWinSetInterfaces --
@@ -630,107 +306,17 @@ TclWinSetInterfaces(
int wide) /* Non-zero to use wide interfaces, 0
* otherwise. */
{
- Tcl_FreeEncoding(tclWinTCharEncoding);
+ TclWinResetInterfaces();
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);
- }
- }
+ winTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
}
}
/*
*---------------------------------------------------------------------------
*
- * TclWinResetInterfaceEncodings --
+ * TclWinEncodingsCleanup --
*
* Called during finalization to free up any encodings we use. The
* tclWinProcs-> look up table is still ok to use after this call,
@@ -750,13 +336,11 @@ TclWinSetInterfaces(
*/
void
-TclWinResetInterfaceEncodings(void)
+TclWinEncodingsCleanup(void)
{
MountPointMap *dlIter, *dlIter2;
- if (tclWinTCharEncoding != NULL) {
- Tcl_FreeEncoding(tclWinTCharEncoding);
- tclWinTCharEncoding = NULL;
- }
+
+ TclWinResetInterfaces();
/*
* Clean up the mount point map.
@@ -766,8 +350,8 @@ TclWinResetInterfaceEncodings(void)
dlIter = driveLetterLookup;
while (dlIter != NULL) {
dlIter2 = dlIter->nextPtr;
- ckfree((char*)dlIter->volumeName);
- ckfree((char*)dlIter);
+ ckfree(dlIter->volumeName);
+ ckfree(dlIter);
dlIter = dlIter2;
}
Tcl_MutexUnlock(&mountPointMap);
@@ -793,7 +377,10 @@ TclWinResetInterfaceEncodings(void)
void
TclWinResetInterfaces(void)
{
- tclWinProcs = &asciiProcs;
+ if (winTCharEncoding != NULL) {
+ Tcl_FreeEncoding(winTCharEncoding);
+ winTCharEncoding = NULL;
+ }
}
/*
@@ -820,11 +407,11 @@ TclWinResetInterfaces(void)
char
TclWinDriveLetterForVolMountPoint(
- CONST WCHAR *mountPoint)
+ const TCHAR *mountPoint)
{
MountPointMap *dlIter, *dlPtr2;
- WCHAR Target[55]; /* Target of mount at mount point */
- WCHAR drive[4] = { L'A', L':', L'\\', L'\0' };
+ TCHAR Target[55]; /* Target of mount at mount point */
+ TCHAR drive[4] = TEXT("A:\\");
/*
* Detect the volume mounted there. Unfortunately, there is no simple way
@@ -835,28 +422,28 @@ TclWinDriveLetterForVolMountPoint(
Tcl_MutexLock(&mountPointMap);
dlIter = driveLetterLookup;
while (dlIter != NULL) {
- if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
+ if (_tcscmp(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] = L'A' + (dlIter->driveLetter - 'A');
+ drive[0] = (TCHAR) dlIter->driveLetter;
/*
* Try to read the volume mount point and see where it points.
*/
- if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
- (TCHAR*)Target, 55) != 0) {
- if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
+ if (GetVolumeNameForVolumeMountPoint(drive,
+ Target, 55) != 0) {
+ if (_tcscmp(dlIter->volumeName, Target) == 0) {
/*
* Nothing has changed.
*/
Tcl_MutexUnlock(&mountPointMap);
- return dlIter->driveLetter;
+ return (char) dlIter->driveLetter;
}
}
@@ -883,8 +470,8 @@ TclWinDriveLetterForVolMountPoint(
* Now dlPtr2 points to the structure to free.
*/
- ckfree((char*)dlPtr2->volumeName);
- ckfree((char*)dlPtr2);
+ ckfree(dlPtr2->volumeName);
+ ckfree(dlPtr2);
/*
* Restart the loop - we could try to be clever and continue half
@@ -907,23 +494,23 @@ TclWinDriveLetterForVolMountPoint(
* Try to read the volume mount point and see where it points.
*/
- if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
- (TCHAR*)Target, 55) != 0) {
+ if (GetVolumeNameForVolumeMountPoint(drive,
+ Target, 55) != 0) {
int alreadyStored = 0;
for (dlIter = driveLetterLookup; dlIter != NULL;
dlIter = dlIter->nextPtr) {
- if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
+ if (_tcscmp(dlIter->volumeName, Target) == 0) {
alreadyStored = 1;
break;
}
}
if (!alreadyStored) {
- dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap));
+ dlPtr2 = ckalloc(sizeof(MountPointMap));
dlPtr2->volumeName = TclNativeDupInternalRep(Target);
- dlPtr2->driveLetter = 'A' + (drive[0] - L'A');
+ dlPtr2->driveLetter = (char) drive[0];
dlPtr2->nextPtr = driveLetterLookup;
- driveLetterLookup = dlPtr2;
+ driveLetterLookup = dlPtr2;
}
}
}
@@ -934,9 +521,9 @@ TclWinDriveLetterForVolMountPoint(
for (dlIter = driveLetterLookup; dlIter != NULL;
dlIter = dlIter->nextPtr) {
- if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
+ if (_tcscmp(dlIter->volumeName, mountPoint) == 0) {
Tcl_MutexUnlock(&mountPointMap);
- return dlIter->driveLetter;
+ return (char) dlIter->driveLetter;
}
}
@@ -945,11 +532,11 @@ TclWinDriveLetterForVolMountPoint(
* that fact and store '-1' so we don't have to look it up each time.
*/
- dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
- dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint);
+ dlPtr2 = ckalloc(sizeof(MountPointMap));
+ dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint);
dlPtr2->driveLetter = -1;
dlPtr2->nextPtr = driveLetterLookup;
- driveLetterLookup = dlPtr2;
+ driveLetterLookup = dlPtr2;
Tcl_MutexUnlock(&mountPointMap);
return -1;
}
@@ -1006,27 +593,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(tclWinTCharEncoding,
+ return (TCHAR *) Tcl_UtfToExternalDString(winTCharEncoding,
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(tclWinTCharEncoding,
- (CONST char *) string, len, dsPtr);
+ return Tcl_ExternalToUtfDString(winTCharEncoding,
+ (const char *) string, len, dsPtr);
}
/*
@@ -1054,11 +641,16 @@ TclWinCPUID(
{
int status = TCL_ERROR;
-#if defined(__GNUC__)
+#if defined(HAVE_INTRIN_H) && defined(_WIN64)
+
+ __cpuid(regsPtr, index);
+ status = TCL_OK;
+
+#elif defined(__GNUC__)
# if defined(_WIN64)
/*
* Execute the CPUID instruction with the given index, and store results
- * off 'regsPtr'.
+ * off 'regPtr'.
*/
__asm__ __volatile__(
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 0f17834..517aa20 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 DWORD FileGetType(HANDLE handle);
* This structure describes the channel type structure for file based IO.
*/
-static Tcl_ChannelType fileChannelType = {
+static const Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
FileCloseProc, /* Close proc. */
@@ -117,7 +117,7 @@ static Tcl_ChannelType fileChannelType = {
NULL, /* handler proc. */
FileWideSeekProc, /* Wide seek proc. */
FileThreadActionProc, /* Thread action proc. */
- FileTruncateProc, /* Truncate proc. */
+ FileTruncateProc /* Truncate proc. */
};
#ifdef HAVE_NO_SEH
@@ -128,11 +128,11 @@ static Tcl_ChannelType fileChannelType = {
*/
typedef struct EXCEPTION_REGISTRATION {
- struct EXCEPTION_REGISTRATION* link;
+ struct EXCEPTION_REGISTRATION *link;
EXCEPTION_DISPOSITION (*handler)(
struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
- void* ebp;
- void* esp;
+ void *ebp;
+ void *esp;
int status;
} EXCEPTION_REGISTRATION;
#endif
@@ -274,7 +274,7 @@ FileCheckProc(
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
infoPtr->flags |= FILE_PENDING;
- evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
+ evPtr = ckalloc(sizeof(FileEvent));
evPtr->header.proc = FileEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -357,7 +357,7 @@ FileBlockProc(
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- FileInfo *infoPtr = (FileInfo *) instanceData;
+ FileInfo *infoPtr = instanceData;
/*
* Files on Windows can not be switched between blocking and nonblocking,
@@ -395,7 +395,7 @@ FileCloseProc(
ClientData instanceData, /* Pointer to FileInfo structure. */
Tcl_Interp *interp) /* Not used. */
{
- FileInfo *fileInfoPtr = (FileInfo *) instanceData;
+ FileInfo *fileInfoPtr = instanceData;
FileInfo *infoPtr;
ThreadSpecificData *tsdPtr;
int errorCode = 0;
@@ -441,7 +441,7 @@ FileCloseProc(
break;
}
}
- ckfree((char *)fileInfoPtr);
+ ckfree(fileInfoPtr);
return errorCode;
}
@@ -470,7 +470,7 @@ FileSeekProc(
int mode, /* Relative to where should we seek? */
int *errorCodePtr) /* To store error code. */
{
- FileInfo *infoPtr = (FileInfo *) instanceData;
+ FileInfo *infoPtr = instanceData;
LONG newPos, newPosHigh, oldPos, oldPosHigh;
DWORD moveMethod;
@@ -548,7 +548,7 @@ FileWideSeekProc(
int mode, /* Relative to where should we seek? */
int *errorCodePtr) /* To store error code. */
{
- FileInfo *infoPtr = (FileInfo *) instanceData;
+ FileInfo *infoPtr = instanceData;
DWORD moveMethod;
LONG newPos, newPosHigh;
@@ -597,7 +597,7 @@ FileTruncateProc(
ClientData instanceData, /* File state. */
Tcl_WideInt length) /* Length to truncate at. */
{
- FileInfo *infoPtr = (FileInfo *) instanceData;
+ FileInfo *infoPtr = instanceData;
LONG newPos, newPosHigh, oldPos, oldPosHigh;
/*
@@ -673,11 +673,10 @@ FileInputProc(
int bufSize, /* Num bytes available in buffer. */
int *errorCode) /* Where to store error code. */
{
- FileInfo *infoPtr;
+ FileInfo *infoPtr = instanceData;
DWORD bytesRead;
*errorCode = 0;
- infoPtr = (FileInfo *) instanceData;
/*
* Note that we will block on reads from a console buffer until a full
@@ -721,11 +720,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 = (FileInfo *) instanceData;
+ FileInfo *infoPtr = instanceData;
DWORD bytesWritten;
*errorCode = 0;
@@ -772,7 +771,7 @@ FileWatchProc(
* of TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION. */
{
- FileInfo *infoPtr = (FileInfo *) instanceData;
+ FileInfo *infoPtr = instanceData;
Tcl_Time blockTime = { 0, 0 };
/*
@@ -810,7 +809,7 @@ FileGetHandleProc(
int direction, /* TCL_READABLE or TCL_WRITABLE */
ClientData *handlePtr) /* Where to store the handle. */
{
- FileInfo *infoPtr = (FileInfo *) instanceData;
+ FileInfo *infoPtr = instanceData;
if (direction & infoPtr->validMask) {
*handlePtr = (ClientData) infoPtr->handle;
@@ -850,12 +849,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 = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
+ nativeName = Tcl_FSGetNativePath(pathPtr);
if (nativeName == NULL) {
return NULL;
}
@@ -914,7 +913,7 @@ TclpOpenFileChannel(
flags = FILE_ATTRIBUTE_READONLY;
}
} else {
- flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ flags = GetFileAttributes(nativeName);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
@@ -930,8 +929,8 @@ TclpOpenFileChannel(
* Now we get to create the file.
*/
- handle = (*tclWinProcs->createFileProc)(nativeName, accessMode,
- shareMode, NULL, createMode, flags, (HANDLE) NULL);
+ handle = CreateFile(nativeName, accessMode, shareMode,
+ NULL, createMode, flags, (HANDLE) NULL);
if (handle == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
@@ -998,6 +997,8 @@ TclpOpenFileChannel(
channel = NULL;
Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
"\": bad file type", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE",
+ NULL);
break;
}
@@ -1223,8 +1224,8 @@ TclpGetDefaultStdChannel(
Tcl_Channel channel;
HANDLE handle;
int mode = -1;
- char *bufMode = NULL;
- DWORD handleId = (DWORD)-1;
+ const char *bufMode = NULL;
+ DWORD handleId = (DWORD) -1;
/* Standard handle to retrieve. */
switch (type) {
@@ -1323,7 +1324,7 @@ TclWinOpenFileChannel(
}
}
- infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
+ infoPtr = ckalloc(sizeof(FileInfo));
/*
* TIP #218. Removed the code inserting the new structure into the global
@@ -1337,10 +1338,10 @@ TclWinOpenFileChannel(
infoPtr->flags = appendMode;
infoPtr->handle = handle;
infoPtr->dirty = 0;
- wsprintfA(channelName, "file%lx", PTR2INT(infoPtr));
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
- (ClientData) infoPtr, permissions);
+ infoPtr, permissions);
/*
* Files have default translation of AUTO and ^Z eof char, which means
@@ -1414,7 +1415,7 @@ FileThreadActionProc(
int action)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- FileInfo *infoPtr = (FileInfo *) instanceData;
+ FileInfo *infoPtr = instanceData;
if (action == TCL_CHANNEL_THREAD_INSERT) {
infoPtr->nextPtr = tsdPtr->firstFilePtr;
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 8be8e09..5aab255 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -11,9 +11,6 @@
*/
#include "tclWinInt.h"
-
-#include <fcntl.h>
-#include <io.h>
#include <sys/stat.h>
/*
@@ -49,6 +46,23 @@ 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.
*/
@@ -67,24 +81,18 @@ typedef struct ConsoleInfo {
Tcl_ThreadId threadId; /* Thread to which events should be reported.
* This value is used by the reader/writer
* threads. */
- 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 */
+ 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. */
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
@@ -99,8 +107,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;
@@ -134,7 +142,8 @@ 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);
@@ -146,7 +155,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);
@@ -155,13 +164,22 @@ 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 Tcl_ChannelType consoleChannelType = {
+static const Tcl_ChannelType consoleChannelType = {
"console", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
ConsoleCloseProc, /* Close proc. */
@@ -173,23 +191,27 @@ static 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 */
+ ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */
+ NULL, /* Flush proc. */
+ NULL, /* Handler proc. */
+ NULL, /* Wide seek proc. */
+ ConsoleThreadActionProc, /* Thread action proc. */
+ NULL /* Truncation proc. */
};
/*
*----------------------------------------------------------------------
*
- * 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,
@@ -197,30 +219,32 @@ readConsoleBytes(
{
DWORD ntchars;
BOOL result;
- int tcharsize;
- tcharsize = tclWinProcs->useWide? 2 : 1;
- result = tclWinProcs->readConsoleProc(
- hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL);
- if (nbytesread)
- *nbytesread = (ntchars*tcharsize);
+ int tcharsize = sizeof(TCHAR);
+
+ result = ReadConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars,
+ NULL);
+ if (nbytesread != NULL) {
+ *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;
- tcharsize = tclWinProcs->useWide? 2 : 1;
- result = tclWinProcs->writeConsoleProc(
- hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL);
- if (nbyteswritten)
- *nbyteswritten = (ntchars*tcharsize);
+ int tcharsize = sizeof(TCHAR);
+
+ result = WriteConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars,
+ NULL);
+ if (nbyteswritten != NULL) {
+ *nbyteswritten = ntchars * tcharsize;
+ }
return result;
}
@@ -243,8 +267,6 @@ writeConsoleBytes(
static void
ConsoleInit(void)
{
- ThreadSpecificData *tsdPtr;
-
/*
* Check the initialized flag first, then check again in the mutex. This
* is a speed enhancement.
@@ -259,9 +281,9 @@ ConsoleInit(void)
Tcl_MutexUnlock(&consoleMutex);
}
- tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
- if (tsdPtr == NULL) {
- tsdPtr = TCL_TSD_INIT(&dataKey);
+ if (TclThreadDataKeyGet(&dataKey) == NULL) {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
tsdPtr->firstConsolePtr = NULL;
Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
@@ -287,7 +309,7 @@ ConsoleInit(void)
static void
ConsoleExitHandler(
- ClientData clientData) /* Old window proc */
+ ClientData clientData) /* Old window proc. */
{
Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
}
@@ -311,7 +333,7 @@ ConsoleExitHandler(
static void
ProcExitHandler(
- ClientData clientData) /* Old window proc */
+ ClientData clientData) /* Old window proc. */
{
Tcl_MutexLock(&consoleMutex);
initialized = 0;
@@ -356,7 +378,8 @@ ConsoleSetupProc(
for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->writer.readyEvent,
+ 0) != WAIT_TIMEOUT) {
block = 0;
}
}
@@ -394,7 +417,6 @@ ConsoleCheckProc(
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
ConsoleInfo *infoPtr;
- ConsoleEvent *evPtr;
int needEvent;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -419,7 +441,8 @@ ConsoleCheckProc(
needEvent = 0;
if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->writer.readyEvent,
+ 0) != WAIT_TIMEOUT) {
needEvent = 1;
}
}
@@ -431,8 +454,9 @@ 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);
@@ -440,7 +464,6 @@ ConsoleCheckProc(
}
}
-
/*
*----------------------------------------------------------------------
*
@@ -463,7 +486,7 @@ ConsoleBlockModeProc(
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
/*
* Consoles on Windows can not be switched between blocking and
@@ -476,7 +499,7 @@ ConsoleBlockModeProc(
if (mode == TCL_MODE_NONBLOCKING) {
infoPtr->flags |= CONSOLE_ASYNC;
} else {
- infoPtr->flags &= ~(CONSOLE_ASYNC);
+ infoPtr->flags &= ~CONSOLE_ASYNC;
}
return 0;
}
@@ -484,6 +507,84 @@ 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.
@@ -502,13 +603,10 @@ ConsoleCloseProc(
ClientData instanceData, /* Pointer to ConsoleInfo structure. */
Tcl_Interp *interp) /* For error reporting. */
{
- ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData;
- int errorCode;
+ ConsoleInfo *consolePtr = instanceData;
+ int errorCode = 0;
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
@@ -516,49 +614,8 @@ ConsoleCloseProc(
* trying to read from the console.
*/
- 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;
+ if (consolePtr->reader.thread) {
+ StopChannelThread(&consolePtr->reader);
}
consolePtr->validMask &= ~TCL_READABLE;
@@ -568,62 +625,20 @@ ConsoleCloseProc(
* should be no pending write operations.
*/
- if (consolePtr->writeThread) {
+ if (consolePtr->writer.thread) {
if (consolePtr->toWrite) {
/*
* We only need to wait if there is something to write. This may
- * 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.
+ * prevent infinite wait on exit. [Python Bug 216289]
*/
- SetEvent(consolePtr->stopWriter);
-
- /*
- * Wait at most 20 milliseconds for the writer thread to close.
- */
-
- 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);
- }
+ WaitForSingleObject(consolePtr->writer.readyEvent, INFINITE);
}
- CloseHandle(consolePtr->writeThread);
- CloseHandle(consolePtr->writable);
- CloseHandle(consolePtr->startWriter);
- CloseHandle(consolePtr->stopWriter);
- consolePtr->writeThread = NULL;
+ StopChannelThread(&consolePtr->writer);
}
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
@@ -649,7 +664,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;
}
@@ -658,7 +673,7 @@ ConsoleCloseProc(
ckfree(consolePtr->writeBuf);
consolePtr->writeBuf = 0;
}
- ckfree((char*) consolePtr);
+ ckfree(consolePtr);
return errorCode;
}
@@ -689,7 +704,7 @@ ConsoleInputProc(
* buffer? */
int *errorCode) /* Where to store error code. */
{
- ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
DWORD count, bytesRead = 0;
int result;
@@ -724,7 +739,7 @@ ConsoleInputProc(
bytesRead = infoPtr->bytesRead - infoPtr->offset;
/*
- * Reset the buffer
+ * Reset the buffer.
*/
infoPtr->readFlags &= ~CONSOLE_BUFFERED;
@@ -740,8 +755,8 @@ ConsoleInputProc(
* byte is available or an EOF occurs.
*/
- if (readConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count)
- == TRUE) {
+ if (ReadConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize,
+ &count) == TRUE) {
buf[count] = '\0';
return count;
}
@@ -770,16 +785,17 @@ 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 = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
+ ConsoleThreadInfo *threadInfo = &infoPtr->reader;
DWORD bytesWritten, timeout;
*errorCode = 0;
timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE;
- if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
+ if (WaitForSingleObject(threadInfo->readyEvent,timeout) == WAIT_TIMEOUT) {
/*
* The writer thread is blocked waiting for a write to complete and
* the channel is in non-blocking mode.
@@ -814,12 +830,12 @@ ConsoleOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc((size_t)toWrite);
+ infoPtr->writeBuf = ckalloc(toWrite);
}
- memcpy(infoPtr->writeBuf, buf, (size_t)toWrite);
+ memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
- ResetEvent(infoPtr->writable);
- SetEvent(infoPtr->startWriter);
+ ResetEvent(threadInfo->readyEvent);
+ SetEvent(threadInfo->startEvent);
bytesWritten = toWrite;
} else {
/*
@@ -827,9 +843,8 @@ 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;
}
@@ -868,7 +883,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);
@@ -887,7 +902,7 @@ ConsoleEventProc(
for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (consoleEvPtr->infoPtr == infoPtr) {
- infoPtr->flags &= ~(CONSOLE_PENDING);
+ infoPtr->flags &= ~CONSOLE_PENDING;
break;
}
}
@@ -908,7 +923,8 @@ ConsoleEventProc(
mask = 0;
if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->writer.readyEvent,
+ 0) != WAIT_TIMEOUT) {
mask = TCL_WRITABLE;
}
}
@@ -955,7 +971,7 @@ ConsoleWatchProc(
* TCL_EXCEPTION. */
{
ConsoleInfo **nextPtrPtr, *ptr;
- ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
int oldMask = infoPtr->watchMask;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -967,6 +983,7 @@ ConsoleWatchProc(
infoPtr->watchMask = mask & infoPtr->validMask;
if (infoPtr->watchMask) {
Tcl_Time blockTime = { 0, 0 };
+
if (!oldMask) {
infoPtr->nextPtr = tsdPtr->firstConsolePtr;
tsdPtr->firstConsolePtr = infoPtr;
@@ -1009,12 +1026,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 = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
- *handlePtr = (ClientData) infoPtr->handle;
+ *handlePtr = infoPtr->handle;
return TCL_OK;
}
@@ -1047,6 +1064,7 @@ WaitForRead(
{
DWORD timeout, count;
HANDLE *handle = infoPtr->handle;
+ ConsoleThreadInfo *threadInfo = &infoPtr->reader;
INPUT_RECORD input;
while (1) {
@@ -1055,7 +1073,8 @@ WaitForRead(
*/
timeout = blocking ? INFINITE : 0;
- if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
+ if (WaitForSingleObject(threadInfo->readyEvent,
+ timeout) == WAIT_TIMEOUT) {
/*
* The reader thread is blocked waiting for data and the channel
* is in non-blocking mode.
@@ -1114,8 +1133,8 @@ WaitForRead(
* There wasn't any data available, so reset the thread and try again.
*/
- ResetEvent(infoPtr->readable);
- SetEvent(infoPtr->startReader);
+ ResetEvent(threadInfo->readyEvent);
+ SetEvent(threadInfo->startEvent);
}
}
@@ -1142,14 +1161,18 @@ static DWORD WINAPI
ConsoleReaderThread(
LPVOID arg)
{
- ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
+ ConsoleInfo *infoPtr = arg;
HANDLE *handle = infoPtr->handle;
+ ConsoleThreadInfo *threadInfo = &infoPtr->reader;
DWORD waitResult;
HANDLE wEvents[2];
- /* The first event takes precedence. */
- wEvents[0] = infoPtr->stopReader;
- wEvents[1] = infoPtr->startReader;
+ /*
+ * The first event takes precedence.
+ */
+
+ wEvents[0] = threadInfo->stopEvent;
+ wEvents[1] = threadInfo->startEvent;
for (;;) {
/*
@@ -1172,7 +1195,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.
@@ -1180,10 +1203,9 @@ ConsoleReaderThread(
infoPtr->readFlags |= CONSOLE_BUFFERED;
} else {
- DWORD err;
- err = GetLastError();
+ DWORD err = GetLastError();
- if (err == (DWORD)EOF) {
+ if (err == (DWORD) EOF) {
infoPtr->readFlags = CONSOLE_EOF;
}
}
@@ -1193,7 +1215,7 @@ ConsoleReaderThread(
* waking up the notifier thread.
*/
- SetEvent(infoPtr->readable);
+ SetEvent(threadInfo->readyEvent);
/*
* Alert the foreground thread. Note that we need to treat this like a
@@ -1207,6 +1229,7 @@ ConsoleReaderThread(
* TIP #218. When in flight ignore the event, no one will receive
* it anyway.
*/
+
Tcl_ThreadAlert(infoPtr->threadId);
}
Tcl_MutexUnlock(&consoleMutex);
@@ -1238,16 +1261,19 @@ static DWORD WINAPI
ConsoleWriterThread(
LPVOID arg)
{
-
- ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
+ ConsoleInfo *infoPtr = 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] = infoPtr->stopWriter;
- wEvents[1] = infoPtr->startWriter;
+ /*
+ * The first event takes precedence.
+ */
+
+ wEvents[0] = threadInfo->stopEvent;
+ wEvents[1] = threadInfo->startEvent;
for (;;) {
/*
@@ -1273,14 +1299,13 @@ 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;
}
/*
@@ -1288,7 +1313,7 @@ ConsoleWriterThread(
* waking up the notifier thread.
*/
- SetEvent(infoPtr->writable);
+ SetEvent(threadInfo->readyEvent);
/*
* Alert the foreground thread. Note that we need to treat this like a
@@ -1324,7 +1349,7 @@ ConsoleWriterThread(
* Returns the new channel, or NULL.
*
* Side effects:
- * May open the channel
+ * May open the channel.
*
*----------------------------------------------------------------------
*/
@@ -1337,7 +1362,7 @@ TclWinOpenConsoleChannel(
{
char encoding[4 + TCL_INTEGER_SPACE];
ConsoleInfo *infoPtr;
- DWORD id, modes;
+ DWORD modes;
ConsoleInit();
@@ -1345,7 +1370,7 @@ TclWinOpenConsoleChannel(
* See if a channel with this handle already exists.
*/
- infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo));
+ infoPtr = ckalloc(sizeof(ConsoleInfo));
memset(infoPtr, 0, sizeof(ConsoleInfo));
infoPtr->validMask = permissions;
@@ -1362,10 +1387,10 @@ TclWinOpenConsoleChannel(
* for instance).
*/
- wsprintfA(channelName, "file%lx", PTR2INT(infoPtr));
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
- (ClientData) infoPtr, permissions);
+ infoPtr, permissions);
if (permissions & TCL_READABLE) {
/*
@@ -1378,22 +1403,11 @@ TclWinOpenConsoleChannel(
modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT);
modes |= ENABLE_LINE_INPUT;
SetConsoleMode(infoPtr->handle, modes);
-
- 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);
+ StartChannelThread(infoPtr, &infoPtr->reader, ConsoleReaderThread);
}
if (permissions & TCL_WRITABLE) {
- 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);
+ StartChannelThread(infoPtr, &infoPtr->writer, ConsoleWriterThread);
}
/*
@@ -1403,11 +1417,11 @@ TclWinOpenConsoleChannel(
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
- if (tclWinProcs->useWide)
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode");
- else
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
-
+#ifdef UNICODE
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode");
+#else
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
+#endif
return infoPtr->channel;
}
@@ -1432,9 +1446,10 @@ ConsoleThreadActionProc(
ClientData instanceData,
int action)
{
- ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = 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 9f39b37..71b03a9 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -10,6 +10,10 @@
* 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 <dde.h>
#include <ddeml.h>
@@ -47,7 +51,7 @@ typedef struct Conversation {
/* The next conversation in the list. */
RegisteredInterp *riPtr; /* The info we know about the conversation. */
HCONV hConv; /* The DDE handle for this conversation. */
- Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
+ Tcl_Obj *returnPackagePtr; /* The result package for this conversation */
} Conversation;
typedef struct DdeEnumServices {
@@ -75,7 +79,7 @@ static Tcl_ThreadDataKey dataKey;
static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance; /* The application instance handle given to us
- * by DdeInitialize. */
+ * by DdeInitializeA. */
static int ddeIsServer = 0;
#define TCL_DDE_VERSION "1.3.2"
@@ -92,10 +96,11 @@ TCL_DECLARE_MUTEX(ddeMutex)
static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg,
WPARAM wParam, LPARAM lParam);
static int DdeCreateClient(struct DdeEnumServices *es);
-static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam);
+static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget,
+ LPARAM lParam);
static void DdeExitProc(ClientData clientData);
static int DdeGetServicesList(Tcl_Interp *interp,
- char *serviceName, char *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);
@@ -104,13 +109,12 @@ static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam,
static void DeleteProc(ClientData clientData);
static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr,
Tcl_Obj *ddeObjectPtr);
-static int MakeDdeConnection(Tcl_Interp *interp, char *name,
- HCONV *ddeConvPtr);
+static int MakeDdeConnection(Tcl_Interp *interp,
+ const char *name, HCONV *ddeConvPtr);
static void SetDdeError(Tcl_Interp *interp);
-
-int Tcl_DdeObjCmd(ClientData clientData,
+static int DdeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
EXTERN int Dde_Init(Tcl_Interp *interp);
EXTERN int Dde_SafeInit(Tcl_Interp *interp);
@@ -135,11 +139,11 @@ int
Dde_Init(
Tcl_Interp *interp)
{
- if (!Tcl_InitStubs(interp, "8.0", 0)) {
+ if (!Tcl_InitStubs(interp, "8.1", 0)) {
return TCL_ERROR;
}
- Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
Tcl_CreateExitHandler(DdeExitProc, NULL);
return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
}
@@ -211,7 +215,7 @@ Initialize(void)
if (ddeInstance == 0) {
Tcl_MutexLock(&ddeMutex);
if (ddeInstance == 0) {
- if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc,
+ if (DdeInitializeA(&ddeInstance, (PFNCALLBACK) DdeServerProc,
CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS
| CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) {
ddeInstance = 0;
@@ -224,7 +228,7 @@ Initialize(void)
if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
ddeIsServer = 1;
Tcl_CreateExitHandler(DdeExitProc, NULL);
- ddeServiceGlobal = DdeCreateStringHandle(ddeInstance,
+ ddeServiceGlobal = DdeCreateStringHandleA(ddeInstance,
TCL_DDE_SERVICE_NAME, 0);
DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
} else {
@@ -259,10 +263,10 @@ Initialize(void)
*----------------------------------------------------------------------
*/
-static char *
+static const char *
DdeSetServerName(
Tcl_Interp *interp,
- char *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 exactName, /* Should we make a unique name? 0 = unique */
@@ -272,7 +276,7 @@ DdeSetServerName(
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
- char *actualName;
+ const char *actualName;
Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL;
int n, srvCount = 0, lastSuffix, r = TCL_OK;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -331,7 +335,7 @@ DdeSetServerName(
&srvPtrPtr);
}
if (r != TCL_OK) {
- OutputDebugString(Tcl_GetStringResult(interp));
+ OutputDebugStringA(Tcl_GetStringResult(interp));
return NULL;
}
@@ -351,7 +355,7 @@ DdeSetServerName(
Tcl_DStringAppend(&dString, name, -1);
Tcl_DStringAppend(&dString, " #", 2);
offset = Tcl_DStringLength(&dString);
- Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE);
+ Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE);
actualName = Tcl_DStringValue(&dString);
}
sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix);
@@ -379,9 +383,9 @@ DdeSetServerName(
* We have found a unique name. Now add it to the registry.
*/
- riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr = ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
- riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1);
+ riPtr->name = ckalloc(strlen(actualName) + 1);
riPtr->nextPtr = tsdPtr->interpListPtr;
riPtr->handlerPtr = handlerPtr;
if (riPtr->handlerPtr != NULL) {
@@ -394,8 +398,8 @@ DdeSetServerName(
Tcl_ExposeCommand(interp, "dde", "dde");
}
- Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
- (ClientData) riPtr, DeleteProc);
+ Tcl_CreateObjCommand(interp, "dde", DdeObjCmd,
+ riPtr, DeleteProc);
if (Tcl_IsSafe(interp)) {
Tcl_HideCommand(interp, "dde", "dde");
}
@@ -524,6 +528,7 @@ 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;
}
@@ -534,7 +539,8 @@ ExecuteRemoteObject(
Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr);
- result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, ddeObjectPtr);
+ result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr,
+ ddeObjectPtr);
if (result == TCL_OK) {
ddeObjectPtr = cmdPtr;
}
@@ -589,7 +595,7 @@ static HDDEDATA CALLBACK
DdeServerProc(
UINT uType, /* The type of DDE transaction we are
* performing. */
- UINT uFmt, /* The format that data is sent or received. */
+ UINT uFmt, /* The format that data is sent or received */
HCONV hConv, /* The conversation associated with the
* current transaction. */
HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type
@@ -615,16 +621,16 @@ DdeServerProc(
* sure we have a valid topic.
*/
- len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
+ len = DdeQueryStringA(ddeInstance, ddeTopic, NULL, 0, 0);
Tcl_DStringInit(&dString);
Tcl_DStringSetLength(&dString, len);
utilString = Tcl_DStringValue(&dString);
- DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
+ DdeQueryStringA(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
CP_WINANSI);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (stricmp(utilString, riPtr->name) == 0) {
+ if (strcasecmp(utilString, riPtr->name) == 0) {
Tcl_DStringFree(&dString);
return (HDDEDATA) TRUE;
}
@@ -640,16 +646,16 @@ DdeServerProc(
* result to return in an XTYP_REQUEST.
*/
- len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
+ len = DdeQueryStringA(ddeInstance, ddeTopic, NULL, 0, 0);
Tcl_DStringInit(&dString);
Tcl_DStringSetLength(&dString, len);
utilString = Tcl_DStringValue(&dString);
- DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
+ DdeQueryStringA(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
CP_WINANSI);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (stricmp(riPtr->name, utilString) == 0) {
- convPtr = (Conversation *) ckalloc(sizeof(Conversation));
+ if (strcasecmp(riPtr->name, utilString) == 0) {
+ convPtr = ckalloc(sizeof(Conversation));
convPtr->nextPtr = tsdPtr->currentConversations;
convPtr->returnPackagePtr = NULL;
convPtr->hConv = hConv;
@@ -679,7 +685,7 @@ DdeServerProc(
if (convPtr->returnPackagePtr != NULL) {
Tcl_DecrRefCount(convPtr->returnPackagePtr);
}
- ckfree((char *) convPtr);
+ ckfree(convPtr);
break;
}
}
@@ -707,13 +713,13 @@ DdeServerProc(
if (convPtr != NULL) {
BYTE *returnString;
- len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI);
+ len = DdeQueryStringA(ddeInstance, ddeItem, NULL, 0, CP_WINANSI);
Tcl_DStringInit(&dString);
Tcl_DStringSetLength(&dString, len);
utilString = Tcl_DStringValue(&dString);
- DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
+ DdeQueryStringA(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
CP_WINANSI);
- if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
+ if (strcasecmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
returnString = (BYTE *)
Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
ddeReturn = DdeCreateDataHandle(ddeInstance, returnString,
@@ -812,9 +818,9 @@ DdeServerProc(
len = dlen;
for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
i++, riPtr = riPtr->nextPtr) {
- returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance,
+ returnPtr[i].hszSvc = DdeCreateStringHandleA(ddeInstance,
TCL_DDE_SERVICE_NAME, CP_WINANSI);
- returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance,
+ returnPtr[i].hszTopic = DdeCreateStringHandleA(ddeInstance,
riPtr->name, CP_WINANSI);
}
returnPtr[i].hszSvc = NULL;
@@ -873,14 +879,14 @@ DdeExitProc(
static int
MakeDdeConnection(
Tcl_Interp *interp, /* Used to report errors. */
- char *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, 0);
- ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) name, 0);
+ ddeService = DdeCreateStringHandleA(ddeInstance, TCL_DDE_SERVICE_NAME, 0);
+ ddeTopic = DdeCreateStringHandleA(ddeInstance, (void *) name, 0);
ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
@@ -890,6 +896,7 @@ MakeDdeConnection(
if (interp != NULL) {
Tcl_AppendResult(interp, "no registered server named \"",
name, "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
}
return TCL_ERROR;
}
@@ -922,7 +929,7 @@ static int
DdeCreateClient(
struct DdeEnumServices *es)
{
- WNDCLASSEX wc;
+ WNDCLASSEXA wc;
static const char *szDdeClientClassName = "TclEval client class";
static const char *szDdeClientWindowName = "TclEval client window";
@@ -936,8 +943,8 @@ DdeCreateClient(
* Register and create the callback window.
*/
- RegisterClassEx(&wc);
- es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName,
+ RegisterClassExA(&wc);
+ es->hwnd = CreateWindowExA(0, szDdeClientClassName, szDdeClientWindowName,
WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es);
return TCL_OK;
}
@@ -957,9 +964,9 @@ DdeClientWindowProc(
(struct DdeEnumServices *) lpcs->lpCreateParams;
#ifdef _WIN64
- SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
+ SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR)es);
#else
- SetWindowLong(hwnd, GWL_USERDATA, (long)es);
+ SetWindowLongA(hwnd, GWL_USERDATA, (long)es);
#endif
return (LRESULT) 0L;
}
@@ -967,7 +974,7 @@ DdeClientWindowProc(
return DdeServicesOnAck(hwnd, wParam, lParam);
break;
default:
- return DefWindowProc(hwnd, uMsg, wParam, lParam);
+ return DefWindowProcA(hwnd, uMsg, wParam, lParam);
}
}
@@ -986,7 +993,7 @@ DdeServicesOnAck(
#ifdef _WIN64
es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
- es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
+ es = (struct DdeEnumServices *) GetWindowLongA(hwnd, GWL_USERDATA);
#endif
if ((es->service == (ATOM)0 || es->service == service)
@@ -1023,7 +1030,7 @@ DdeServicesOnAck(
* Tell the server we are no longer interested.
*/
- PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
+ PostMessageA(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
return 0L;
}
@@ -1035,7 +1042,7 @@ DdeEnumWindowsCallback(
DWORD_PTR dwResult = 0;
struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
- SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
+ SendMessageTimeoutA(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
&dwResult);
return TRUE;
@@ -1044,16 +1051,16 @@ DdeEnumWindowsCallback(
static int
DdeGetServicesList(
Tcl_Interp *interp,
- char *serviceName,
- char *topicName)
+ const char *serviceName,
+ const char *topicName)
{
struct DdeEnumServices es;
es.interp = interp;
es.result = TCL_OK;
es.service = (serviceName == NULL)
- ? (ATOM)0 : GlobalAddAtom(serviceName);
- es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName);
+ ? (ATOM)0 : GlobalAddAtomA(serviceName);
+ es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtomA(topicName);
Tcl_ResetResult(interp); /* our list is to be appended to result. */
DdeCreateClient(&es);
@@ -1092,31 +1099,36 @@ static void
SetDdeError(
Tcl_Interp *interp) /* The interp to put the message in. */
{
- char *errorMessage;
+ const char *errorMessage, *errorCode;
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);
}
/*
*----------------------------------------------------------------------
*
- * Tcl_DdeObjCmd --
+ * DdeObjCmd --
*
* This function is invoked to process the "dde" Tcl command. See the
* user documentation for details on what it does.
@@ -1130,14 +1142,14 @@ SetDdeError(
*----------------------------------------------------------------------
*/
-int
-Tcl_DdeObjCmd(
+static int
+DdeObjCmd(
ClientData clientData, /* Used only for deletion */
Tcl_Interp *interp, /* The interp we are sending from */
int objc, /* Number of arguments */
- Tcl_Obj *CONST * objv) /* The arguments */
+ Tcl_Obj *const * objv) /* The arguments */
{
- static CONST char *ddeCommands[] = {
+ static const char *const ddeCommands[] = {
"servername", "execute", "poke", "request", "services", "eval",
(char *) NULL
};
@@ -1145,16 +1157,16 @@ Tcl_DdeObjCmd(
DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES,
DDE_EVAL
};
- static CONST char *ddeSrvOptions[] = {
+ static const char *const ddeSrvOptions[] = {
"-force", "-handler", "--", NULL
};
enum DdeSrvOptions {
DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
};
- static CONST char *ddeExecOptions[] = {
+ static const char *const ddeExecOptions[] = {
"-async", NULL
};
- static CONST char *ddeReqOptions[] = {
+ static const char *const ddeReqOptions[] = {
"-binary", NULL
};
@@ -1164,7 +1176,8 @@ Tcl_DdeObjCmd(
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
HCONV hConv = NULL;
- char *serviceName = NULL, *topicName = NULL, *string;
+ const char *serviceName = NULL, *topicName = NULL;
+ char *string;
DWORD ddeResult;
Tcl_Obj *objPtr, *handlerPtr = NULL;
@@ -1290,8 +1303,8 @@ Tcl_DdeObjCmd(
int dummy;
firstArg = 2;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0,
- &dummy) == TCL_OK) {
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option",
+ 0, &dummy) == TCL_OK) {
if (objc < 5) {
goto wrongDdeEvalArgs;
}
@@ -1313,7 +1326,7 @@ Tcl_DdeObjCmd(
if (length == 0) {
serviceName = NULL;
} else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
- ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName,
+ ddeService = DdeCreateStringHandleA(ddeInstance, (void *) serviceName,
CP_WINANSI);
}
@@ -1322,14 +1335,15 @@ Tcl_DdeObjCmd(
if (length == 0) {
topicName = NULL;
} else {
- ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName,
+ ddeTopic = DdeCreateStringHandleA(ddeInstance, (void *) topicName,
CP_WINANSI);
}
}
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
- serviceName = DdeSetServerName(interp, serviceName, exact, handlerPtr);
+ serviceName = DdeSetServerName(interp, serviceName, exact,
+ handlerPtr);
if (serviceName != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
} else {
@@ -1345,6 +1359,7 @@ Tcl_DdeObjCmd(
if (dataLength == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot execute null data", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
break;
}
@@ -1381,11 +1396,13 @@ Tcl_DdeObjCmd(
break;
}
case DDE_REQUEST: {
- char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
+ const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
+ &length);
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;
}
@@ -1398,7 +1415,7 @@ Tcl_DdeObjCmd(
result = TCL_ERROR;
} else {
Tcl_Obj *returnObjPtr;
- ddeItem = DdeCreateStringHandle(ddeInstance, (void *)itemString,
+ ddeItem = DdeCreateStringHandleA(ddeInstance, (void *) itemString,
CP_WINANSI);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
@@ -1414,7 +1431,7 @@ Tcl_DdeObjCmd(
returnObjPtr = Tcl_NewByteArrayObj(dataString,
(int) tmp);
} else {
- returnObjPtr = Tcl_NewStringObj((const char *)dataString, -1);
+ returnObjPtr = Tcl_NewStringObj((char*)dataString,-1);
}
DdeUnaccessData(ddeData);
DdeFreeDataHandle(ddeData);
@@ -1429,12 +1446,14 @@ Tcl_DdeObjCmd(
break;
}
case DDE_POKE: {
- char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
+ const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
+ &length);
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;
}
@@ -1449,7 +1468,7 @@ Tcl_DdeObjCmd(
SetDdeError(interp);
result = TCL_ERROR;
} else {
- ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
+ ddeItem = DdeCreateStringHandleA(ddeInstance, (void *) itemString,
CP_WINANSI);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
@@ -1477,6 +1496,7 @@ Tcl_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;
}
@@ -1495,7 +1515,7 @@ Tcl_DdeObjCmd(
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (stricmp(serviceName, riPtr->name) == 0) {
+ if (strcasecmp(serviceName, riPtr->name) == 0) {
break;
}
}
@@ -1508,9 +1528,9 @@ Tcl_DdeObjCmd(
* server.
*/
- Tcl_Preserve((ClientData) riPtr);
+ Tcl_Preserve(riPtr);
sendInterp = riPtr->interp;
- Tcl_Preserve((ClientData) sendInterp);
+ Tcl_Preserve(sendInterp);
/*
* Don't exchange objects between interps. The target interp would
@@ -1524,6 +1544,8 @@ Tcl_DdeObjCmd(
Tcl_SetResult(riPtr->interp, "permission denied: "
"a handler procedure must be defined for use in "
"a safe interp", TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
+ NULL);
result = TCL_ERROR;
}
@@ -1575,8 +1597,8 @@ Tcl_DdeObjCmd(
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
}
- Tcl_Release((ClientData) riPtr);
- Tcl_Release((ClientData) sendInterp);
+ Tcl_Release(riPtr);
+ Tcl_Release(sendInterp);
} else {
/*
* This is a non-local request. Send the script to the server and
@@ -1588,6 +1610,7 @@ Tcl_DdeObjCmd(
Tcl_SetObjResult(interp,
Tcl_NewStringObj("invalid data returned from server",
-1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
result = TCL_ERROR;
goto cleanup;
}
@@ -1595,7 +1618,7 @@ Tcl_DdeObjCmd(
objPtr = Tcl_ConcatObj(objc, objv);
string = Tcl_GetStringFromObj(objPtr, &length);
ddeItemData = DdeCreateDataHandle(ddeInstance,
- (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
+ (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
if (async) {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
@@ -1607,7 +1630,7 @@ Tcl_DdeObjCmd(
0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeData != 0) {
- ddeCookie = DdeCreateStringHandle(ddeInstance,
+ ddeCookie = DdeCreateStringHandleA(ddeInstance,
TCL_DDE_EXECUTE_RESULT, CP_WINANSI);
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
CF_TEXT, XTYP_REQUEST, 30000, NULL);
diff --git a/win/tclWinError.c b/win/tclWinError.c
index b49271e..1b59dbe 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -11,7 +11,6 @@
*/
#include "tclInt.h"
-#include "tclPort.h"
#ifndef WSAEWOULDBLOCK
# define WSAEWOULDBLOCK 10035L
@@ -25,7 +24,7 @@
* 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 */
@@ -301,8 +300,8 @@ static CONST unsigned char errorTable[] = {
* errno errors.
*/
-static CONST int wsaErrorTable[] = {
- EWOULDBLOCK, /* WSAEWOULDBLOCK */
+static const unsigned char wsaErrorTable[] = {
+ EAGAIN, /* WSAEWOULDBLOCK */
EINPROGRESS, /* WSAEINPROGRESS */
EALREADY, /* WSAEALREADY */
ENOTSOCK, /* WSAENOTSOCK */
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index a1338a7..fea9ddb 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -54,12 +54,12 @@ static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
-CONST char *tclpFileAttrStrings[] = {
+const char *const tclpFileAttrStrings[] = {
"-archive", "-hidden", "-longname", "-readonly",
"-shortname", "-system", (char *) NULL
};
-CONST TclFileAttrProcs tclpFileAttrProcs[] = {
+const TclFileAttrProcs tclpFileAttrProcs[] = {
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileLongName, CannotSetAttribute},
@@ -90,7 +90,7 @@ typedef struct EXCEPTION_REGISTRATION {
* 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);
/*
@@ -101,18 +101,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,
@@ -170,9 +170,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)
@@ -275,7 +275,7 @@ DoRenameFile(
[registration] "m" (registration),
[nativeDst] "m" (nativeDst),
[nativeSrc] "m" (nativeSrc),
- [moveFile] "r" (tclWinProcs->moveFileProc)
+ [moveFile] "r" (MoveFile)
:
"%eax", "%ebx", "%ecx", "%edx", "memory"
);
@@ -286,7 +286,7 @@ DoRenameFile(
#ifndef HAVE_NO_SEH
__try {
#endif
- if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
+ if ((*MoveFile)(nativeSrc, nativeDst) != FALSE) {
retval = TCL_OK;
}
#ifndef HAVE_NO_SEH
@@ -300,10 +300,10 @@ DoRenameFile(
TclWinConvertError(GetLastError());
- srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
- dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
+ srcAttr = GetFileAttributes(nativeSrc);
+ dstAttr = GetFileAttributes(nativeDst);
if (srcAttr == 0xffffffff) {
- if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL,
+ if (GetFullPathName(nativeSrc, 0, NULL,
NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
@@ -311,7 +311,7 @@ DoRenameFile(
srcAttr = 0;
}
if (dstAttr == 0xffffffff) {
- if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL,
+ if (GetFullPathName(nativeDst, 0, NULL,
NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
@@ -327,28 +327,28 @@ DoRenameFile(
decode:
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
TCHAR *nativeSrcRest, *nativeDstRest;
- CONST char **srcArgv, **dstArgv;
+ const char **srcArgv, **dstArgv;
int size, srcArgc, dstArgc;
- WCHAR nativeSrcPath[MAX_PATH];
- WCHAR nativeDstPath[MAX_PATH];
+ TCHAR nativeSrcPath[MAX_PATH];
+ TCHAR nativeDstPath[MAX_PATH];
Tcl_DString srcString, dstString;
- CONST char *src, *dst;
+ const char *src, *dst;
- size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
+ size = GetFullPathName(nativeSrc, MAX_PATH,
nativeSrcPath, &nativeSrcRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
+ size = GetFullPathName(nativeDst, MAX_PATH,
nativeDstPath, &nativeDstRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
- (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);
+ CharLower(nativeSrcPath);
+ CharLower(nativeDstPath);
- src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
- dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
+ src = Tcl_WinTCharToUtf(nativeSrcPath, -1, &srcString);
+ dst = Tcl_WinTCharToUtf(nativeDstPath, -1, &dstString);
/*
* Check whether the destination path is actually inside the
@@ -395,8 +395,8 @@ DoRenameFile(
Tcl_SetErrno(EXDEV);
}
- ckfree((char *) srcArgv);
- ckfree((char *) dstArgv);
+ ckfree(srcArgv);
+ ckfree(dstArgv);
}
/*
@@ -427,7 +427,7 @@ DoRenameFile(
* directory back, for completeness.
*/
- if ((*tclWinProcs->moveFileProc)(nativeSrc,
+ if (MoveFile(nativeSrc,
nativeDst) != FALSE) {
return TCL_OK;
}
@@ -438,8 +438,8 @@ DoRenameFile(
*/
TclWinConvertError(GetLastError());
- (*tclWinProcs->createDirectoryProc)(nativeDst, NULL);
- (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
+ CreateDirectory(nativeDst, NULL);
+ SetFileAttributes(nativeDst, dstAttr);
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
@@ -466,22 +466,20 @@ DoRenameFile(
TCHAR *nativeRest, *nativeTmp, *nativePrefix;
int result, size;
- WCHAR tempBuf[MAX_PATH];
+ TCHAR tempBuf[MAX_PATH];
- size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
+ size = GetFullPathName(nativeDst, MAX_PATH,
tempBuf, &nativeRest);
if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
return TCL_ERROR;
}
nativeTmp = (TCHAR *) tempBuf;
- ((char *) nativeRest)[0] = '\0';
- ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */
+ nativeRest[0] = L'\0';
result = TCL_ERROR;
- nativePrefix = (tclWinProcs->useWide)
- ? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
- if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
- nativePrefix, 0, tempBuf) != 0) {
+ nativePrefix = (TCHAR *) L"tclr";
+ if (GetTempFileName(nativeTmp, nativePrefix,
+ 0, tempBuf) != 0) {
/*
* Strictly speaking, need the following DeleteFile and
* MoveFile to be joined as an atomic operation so no
@@ -489,19 +487,16 @@ DoRenameFile(
* same temp file.
*/
- 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);
+ nativeTmp = tempBuf;
+ DeleteFile(nativeTmp);
+ if (MoveFile(nativeDst, nativeTmp) != FALSE) {
+ if (MoveFile(nativeSrc, nativeDst) != FALSE) {
+ SetFileAttributes(nativeTmp, FILE_ATTRIBUTE_NORMAL);
+ DeleteFile(nativeTmp);
return TCL_OK;
} else {
- (*tclWinProcs->deleteFileProc)(nativeDst);
- (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);
+ DeleteFile(nativeDst);
+ MoveFile(nativeTmp, nativeDst);
}
}
@@ -564,8 +559,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)
EXCEPTION_REGISTRATION registration;
@@ -668,7 +663,7 @@ DoCopyFile(
[registration] "m" (registration),
[nativeDst] "m" (nativeDst),
[nativeSrc] "m" (nativeSrc),
- [copyFile] "r" (tclWinProcs->copyFileProc)
+ [copyFile] "r" (CopyFile)
:
"%eax", "%ebx", "%ecx", "%edx", "memory"
);
@@ -679,7 +674,7 @@ DoCopyFile(
#ifndef HAVE_NO_SEH
__try {
#endif
- if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
+ if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) {
retval = TCL_OK;
}
#ifndef HAVE_NO_SEH
@@ -699,8 +694,8 @@ DoCopyFile(
if (Tcl_GetErrno() == EACCES) {
DWORD srcAttr, dstAttr;
- srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
- dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
+ srcAttr = GetFileAttributes(nativeSrc);
+ dstAttr = GetFileAttributes(nativeDst);
if (srcAttr != 0xffffffff) {
if (dstAttr == 0xffffffff) {
dstAttr = 0;
@@ -716,9 +711,9 @@ DoCopyFile(
Tcl_SetErrno(EISDIR);
}
if (dstAttr & FILE_ATTRIBUTE_READONLY) {
- (*tclWinProcs->setFileAttributesProc)(nativeDst,
+ SetFileAttributes(nativeDst,
dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
- if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst,
+ if (CopyFile(nativeSrc, nativeDst,
0) != FALSE) {
return TCL_OK;
}
@@ -729,7 +724,7 @@ DoCopyFile(
*/
TclWinConvertError(GetLastError());
- (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
+ SetFileAttributes(nativeDst, dstAttr);
}
}
}
@@ -770,34 +765,35 @@ TclpObjDeleteFile(
int
TclpDeleteFile(
- CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */
+ const void *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 (nativePath == NULL || nativePath[0] == '\0') {
+ if (path == NULL || path[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
- if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
+ if (DeleteFile(path) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = GetFileAttributes(path);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
/*
* It is a symbolic link - remove it.
*/
- if (TclWinSymLinkDelete(nativePath, 0) == 0) {
+ if (TclWinSymLinkDelete(path, 0) == 0) {
return TCL_OK;
}
}
@@ -811,21 +807,21 @@ TclpDeleteFile(
Tcl_SetErrno(EISDIR);
} else if (attr & FILE_ATTRIBUTE_READONLY) {
- int res = (*tclWinProcs->setFileAttributesProc)(nativePath,
- attr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
+ int res = SetFileAttributes(path,
+ attr & ~((DWORD) FILE_ATTRIBUTE_READONLY));
- if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath)
- != FALSE)) {
+ if ((res != 0) &&
+ (DeleteFile(path) != FALSE)) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
if (res != 0) {
- (*tclWinProcs->setFileAttributesProc)(nativePath, attr);
+ SetFileAttributes(path, attr);
}
}
}
} else if (Tcl_GetErrno() == ENOENT) {
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = GetFileAttributes(path);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
@@ -882,11 +878,11 @@ TclpObjCreateDirectory(
static int
DoCreateDirectory(
- CONST TCHAR *nativePath) /* Pathname of directory to create (native). */
+ const TCHAR *nativePath) /* Pathname of directory to create (native). */
{
- DWORD error;
- if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
- error = GetLastError();
+ if (CreateDirectory(nativePath, NULL) == 0) {
+ DWORD error = GetLastError();
+
TclWinConvertError(error);
return TCL_ERROR;
}
@@ -1033,7 +1029,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. */
@@ -1053,7 +1049,7 @@ DoRemoveJustDirectory(
goto end;
}
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = GetFileAttributes(nativePath);
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
/*
@@ -1067,7 +1063,7 @@ DoRemoveJustDirectory(
* Ordinary directory.
*/
- if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
+ if (RemoveDirectory(nativePath) != FALSE) {
return TCL_OK;
}
}
@@ -1075,7 +1071,7 @@ DoRemoveJustDirectory(
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = GetFileAttributes(nativePath);
if (attr != 0xffffffff) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
@@ -1099,32 +1095,32 @@ DoRemoveJustDirectory(
if (attr & FILE_ATTRIBUTE_READONLY) {
attr &= ~FILE_ATTRIBUTE_READONLY;
- if ((*tclWinProcs->setFileAttributesProc)(nativePath,
+ if (SetFileAttributes(nativePath,
attr) == FALSE) {
goto end;
}
- if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
+ if (RemoveDirectory(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- (*tclWinProcs->setFileAttributesProc)(nativePath,
+ SetFileAttributes(nativePath,
attr | FILE_ATTRIBUTE_READONLY);
}
/*
- * Windows 95 and Win32s report removing a non-empty directory as
+ * Windows 95 reports 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;
+ if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
+ const char *path, *find;
HANDLE handle;
WIN32_FIND_DATAA data;
Tcl_DString buffer;
int len;
- path = (CONST char *) nativePath;
+ path = (const char *) nativePath;
Tcl_DStringInit(&buffer);
len = strlen(path);
@@ -1192,7 +1188,7 @@ DoRemoveDirectory(
* filled with UTF-8 name of file causing
* error. */
{
- int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive,
+ int res = DoRemoveJustDirectory((const TCHAR *)Tcl_DStringValue(pathPtr), recursive,
errorPtr);
if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
@@ -1246,7 +1242,7 @@ TraverseWinTree(
TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen;
HANDLE handle;
- WIN32_FIND_DATAT data;
+ WIN32_FIND_DATA data;
nativeErrfile = NULL;
result = TCL_OK;
@@ -1257,7 +1253,7 @@ TraverseWinTree(
(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));
oldSourceLen = Tcl_DStringLength(sourcePtr);
- sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
+ sourceAttr = GetFileAttributes(nativeSource);
if (sourceAttr == 0xffffffff) {
nativeErrfile = nativeSource;
goto end;
@@ -1268,7 +1264,7 @@ TraverseWinTree(
* Process the symbolic link
*/
- return (*traverseProc)(nativeSource, nativeTarget, DOTREE_LINK,
+ return traverseProc(nativeSource, nativeTarget, DOTREE_LINK,
errorPtr);
}
@@ -1277,18 +1273,14 @@ TraverseWinTree(
* Process the regular file
*/
- return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr);
+ return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr);
}
- if (tclWinProcs->useWide) {
- Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
- Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
- } else {
- Tcl_DStringAppend(sourcePtr, "\\*.*", 4);
- }
+ Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\*.*"), 4 * sizeof(TCHAR) + 1);
+ Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
- handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
+ handle = FindFirstFile(nativeSource, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* Can't read directory.
@@ -1299,67 +1291,44 @@ TraverseWinTree(
goto end;
}
- nativeSource[oldSourceLen + 1] = '\0';
+ Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
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;
-
- 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);
- }
+ sourceLen = oldSourceLen + sizeof(TCHAR);
+ Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1);
+ Tcl_DStringSetLength(sourcePtr, sourceLen);
if (targetPtr != NULL) {
oldTargetLen = Tcl_DStringLength(targetPtr);
targetLen = oldTargetLen;
- 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);
- }
+ targetLen += sizeof(TCHAR);
+ Tcl_DStringAppend(targetPtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1);
+ Tcl_DStringSetLength(targetPtr, targetLen);
}
found = 1;
- for (; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
+ for (; found; found = FindNextFile(handle, &data)) {
TCHAR *nativeName;
int len;
- if (tclWinProcs->useWide) {
- WCHAR *wp;
-
- wp = data.w.cFileName;
+ TCHAR *wp = data.cFileName;
+ if (*wp == '.') {
+ wp++;
if (*wp == '.') {
wp++;
- if (*wp == '.') {
- wp++;
- }
- if (*wp == '\0') {
- continue;
- }
}
- nativeName = (TCHAR *) data.w.cFileName;
- len = wcslen(data.w.cFileName) * sizeof(WCHAR);
- } else {
- if ((strcmp(data.a.cFileName, ".") == 0)
- || (strcmp(data.a.cFileName, "..") == 0)) {
+ if (*wp == '\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.
@@ -1404,8 +1373,8 @@ TraverseWinTree(
* files in that directory.
*/
- result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
- (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
+ result = traverseProc((const TCHAR *)Tcl_DStringValue(sourcePtr),
+ (const TCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
DOTREE_POSTD, errorPtr);
}
@@ -1440,8 +1409,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. */
@@ -1459,9 +1428,9 @@ TraversalCopy(
break;
case DOTREE_PRED:
if (DoCreateDirectory(nativeDst) == TCL_OK) {
- DWORD attr = (tclWinProcs->getFileAttributesProc)(nativeSrc);
+ DWORD attr = GetFileAttributes(nativeSrc);
- if ((tclWinProcs->setFileAttributesProc)(nativeDst,
+ if (SetFileAttributes(nativeDst,
attr) != FALSE) {
return TCL_OK;
}
@@ -1506,8 +1475,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. */
@@ -1593,11 +1562,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 = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ result = GetFileAttributes(nativeName);
if (result == 0xffffffff) {
StatError(interp, fileName);
@@ -1615,7 +1584,7 @@ GetWinFileAttributes(
*/
int len;
- char *str = Tcl_GetStringFromObj(fileName,&len);
+ const char *str = Tcl_GetStringFromObj(fileName,&len);
if (len < 4) {
if (len == 0) {
@@ -1684,6 +1653,8 @@ ConvertFileNameFormat(
Tcl_AppendResult(interp, "could not read \"",
Tcl_GetString(fileName), "\": no such file or directory",
(char *) NULL);
+ errno = ENOENT;
+ Tcl_PosixError(interp);
}
goto cleanup;
}
@@ -1724,10 +1695,10 @@ ConvertFileNameFormat(
Tcl_Obj *tempPath;
Tcl_DString ds;
Tcl_DString dsTemp;
- TCHAR *nativeName;
- char *tempString;
+ const TCHAR *nativeName;
+ const char *tempString;
int tempLen;
- WIN32_FIND_DATAT data;
+ WIN32_FIND_DATA data;
HANDLE handle;
DWORD attr;
@@ -1743,7 +1714,7 @@ ConvertFileNameFormat(
tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
Tcl_DecrRefCount(tempPath);
- handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
+ handle = FindFirstFile(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* FindFirstFile() doesn't like root directories. We would
@@ -1752,7 +1723,7 @@ ConvertFileNameFormat(
* root directory
*/
- attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ attr = GetFileAttributes(nativeName);
if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
goto simple;
@@ -1766,27 +1737,14 @@ ConvertFileNameFormat(
}
goto cleanup;
}
- 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;
- }
+ nativeName = data.cAlternateFileName;
+ if (longShort) {
+ if (data.cFileName[0] != TEXT('\0')) {
+ nativeName = data.cFileName;
}
} else {
- 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;
- }
+ if (data.cAlternateFileName[0] == TEXT('\0')) {
+ nativeName = (TCHAR *) data.cFileName;
}
}
@@ -1810,7 +1768,7 @@ ConvertFileNameFormat(
*/
if (Tcl_DStringValue(&dsTemp)[0] == '~') {
- tempPath = Tcl_NewStringObj("./",2);
+ TclNewLiteralStringObj(tempPath, "./");
Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
Tcl_DStringLength(&dsTemp));
} else {
@@ -1932,12 +1890,11 @@ SetWinFileAttributes(
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
DWORD fileAttributes;
- int yesNo;
- int result;
- CONST TCHAR *nativeName;
+ int yesNo, result;
+ const TCHAR *nativeName;
nativeName = Tcl_FSGetNativePath(fileName);
- fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ fileAttributes = GetFileAttributes(nativeName);
if (fileAttributes == 0xffffffff) {
StatError(interp, fileName);
@@ -1955,7 +1912,7 @@ SetWinFileAttributes(
fileAttributes &= ~(attributeArray[objIndex]);
}
- if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
+ if (!SetFileAttributes(nativeName, fileAttributes)) {
StatError(interp, fileName);
return TCL_ERROR;
}
@@ -1988,11 +1945,11 @@ CannotSetAttribute(
{
Tcl_AppendResult(interp, "cannot set attribute \"",
tclpFileAttrStrings[objIndex], "\" for file \"",
- Tcl_GetString(fileName), "\": attribute is readonly",
- (char *) NULL);
+ Tcl_GetString(fileName), "\": attribute is readonly", NULL);
+ errno = EINVAL;
+ Tcl_PosixError(interp);
return TCL_ERROR;
}
-
/*
*---------------------------------------------------------------------------
@@ -2010,7 +1967,7 @@ CannotSetAttribute(
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
+Tcl_Obj *
TclpObjListVolumes(void)
{
Tcl_Obj *resultPtr, *elemPtr;
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index a9b321d..dcc05bb 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -17,7 +17,7 @@
#include <winioctl.h>
#include <sys/stat.h>
#include <shlobj.h>
-#include <lmaccess.h> /* For TclpGetUserHome(). */
+#include <lm.h> /* For TclpGetUserHome(). */
/*
* The number of 100-ns intervals between the Windows system epoch (1601-01-01
@@ -141,28 +141,6 @@ 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.
*/
@@ -170,14 +148,6 @@ typedef enum _FINDEX_SEARCH_OPS {
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);
-
/*
* Declarations for local functions defined in this file:
*/
@@ -203,6 +173,7 @@ static int WinLink(const TCHAR *LinkSource,
const TCHAR *LinkTarget, int linkAction);
static int WinSymLinkDirectory(const TCHAR *LinkDirectory,
const TCHAR *LinkTarget);
+MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
/*
*--------------------------------------------------------------------
@@ -220,7 +191,7 @@ WinLink(
const TCHAR *linkTargetPath,
int linkAction)
{
- WCHAR tempFileName[MAX_PATH];
+ TCHAR tempFileName[MAX_PATH];
TCHAR *tempFilePart;
DWORD attr;
@@ -228,8 +199,8 @@ WinLink(
* Get the full path referenced by the target.
*/
- if (!(*tclWinProcs->getFullPathNameProc)(linkTargetPath, MAX_PATH,
- tempFileName, &tempFilePart)) {
+ if (!GetFullPathName(linkTargetPath, MAX_PATH, tempFileName,
+ &tempFilePart)) {
/*
* Invalid file.
*/
@@ -242,7 +213,7 @@ WinLink(
* Make sure source file doesn't exist.
*/
- attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath);
+ attr = GetFileAttributes(linkSourcePath);
if (attr != INVALID_FILE_ATTRIBUTES) {
Tcl_SetErrno(EEXIST);
return -1;
@@ -252,8 +223,8 @@ WinLink(
* Get the full path referenced by the source file/directory.
*/
- if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH,
- tempFileName, &tempFilePart)) {
+ if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName,
+ &tempFilePart)) {
/*
* Invalid file.
*/
@@ -266,43 +237,36 @@ WinLink(
* Check the target.
*/
- attr = (*tclWinProcs->getFileAttributesProc)(linkTargetPath);
+ attr = GetFileAttributes(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 (tclWinProcs->createHardLinkProc == NULL) {
- Tcl_SetErrno(ENOTDIR);
- return -1;
- }
-
if (linkAction & TCL_CREATE_HARD_LINK) {
- if (!(*tclWinProcs->createHardLinkProc)(linkSourcePath,
- linkTargetPath, NULL)) {
- TclWinConvertError(GetLastError());
- return -1;
+ if (CreateHardLink(linkSourcePath, linkTargetPath, NULL)) {
+ /*
+ * Success!
+ */
+
+ return 0;
}
- 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 {
/*
@@ -319,12 +283,11 @@ WinLink(
*/
Tcl_SetErrno(EISDIR);
- return -1;
} else {
Tcl_SetErrno(ENODEV);
- return -1;
}
}
+ return -1;
}
/*
@@ -341,7 +304,7 @@ static Tcl_Obj *
WinReadLink(
const TCHAR *linkSourcePath)
{
- WCHAR tempFileName[MAX_PATH];
+ TCHAR tempFileName[MAX_PATH];
TCHAR *tempFilePart;
DWORD attr;
@@ -349,8 +312,8 @@ WinReadLink(
* Get the full path referenced by the target.
*/
- if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH,
- tempFileName, &tempFilePart)) {
+ if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName,
+ &tempFilePart)) {
/*
* Invalid file.
*/
@@ -363,7 +326,7 @@ WinReadLink(
* Make sure source file does exist.
*/
- attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath);
+ attr = GetFileAttributes(linkSourcePath);
if (attr == INVALID_FILE_ATTRIBUTES) {
/*
* The source doesn't exist.
@@ -379,9 +342,9 @@ WinReadLink(
Tcl_SetErrno(ENOTDIR);
return NULL;
- } else {
- return WinReadLinkDirectory(linkSourcePath);
}
+
+ return WinReadLinkDirectory(linkSourcePath);
}
/*
@@ -520,9 +483,8 @@ TclWinSymLinkDelete(
memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
- hFile = (*tclWinProcs->createFileProc)(linkOrigPath, GENERIC_WRITE, 0,
- NULL, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ hFile = CreateFile(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,
@@ -536,7 +498,7 @@ TclWinSymLinkDelete(
} else {
CloseHandle(hFile);
if (!linkOnly) {
- (*tclWinProcs->removeDirectoryProc)(linkOrigPath);
+ RemoveDirectory(linkOrigPath);
}
return 0;
}
@@ -576,7 +538,7 @@ WinReadLinkDirectory(
Tcl_DString ds;
const char *copy;
- attr = (*tclWinProcs->getFileAttributesProc)(linkDirPath);
+ attr = GetFileAttributes(linkDirPath);
if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
goto invalidError;
}
@@ -601,6 +563,7 @@ WinReadLinkDirectory(
*/
offset = 0;
+#ifdef UNICODE
if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') {
/*
* Check whether this is a mounted volume.
@@ -662,8 +625,9 @@ WinReadLinkDirectory(
offset = 4;
}
}
+#endif /* UNICODE */
- Tcl_WinTCharToUtf((const char *)
+ Tcl_WinTCharToUtf((const TCHAR *)
reparseBuffer->MountPointReparseBuffer.PathBuffer,
(int) reparseBuffer->MountPointReparseBuffer
.SubstituteNameLength, &ds);
@@ -704,9 +668,8 @@ NativeReadReparse(
HANDLE hFile;
DWORD returnedLength;
- hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_READ, 0,
- NULL, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ hFile = CreateFile(linkDirPath, GENERIC_READ, 0, NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
/*
@@ -764,7 +727,7 @@ NativeWriteReparse(
* Create the directory - it must not already exist.
*/
- if ((*tclWinProcs->createDirectoryProc)(linkDirPath, NULL) == 0) {
+ if (CreateDirectory(linkDirPath, NULL) == 0) {
/*
* Error creating directory.
*/
@@ -772,9 +735,9 @@ NativeWriteReparse(
TclWinConvertError(GetLastError());
return -1;
}
- hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_WRITE, 0,
- NULL, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ hFile = CreateFile(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.
@@ -797,7 +760,7 @@ NativeWriteReparse(
TclWinConvertError(GetLastError());
CloseHandle(hFile);
- (*tclWinProcs->removeDirectoryProc)(linkDirPath);
+ RemoveDirectory(linkDirPath);
return -1;
}
CloseHandle(hFile);
@@ -810,6 +773,55 @@ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+}
+
+/*
*---------------------------------------------------------------------------
*
* TclpFindExecutable --
@@ -828,28 +840,33 @@ NativeWriteReparse(
void
TclpFindExecutable(
- const char *argv0) /* The value of the application's argv[0]
- * (native). */
+ const char *argv0) /* If NULL, install PanicMessageBox, otherwise
+ * ignore. */
{
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.
+ * create this process. Only if it is NULL, install a new panic handler.
*/
- if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) {
- GetModuleFileNameA(NULL, name, sizeof(name));
+ if (argv0 == NULL) {
+ Tcl_SetPanicProc(tclWinDebugPanic);
+ }
- /*
- * Convert to WCHAR to get out of ANSI codepage
- */
+#ifdef UNICODE
+ GetModuleFileNameW(NULL, wName, MAX_PATH);
+#else
+ GetModuleFileNameA(NULL, name, sizeof(name));
- MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
- }
+ /*
+ * Convert to WCHAR to get out of ANSI codepage
+ */
- WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL,NULL);
+ MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
+#endif
+ WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
TclWinNoBackslash(name);
TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
}
@@ -895,6 +912,7 @@ TclpMatchInDirectory(
if (pattern == NULL || (*pattern == '\0')) {
Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+
if (norm != NULL) {
/*
* Match a single file directly.
@@ -902,23 +920,16 @@ TclpMatchInDirectory(
int len;
DWORD attr;
+ WIN32_FILE_ATTRIBUTE_DATA data;
const char *str = Tcl_GetStringFromObj(norm,&len);
- native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
+ native = Tcl_FSGetNativePath(pathPtr);
- 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;
+ if (GetFileAttributesEx(native,
+ GetFileExInfoStandard, &data) != TRUE) {
+ return TCL_OK;
}
+ attr = data.dwFileAttributes;
if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
@@ -928,7 +939,7 @@ TclpMatchInDirectory(
} else {
DWORD attr;
HANDLE handle;
- WIN32_FIND_DATAT data;
+ WIN32_FIND_DATA data;
const char *dirName; /* UTF-8 dir name, later with pattern
* appended. */
int dirLength;
@@ -957,9 +968,10 @@ TclpMatchInDirectory(
if (native == NULL) {
return TCL_OK;
}
- attr = (*tclWinProcs->getFileAttributesProc)(native);
+ attr = GetFileAttributes(native);
- if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
+ if ((attr == INVALID_FILE_ATTRIBUTES)
+ || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
return TCL_OK;
}
@@ -998,21 +1010,21 @@ TclpMatchInDirectory(
}
native = Tcl_WinUtfToTChar(dirName, -1, &ds);
- if (tclWinProcs->findFirstFileExProc == NULL || (types == NULL)
- || (types->type != TCL_GLOB_TYPE_DIR)) {
- handle = (*tclWinProcs->findFirstFileProc)(native, &data);
+ if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) {
+ handle = FindFirstFile(native, &data);
} else {
/*
* We can be more efficient, for pure directory requests.
*/
- handle = (*tclWinProcs->findFirstFileExProc)(native,
+ handle = FindFirstFileEx(native,
FindExInfoStandard, &data,
FindExSearchLimitToDirectories, NULL, 0);
}
if (handle == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
+
Tcl_DStringFree(&ds);
if (err == ERROR_FILE_NOT_FOUND) {
/*
@@ -1069,14 +1081,8 @@ TclpMatchInDirectory(
int checkDrive = 0, isDrive;
DWORD attr;
- if (tclWinProcs->useWide) {
- native = (const TCHAR *) data.w.cFileName;
- attr = data.w.dwFileAttributes;
- } else {
- native = (const TCHAR *) data.a.cFileName;
- attr = data.a.dwFileAttributes;
- }
-
+ native = data.cFileName;
+ attr = data.dwFileAttributes;
utfname = Tcl_WinTCharToUtf(native, -1, &ds);
if (!matchSpecialDots) {
@@ -1119,6 +1125,7 @@ TclpMatchInDirectory(
if (checkDrive) {
const char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
Tcl_DStringLength(&ds));
+
isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
Tcl_DStringSetLength(&dsOrig, dirLength);
} else {
@@ -1136,7 +1143,7 @@ TclpMatchInDirectory(
*/
Tcl_DStringFree(&ds);
- } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE);
+ } while (FindNextFile(handle, &data) == TRUE);
FindClose(handle);
Tcl_DStringFree(&dsOrig);
@@ -1309,81 +1316,80 @@ NativeMatchType(
* If invisible, don't return the file.
*/
- if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
+ return !(attr & FILE_ATTRIBUTE_HIDDEN && !isDrive);
+ }
+
+ if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
+ /*
+ * If invisible.
+ */
+
+ if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
return 0;
}
} else {
- if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
- /*
- * If invisible.
- */
-
- if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
- return 0;
- }
- } else {
- /*
- * Visible.
- */
+ /*
+ * Visible.
+ */
- if (types->perm & TCL_GLOB_PERM_HIDDEN) {
- return 0;
- }
+ if (types->perm & TCL_GLOB_PERM_HIDDEN) {
+ return 0;
}
+ }
- 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 != 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;
+ if ((types->type & TCL_GLOB_TYPE_DIR)
+ && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
+ /*
+ * Quicker test for directory, which is a common case.
+ */
- } else if (types->type != 0) {
- unsigned short st_mode;
- int isExec = NativeIsExec(nativeName);
+ return 1;
- st_mode = NativeStatMode(attr, 0, isExec);
+ } else if (types->type != 0) {
+ unsigned short st_mode;
+ int isExec = NativeIsExec(nativeName);
- /*
- * In order bcdpfls as in 'find -t'
- */
+ st_mode = NativeStatMode(attr, 0, isExec);
+
+ /*
+ * 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;
@@ -1410,80 +1416,56 @@ NativeMatchType(
*----------------------------------------------------------------------
*/
-char *
+const 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. */
{
- char *result;
- HINSTANCE netapiInst;
+ 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];
- 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
+ * "{Windows Drive}:/users/default".
+ */
- netapiInst = LoadLibraryA("netapi32.dll");
- if (netapiInst != NULL) {
- NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
- NETGETDCNAMEPROC *netGetDCNameProc;
- NETUSERGETINFOPROC *netUserGetInfoProc;
-
- netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
- GetProcAddress(netapiInst, "NetApiBufferFree");
- netGetDCNameProc = (NETGETDCNAMEPROC *)
- GetProcAddress(netapiInst, "NetGetDCName");
- netUserGetInfoProc = (NETUSERGETINFOPROC *)
- GetProcAddress(netapiInst, "NetUserGetInfo");
- if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
- && (netApiBufferFreeProc != 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
- * "{Windows Drive}:/users/default".
- */
-
- GetWindowsDirectoryW(buf, MAX_PATH);
- Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
- Tcl_DStringAppend(bufferPtr, "/users/default", -1);
- }
- result = Tcl_DStringValue(bufferPtr);
- (*netApiBufferFreeProc)((void *) uiPtr);
- }
- Tcl_DStringFree(&ds);
- }
- if (wDomain != NULL) {
- (*netApiBufferFreeProc)((void *) wDomain);
+ GetWindowsDirectoryW(buf, MAX_PATH);
+ Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
+ Tcl_DStringAppend(bufferPtr, "/users/default", -1);
}
+ result = Tcl_DStringValue(bufferPtr);
+ NetApiBufferFree((void *) uiPtr);
}
- FreeLibrary(netapiInst);
+ Tcl_DStringFree(&ds);
+ }
+ if (wDomain != NULL) {
+ NetApiBufferFree((void *) wDomain);
}
if (result == NULL) {
/*
@@ -1539,15 +1521,23 @@ NativeAccess(
{
DWORD attr;
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = GetFileAttributes(nativePath);
- if (attr == 0xffffffff) {
+ if (attr == INVALID_FILE_ATTRIBUTES) {
/*
- * File doesn't exist.
+ * File might not exist.
*/
- TclWinConvertError(GetLastError());
- return -1;
+ WIN32_FIND_DATA ffd;
+ HANDLE hFind;
+ hFind = FindFirstFile(nativePath, &ffd);
+ if (hFind != INVALID_HANDLE_VALUE) {
+ attr = ffd.dwFileAttributes;
+ FindClose(hFind);
+ } else {
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
}
if (mode == F_OK) {
@@ -1594,7 +1584,8 @@ NativeAccess(
* what permissions the OS has set for a file.
*/
- if (tclWinProcs->getFileSecurityProc != NULL) {
+#ifdef UNICODE
+ {
SECURITY_DESCRIPTOR *sdPtr = NULL;
unsigned long size;
PSID pSid = 0;
@@ -1609,11 +1600,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;
- (*tclWinProcs->getFileSecurityProc)(nativePath,
+ GetFileSecurity(nativePath,
OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION,
0, 0, &size);
@@ -1647,7 +1638,7 @@ NativeAccess(
* Call GetFileSecurity() for real.
*/
- if (!(*tclWinProcs->getFileSecurityProc)(nativePath,
+ if (!GetFileSecurity(nativePath,
OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION,
sdPtr, size, &size)) {
@@ -1683,14 +1674,14 @@ NativeAccess(
* thread token.
*/
- if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) {
+ if (!ImpersonateSelf(SecurityImpersonation)) {
/*
* Unable to perform security impersonation.
*/
goto accessError;
}
- if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread(),
+ if (!OpenThreadToken(GetCurrentThread(),
TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) {
/*
* Unable to get current thread's token.
@@ -1699,7 +1690,7 @@ NativeAccess(
goto accessError;
}
- (*tclWinProcs->revertToSelfProc)();
+ RevertToSelf();
/*
* Setup desiredAccess according to the access priveleges we are
@@ -1726,7 +1717,7 @@ NativeAccess(
* Perform access check using the token.
*/
- if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess,
+ if (!AccessCheck(sdPtr, hToken, desiredAccess,
&genMap, &privSet, &privSetSize, &grantedAccess,
&accessYesNo)) {
/*
@@ -1756,6 +1747,7 @@ NativeAccess(
}
}
+#endif /* !UNICODE */
return 0;
}
@@ -1775,55 +1767,22 @@ NativeAccess(
static int
NativeIsExec(
- const TCHAR *nativePath)
+ const TCHAR *path)
{
- if (tclWinProcs->useWide) {
- const WCHAR *path = (const WCHAR *) nativePath;
- int len = wcslen(path);
-
- if (len < 5) {
- 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;
+ int len = _tcslen(path);
- /*
- * 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 (len < 5) {
+ return 0;
+ }
- if ((strcasecmp(p, "exe") == 0)
- || (strcasecmp(p, "com") == 0)
- || (strcasecmp(p, "bat") == 0)) {
- /*
- * File that ends with .exe, .com, or .bat is executable.
- */
+ if (path[len-4] != TEXT('.')) {
+ return 0;
+ }
- return 1;
- }
- }
+ 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 0;
}
@@ -1851,9 +1810,9 @@ TclpObjChdir(
int result;
const TCHAR *nativePath;
- nativePath = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
+ nativePath = Tcl_FSGetNativePath(pathPtr);
- result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
+ result = SetCurrentDirectory(nativePath);
if (result == 0) {
TclWinConvertError(GetLastError());
@@ -1890,10 +1849,11 @@ TclpGetCwd(
Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
* name of current directory. */
{
- WCHAR buffer[MAX_PATH];
+ TCHAR buffer[MAX_PATH];
char *p;
+ WCHAR *native;
- if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
+ if (GetCurrentDirectory(MAX_PATH, buffer) == 0) {
TclWinConvertError(GetLastError());
if (interp != NULL) {
Tcl_AppendResult(interp, "error getting working directory name: ",
@@ -1906,25 +1866,12 @@ TclpGetCwd(
* Watch for the weird Windows c:\\UNC syntax.
*/
- 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);
+ native = (WCHAR *) buffer;
+ if ((native[0] != '\0') && (native[1] == ':')
+ && (native[2] == '\\') && (native[3] == '\\')) {
+ native += 2;
}
+ Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
/*
* Convert to forward slashes for easier use in scripts.
@@ -1951,8 +1898,7 @@ TclpObjStat(
TclWinFlushDirtyChannels();
- return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr),
- statPtr, 0);
+ return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 0);
}
/*
@@ -1998,7 +1944,7 @@ NativeStat(
* simpler routines.
*/
- fileHandle = (tclWinProcs->createFileProc)(nativePath, GENERIC_READ,
+ fileHandle = CreateFile(nativePath, GENERIC_READ,
FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
@@ -2037,66 +1983,37 @@ NativeStat(
*/
inode = data.nFileIndexHigh | data.nFileIndexLow;
- } else if (tclWinProcs->getFileAttributesExProc != NULL) {
+ } else {
/*
* Fall back on the less capable routines. This means no nlink or ino.
*/
WIN32_FILE_ATTRIBUTE_DATA data;
- if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
+ if (GetFileAttributesEx(nativePath,
GetFileExInfoStandard, &data) != TRUE) {
- Tcl_SetErrno(ENOENT);
- return -1;
- }
-
- attr = data.dwFileAttributes;
-
- statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
- (((Tcl_WideInt) data.nFileSizeHigh) << 32);
- 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.
+ * We might have just been denied access
*/
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
- if (attr == INVALID_FILE_ATTRIBUTES) {
+ WIN32_FIND_DATA ffd;
+ HANDLE hFind = FindFirstFile(nativePath, &ffd);
+
+ if (hFind == INVALID_HANDLE_VALUE) {
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);
+ memcpy(&data, &ffd, sizeof(data));
+ FindClose(hFind);
}
- attr = data.a.dwFileAttributes;
+ attr = data.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);
+ statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
+ (((Tcl_WideInt) data.nFileSizeHigh) << 32);
+ statPtr->st_atime = ToCTime(data.ftLastAccessTime);
+ statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
+ statPtr->st_ctime = ToCTime(data.ftCreationTime);
}
dev = NativeDev(nativePath);
@@ -2128,14 +2045,12 @@ NativeDev(
{
int dev;
Tcl_DString ds;
- WCHAR nativeFullPath[MAX_PATH];
+ TCHAR nativeFullPath[MAX_PATH];
TCHAR *nativePart;
const char *fullPath;
- (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH,
- nativeFullPath, &nativePart);
-
- fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
+ GetFullPathName(nativePath, MAX_PATH, nativeFullPath, &nativePart);
+ fullPath = Tcl_WinTCharToUtf(nativeFullPath, -1, &ds);
if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
const char *p;
@@ -2158,8 +2073,7 @@ NativeDev(
}
nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
dw = (DWORD) -1;
- (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
- NULL, NULL, NULL, 0);
+ GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0);
/*
* GetFullPathName() turns special devices like "NUL" into "\\.\NUL",
@@ -2271,8 +2185,9 @@ 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;
}
@@ -2302,34 +2217,20 @@ ClientData
TclpGetNativeCwd(
ClientData clientData)
{
- WCHAR buffer[MAX_PATH];
+ TCHAR buffer[MAX_PATH];
- if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
+ if (GetCurrentDirectory(MAX_PATH, buffer) == 0) {
TclWinConvertError(GetLastError());
return NULL;
}
if (clientData != NULL) {
- 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;
- }
+ if (_tcscmp((const TCHAR*)clientData, buffer) == 0) {
+ return clientData;
}
}
- return TclNativeDupInternalRep((ClientData) buffer);
+ return TclNativeDupInternalRep(buffer);
}
int
@@ -2337,7 +2238,7 @@ TclpObjAccess(
Tcl_Obj *pathPtr,
int mode)
{
- return NativeAccess((const TCHAR *) Tcl_FSGetNativePath(pathPtr), mode);
+ return NativeAccess(Tcl_FSGetNativePath(pathPtr), mode);
}
int
@@ -2353,8 +2254,7 @@ TclpObjLstat(
TclWinFlushDirtyChannels();
- return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr),
- statPtr, 1);
+ return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 1);
}
#ifdef S_IFLNK
@@ -2366,15 +2266,15 @@ TclpObjLink(
{
if (toPtr != NULL) {
int res;
- TCHAR *LinkTarget;
- TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr);
+ const TCHAR *LinkTarget;
+ const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr);
Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr);
if (normalizedToPtr == NULL) {
return NULL;
}
- LinkTarget = (TCHAR *) Tcl_FSGetNativePath(normalizedToPtr);
+ LinkTarget = Tcl_FSGetNativePath(normalizedToPtr);
if (LinkSource == NULL || LinkTarget == NULL) {
return NULL;
@@ -2386,7 +2286,7 @@ TclpObjLink(
return NULL;
}
} else {
- TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr);
+ const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr);
if (LinkSource == NULL) {
return NULL;
@@ -2394,7 +2294,7 @@ TclpObjLink(
return WinReadLink(LinkSource);
}
}
-#endif
+#endif /* S_IFLNK */
/*
*---------------------------------------------------------------------------
@@ -2420,7 +2320,7 @@ TclpFilesystemPathType(
{
#define VOL_BUF_SIZE 32
int found;
- WCHAR volType[VOL_BUF_SIZE];
+ TCHAR volType[VOL_BUF_SIZE];
char *firstSeparator;
const char *path;
Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
@@ -2435,16 +2335,14 @@ TclpFilesystemPathType(
firstSeparator = strchr(path, '/');
if (firstSeparator == NULL) {
- found = tclWinProcs->getVolumeInformationProc(
- Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL,
- (WCHAR *) volType, VOL_BUF_SIZE);
+ found = GetVolumeInformation(Tcl_FSGetNativePath(pathPtr),
+ NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
} else {
Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
Tcl_IncrRefCount(driveName);
- found = tclWinProcs->getVolumeInformationProc(
- Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL,
- (WCHAR *) volType, VOL_BUF_SIZE);
+ found = GetVolumeInformation(Tcl_FSGetNativePath(driveName),
+ NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
Tcl_DecrRefCount(driveName);
}
@@ -2454,7 +2352,7 @@ TclpFilesystemPathType(
Tcl_DString ds;
Tcl_Obj *objPtr;
- Tcl_WinTCharToUtf((const char *) volType, -1, &ds);
+ Tcl_WinTCharToUtf(volType, -1, &ds);
objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
@@ -2508,6 +2406,8 @@ 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);
@@ -2518,11 +2418,11 @@ TclpObjNormalizePath(
* 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.
+ *
+ * FIXME: This code branch may be derelict as those are not supported
+ * platforms any more.
*/
- int isDrive = 1;
- Tcl_DString ds;
-
currentPathEndPosition = path + nextCheckpoint;
if (*currentPathEndPosition == '/') {
currentPathEndPosition++;
@@ -2602,7 +2502,7 @@ TclpObjNormalizePath(
* path segment and continue
*/
- Tcl_DStringAppend(&dsNorm, (TCHAR *)
+ Tcl_DStringAppend(&dsNorm, (const char *)
(nativePath + Tcl_DStringLength(&ds)-dotLen),
dotLen);
} else {
@@ -2610,7 +2510,7 @@ TclpObjNormalizePath(
* Normal path.
*/
- WIN32_FIND_DATA fData;
+ WIN32_FIND_DATAA fData;
HANDLE handle;
handle = FindFirstFileA(nativePath, &fData);
@@ -2665,9 +2565,6 @@ TclpObjNormalizePath(
* We're on WinNT (or 2000 or XP; something with an NT core).
*/
- int isDrive = 1;
- Tcl_DString ds;
-
currentPathEndPosition = path + nextCheckpoint;
if (*currentPathEndPosition == '/') {
currentPathEndPosition++;
@@ -2681,10 +2578,10 @@ TclpObjNormalizePath(
*/
WIN32_FILE_ATTRIBUTE_DATA data;
- const char *nativePath = Tcl_WinUtfToTChar(path,
+ const TCHAR *nativePath = Tcl_WinUtfToTChar(path,
currentPathEndPosition - path, &ds);
- if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
+ if (GetFileAttributesEx(nativePath,
GetFileExInfoStandard, &data) != TRUE) {
/*
* File doesn't exist.
@@ -2708,7 +2605,8 @@ TclpObjNormalizePath(
((WCHAR *) nativePath)[i] = wc;
}
}
- Tcl_DStringAppend(&dsNorm, nativePath,
+ Tcl_DStringAppend(&dsNorm,
+ (const char *)nativePath,
(int)(sizeof(WCHAR) * len));
lastValidPathEnd = currentPathEndPosition;
}
@@ -2741,7 +2639,7 @@ TclpObjNormalizePath(
* not be normalized, otherwise we could use:
*
* Tcl_GetStringFromObj(to, &pathLen);
- * nextCheckpoint = pathLen
+ * nextCheckpoint = pathLen;
*
* So, instead we have to start from the beginning.
*/
@@ -2771,7 +2669,6 @@ TclpObjNormalizePath(
isDrive = 1;
Tcl_DStringFree(&dsNorm);
- Tcl_DStringInit(&dsNorm);
Tcl_DStringFree(&ds);
continue;
}
@@ -2786,11 +2683,12 @@ TclpObjNormalizePath(
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_DStringAppend(&dsNorm, (const char *)nativePath,
Tcl_DStringLength(&ds));
} else {
char *checkDots = NULL;
@@ -2815,9 +2713,10 @@ TclpObjNormalizePath(
* path segment and continue.
*/
- Tcl_DStringAppend(&dsNorm, (TCHAR *)
- ((WCHAR*)(nativePath + Tcl_DStringLength(&ds))
- - dotLen), (int)(dotLen * sizeof(WCHAR)));
+ Tcl_DStringAppend(&dsNorm, ((const char *)nativePath)
+ + Tcl_DStringLength(&ds)
+ - (dotLen * sizeof(TCHAR)),
+ (int)(dotLen * sizeof(TCHAR)));
} else {
/*
* Normal path.
@@ -2846,12 +2745,13 @@ TclpObjNormalizePath(
FindClose(handle);
Tcl_DStringAppend(&dsNorm, (const char *) L"/",
sizeof(WCHAR));
- Tcl_DStringAppend(&dsNorm, (TCHAR *) nativeName,
+ Tcl_DStringAppend(&dsNorm,
+ (const char *) nativeName,
(int) (wcslen(nativeName)*sizeof(WCHAR)));
}
}
}
-#endif
+#endif /* !TclNORM_LONG_PATH */
Tcl_DStringFree(&ds);
lastValidPathEnd = currentPathEndPosition;
if (cur == 0) {
@@ -2875,10 +2775,10 @@ TclpObjNormalizePath(
if (1) {
WCHAR wpath[MAX_PATH];
- const char *nativePath =
+ const TCHAR *nativePath =
Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds);
- DWORD wpathlen = (*tclWinProcs->getLongPathNameProc)(
- nativePath, (TCHAR *) wpath, MAX_PATH);
+ DWORD wpathlen = GetLongPathNameProc(nativePath,
+ (TCHAR *) wpath, MAX_PATH);
/*
* We have to make the drive letter uppercase.
@@ -2887,10 +2787,11 @@ TclpObjNormalizePath(
if (wpath[0] >= L'a') {
wpath[0] -= (L'a' - L'A');
}
- Tcl_DStringAppend(&dsNorm, (TCHAR*)wpath, wpathlen*sizeof(WCHAR));
+ Tcl_DStringAppend(&dsNorm, (const char *) wpath,
+ wpathlen * sizeof(WCHAR));
Tcl_DStringFree(&ds);
}
-#endif
+#endif /* TclNORM_LONG_PATH */
}
/*
@@ -2905,11 +2806,9 @@ TclpObjNormalizePath(
* native encoding, so we have to convert it to Utf.
*/
- Tcl_DString dsTemp;
-
- Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm),
- Tcl_DStringLength(&dsNorm), &dsTemp);
- nextCheckpoint = Tcl_DStringLength(&dsTemp);
+ Tcl_WinTCharToUtf((const TCHAR *) Tcl_DStringValue(&dsNorm),
+ Tcl_DStringLength(&dsNorm), &ds);
+ nextCheckpoint = Tcl_DStringLength(&ds);
if (*lastValidPathEnd != 0) {
/*
* Not the end of the string.
@@ -2919,7 +2818,7 @@ TclpObjNormalizePath(
char *path;
Tcl_Obj *tmpPathPtr;
- tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
nextCheckpoint);
Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
path = Tcl_GetStringFromObj(tmpPathPtr, &len);
@@ -2930,10 +2829,9 @@ TclpObjNormalizePath(
* End of string was reached above.
*/
- Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),
- nextCheckpoint);
+ Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint);
}
- Tcl_DStringFree(&dsTemp);
+ Tcl_DStringFree(&ds);
}
Tcl_DStringFree(&dsNorm);
@@ -2945,6 +2843,7 @@ TclpObjNormalizePath(
if (temp != NULL) {
Tcl_DecrRefCount(temp);
}
+
return nextCheckpoint;
}
@@ -3084,7 +2983,7 @@ TclpNativeToNormalized(
int len;
char *copy, *p;
- Tcl_WinTCharToUtf((const char *) clientData, -1, &ds);
+ Tcl_WinTCharToUtf((const TCHAR *) clientData, -1, &ds);
copy = Tcl_DStringValue(&ds);
len = Tcl_DStringLength(&ds);
@@ -3179,17 +3078,13 @@ TclNativeCreateNativeRep(
}
}
Tcl_WinUtfToTChar(str, len, &ds);
- if (tclWinProcs->useWide) {
- len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
- } else {
- len = Tcl_DStringLength(&ds) + sizeof(char);
- }
+ len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
Tcl_DecrRefCount(validPathPtr);
- nativePathPtr = ckalloc((unsigned) len);
+ nativePathPtr = ckalloc(len);
memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
Tcl_DStringFree(&ds);
- return (ClientData) nativePathPtr;
+ return nativePathPtr;
}
/*
@@ -3220,23 +3115,11 @@ TclNativeDupInternalRep(
return NULL;
}
- 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);
- }
+ len = sizeof(TCHAR) * (_tcslen((const TCHAR *) clientData) + 1);
- copy = (char *) ckalloc(len);
+ copy = ckalloc(len);
memcpy(copy, clientData, len);
- return (ClientData) copy;
+ return copy;
}
/*
@@ -3271,9 +3154,9 @@ TclpUtime(
FromCTime(tval->actime, &lastAccessTime);
FromCTime(tval->modtime, &lastModTime);
- native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
+ native = Tcl_FSGetNativePath(pathPtr);
- attr = (*tclWinProcs->getFileAttributesProc)(native);
+ attr = GetFileAttributes(native);
if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {
flags = FILE_FLAG_BACKUP_SEMANTICS;
@@ -3284,8 +3167,8 @@ TclpUtime(
* savings complications that utime gets wrong.
*/
- fileHandle = (tclWinProcs->createFileProc)(native, FILE_WRITE_ATTRIBUTES,
- 0, NULL, OPEN_EXISTING, flags, NULL);
+ fileHandle = CreateFile(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 a1087c9..fb53685 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -83,12 +83,12 @@ typedef struct {
#define NUMPLATFORMS 4
-static char* platforms[NUMPLATFORMS] = {
+static const char *const platforms[NUMPLATFORMS] = {
"Win32s", "Windows 95", "Windows NT", "Windows CE"
};
#define NUMPROCESSORS 11
-static char* processors[NUMPROCESSORS] = {
+static const char *const processors[NUMPROCESSORS] = {
"intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
"amd64", "ia32_on_win64"
};
@@ -101,8 +101,8 @@ static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir;
static ProcessGlobalValue defaultLibraryDir =
{0, 0, NULL, NULL, InitializeDefaultLibraryDir, 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);
/*
*---------------------------------------------------------------------------
@@ -178,7 +178,7 @@ TclpInitLibraryPath(
#define LIBRARY_SIZE 32
Tcl_Obj *pathPtr;
char installLib[LIBRARY_SIZE];
- char *bytes;
+ const char *bytes;
pathPtr = Tcl_NewObj();
@@ -208,7 +208,7 @@ TclpInitLibraryPath(
*encodingPtr = NULL;
bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1);
+ *valuePtr = ckalloc((*lengthPtr) + 1);
memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
Tcl_DecrRefCount(pathPtr);
}
@@ -235,14 +235,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;
/*
@@ -288,7 +288,7 @@ AppendEnvironment(
*/
if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
- CONST char *str;
+ const char *str;
/*
* TCL_LIBRARY is set but refers to a different tcl installation
@@ -306,7 +306,7 @@ AppendEnvironment(
objPtr = Tcl_NewStringObj(buf, -1);
}
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- ckfree((char *) pathv);
+ ckfree(pathv);
}
}
@@ -355,7 +355,7 @@ InitializeDefaultLibraryDir(
TclWinNoBackslash(name);
sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
*lengthPtr = strlen(name);
- *valuePtr = ckalloc((unsigned int) *lengthPtr + 1);
+ *valuePtr = ckalloc(*lengthPtr + 1);
*encodingPtr = NULL;
memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}
@@ -378,7 +378,7 @@ InitializeDefaultLibraryDir(
static int
ToUtf(
- CONST WCHAR *wSrc,
+ const WCHAR *wSrc,
char *dst)
{
char *start;
@@ -395,31 +395,6 @@ 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
@@ -455,15 +430,13 @@ TclpSetInitialEncodings(void)
void
TclpSetInterfaces(void)
{
- int platformId, useWide;
+ int useWide;
- platformId = TclWinGetPlatformId();
- useWide = ((platformId == VER_PLATFORM_WIN32_NT)
- || (platformId == VER_PLATFORM_WIN32_CE));
+ useWide = (TclWinGetPlatformId() != VER_PLATFORM_WIN32_WINDOWS);
TclWinSetInterfaces(useWide);
}
-CONST char *
+const char *
Tcl_GetEncodingNameFromEnvironment(
Tcl_DString *bufPtr)
{
@@ -495,7 +468,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;
@@ -503,7 +476,7 @@ TclpSetVariables(
} sys;
OSVERSIONINFOA osInfo;
Tcl_DString ds;
- WCHAR szUserName[UNLEN+1];
+ TCHAR szUserName[UNLEN+1];
DWORD cchUserNameLen = UNLEN;
Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
@@ -577,15 +550,21 @@ TclpSetVariables(
Tcl_DStringInit(&ds);
if (TclGetEnv("USERNAME", &ds) == NULL) {
- if (tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen) != 0) {
+ if (GetUserName(szUserName, &cchUserNameLen) != 0) {
int cbUserNameLen = cchUserNameLen - 1;
- if (tclWinProcs->useWide) cbUserNameLen *= sizeof(WCHAR);
- Tcl_WinTCharToUtf((LPTSTR)szUserName, cbUserNameLen, &ds);
+ cbUserNameLen *= sizeof(TCHAR);
+ Tcl_WinTCharToUtf(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);
}
/*
@@ -610,7 +589,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
@@ -618,7 +597,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;
@@ -627,7 +606,7 @@ TclpFindVariable(
*/
length = strlen(name);
- nameUpper = (char *) ckalloc((unsigned) length+1);
+ nameUpper = ckalloc(length + 1);
memcpy(nameUpper, name, (size_t) length+1);
Tcl_UtfToUpper(nameUpper);
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index a76865d..882b811 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -15,14 +15,6 @@
#include "tclInt.h"
/*
- * 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.
@@ -35,117 +27,11 @@
#define VER_PLATFORM_WIN32_CE 3
#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;
+#ifdef _WIN64
+# define TCL_I_MODIFIER "I"
+#else
+# define TCL_I_MODIFIER ""
+#endif
/*
* Declarations of functions that are not accessible by way of the
@@ -153,7 +39,7 @@ MODULE_SCOPE TclWinProcs *tclWinProcs;
*/
MODULE_SCOPE char TclWinDriveLetterForVolMountPoint(
- CONST WCHAR *mountPoint);
+ const TCHAR *mountPoint);
MODULE_SCOPE void TclWinEncodingsCleanup();
MODULE_SCOPE void TclWinInit(HINSTANCE hInst);
MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle);
@@ -163,12 +49,11 @@ 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 void TclWinResetInterfaceEncodings();
-MODULE_SCOPE HANDLE TclWinSerialReopen(HANDLE handle, CONST TCHAR *name,
+MODULE_SCOPE HANDLE TclWinSerialReopen(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 c4d08e8..3f4d4d9 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -13,6 +13,25 @@
#include "tclWinInt.h"
+/*
+ * Mutex protecting static data in this file;
+ */
+
+static Tcl_Mutex loadMutex;
+
+/*
+ * Name of the directory in the native filesystem where DLLs used in this
+ * process are copied prior to loading.
+ */
+
+static WCHAR* dllDirectoryName = NULL;
+
+/* Static functions defined within this file */
+
+void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
+ const char* symbol);
+void UnloadFile(Tcl_LoadHandle loadHandle);
+
/*
*----------------------------------------------------------------------
@@ -45,8 +64,9 @@ TclpDlopen(
* function which should be used for this
* file. */
{
- HINSTANCE handle;
- CONST TCHAR *nativeName;
+ HINSTANCE hInstance;
+ const TCHAR *nativeName;
+ Tcl_LoadHandle handlePtr;
/*
* First try the full path the user gave us. This is particularly
@@ -55,9 +75,9 @@ TclpDlopen(
*/
nativeName = Tcl_FSGetNativePath(pathPtr);
- handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
+ hInstance = LoadLibraryEx(nativeName, NULL,
LOAD_WITH_ALTERED_SEARCH_PATH);
- if (handle == NULL) {
+ if (hInstance == 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
@@ -65,17 +85,15 @@ TclpDlopen(
*/
Tcl_DString ds;
- char *fileName = Tcl_GetString(pathPtr);
+ const char *fileName = Tcl_GetString(pathPtr);
nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
- handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
+ hInstance = LoadLibraryEx(nativeName, NULL,
LOAD_WITH_ALTERED_SEARCH_PATH);
Tcl_DStringFree(&ds);
}
- *loadHandle = (Tcl_LoadHandle) handle;
-
- if (handle == NULL) {
+ if (hInstance == NULL) {
DWORD lastError = GetLastError();
#if 0
@@ -91,7 +109,7 @@ TclpDlopen(
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);
+ buf = ckalloc(TCL_INTEGER_SPACE + size + 1);
sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
#endif
@@ -107,20 +125,27 @@ TclpDlopen(
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_AppendResult(interp, "this library or a dependent library"
" could not be found in library path", NULL);
break;
case ERROR_PROC_NOT_FOUND:
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL);
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_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL);
Tcl_AppendResult(interp, "this library or a dependent library"
" is damaged", NULL);
break;
case ERROR_DLL_INIT_FAILED:
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL);
Tcl_AppendResult(interp, "the library initialization"
" routine failed", NULL);
break;
@@ -129,16 +154,25 @@ TclpDlopen(
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;
}
/*
*----------------------------------------------------------------------
*
- * TclpFindSymbol --
+ * FindSymbol --
*
* Looks up a symbol, by name, through a handle associated with a
* previously loaded piece of code (shared library).
@@ -151,37 +185,41 @@ TclpDlopen(
*----------------------------------------------------------------------
*/
-Tcl_PackageInitProc *
-TclpFindSymbol(
+void *
+FindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
- CONST char *symbol)
+ const char *symbol)
{
Tcl_PackageInitProc *proc = NULL;
- HINSTANCE handle = (HINSTANCE)loadHandle;
+ HINSTANCE hInstance = (HINSTANCE)(loadHandle->clientData);
/*
* For each symbol, check for both Symbol and _Symbol, since Borland
* generates C symbols with a leading '_' by default.
*/
- proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
+ proc = (void*) GetProcAddress(hInstance, symbol);
if (proc == NULL) {
Tcl_DString ds;
-
+ const char* sym2;
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, "_", 1);
- symbol = Tcl_DStringAppend(&ds, symbol, -1);
- proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
+ sym2 = Tcl_DStringAppend(&ds, symbol, -1);
+ proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
Tcl_DStringFree(&ds);
}
+ if (proc == NULL && interp != NULL) {
+ Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
+ }
return proc;
}
/*
*----------------------------------------------------------------------
*
- * TclpUnloadFile --
+ * UnloadFile --
*
* Unloads a dynamically loaded binary code file from memory. Code
* pointers in the formerly loaded file are no longer valid after calling
@@ -197,15 +235,15 @@ TclpFindSymbol(
*/
void
-TclpUnloadFile(
+UnloadFile(
Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
* TclpDlopen(). The loadHandle is a token
* that represents the loaded file. */
{
- HINSTANCE handle;
+ HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
- handle = (HINSTANCE) loadHandle;
- FreeLibrary(handle);
+ FreeLibrary(hInstance);
+ ckfree(loadHandle);
}
/*
@@ -230,7 +268,7 @@ TclpUnloadFile(
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. */
@@ -239,6 +277,99 @@ 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 */
+{
+ size_t nameLen; /* Length of the temp folder name */
+ WCHAR name[MAX_PATH]; /* Path name of the temp folder */
+ BOOL status; /* Status from Win32 API calls */
+ Tcl_Obj* fileName; /* Name of the temp file */
+ Tcl_Obj* tail; /* Tail of the source path */
+
+ /*
+ * 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 = 0;
+ if (dllDirectoryName == NULL) {
+ Tcl_MutexLock(&loadMutex);
+ if (dllDirectoryName == NULL) {
+ nameLen = GetTempPathW(MAX_PATH, name);
+ if (nameLen >= MAX_PATH-12) {
+ Tcl_SetErrno(ENAMETOOLONG);
+ nameLen = 0;
+ } else {
+ wcscpy(name+nameLen, L"TCLXXXXXXXX");
+ nameLen += 11;
+ }
+ status = 1;
+ if (nameLen != 0) {
+ DWORD id;
+ int i = 0;
+ id = GetCurrentProcessId();
+ for (;;) {
+ DWORD lastError;
+ wsprintfW(name+nameLen-8, L"%08x", id);
+ status = CreateDirectoryW(name, NULL);
+ if (status) {
+ break;
+ }
+ if ((lastError = GetLastError()) != ERROR_ALREADY_EXISTS) {
+ TclWinConvertError(lastError);
+ break;
+ } else if (++i > 256) {
+ TclWinConvertError(lastError);
+ break;
+ }
+ id *= 16777619;
+ }
+ }
+ if (status != 0) {
+ dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR));
+ wcscpy(dllDirectoryName, name);
+ }
+ }
+ Tcl_MutexUnlock(&loadMutex);
+ }
+ if (dllDirectoryName == NULL) {
+ Tcl_AppendResult(interp, "couldn't create temporary directory: ",
+ Tcl_PosixError(interp), NULL);
+ }
+ fileName = TclpNativeToNormalized(dllDirectoryName);
+ tail = TclPathPart(interp, path, TCL_PATH_TAIL);
+ if (tail == NULL) {
+ Tcl_DecrRefCount(fileName);
+ return NULL;
+ } else {
+ Tcl_AppendToObj(fileName, "/", 1);
+ Tcl_AppendObjToObj(fileName, tail);
+ return fileName;
+ }
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 1cd5823..4543b02 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -42,9 +42,6 @@ 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.
@@ -53,6 +50,7 @@ extern Tcl_NotifierProcs tclOriginalNotifier;
*/
static int notifierCount = 0;
+static const TCHAR classname[] = TEXT("TclNotifier");
TCL_DECLARE_MUTEX(notifierMutex)
/*
@@ -81,45 +79,49 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message,
ClientData
Tcl_InitNotifier(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- WNDCLASS class;
+ if (tclNotifierHooks.initNotifierProc) {
+ return tclNotifierHooks.initNotifierProc();
+ } else {
+ 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 = "TclNotifier";
- class.lpfnWndProc = NotifierProc;
- class.hIcon = NULL;
- class.hCursor = NULL;
-
- if (!RegisterClassA(&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 = classname;
+ class.lpfnWndProc = NotifierProc;
+ class.hIcon = NULL;
+ class.hCursor = NULL;
+
+ if (!RegisterClass(&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 (ClientData) tsdPtr;
+ return tsdPtr;
+ }
}
/*
@@ -143,46 +145,51 @@ void
Tcl_FinalizeNotifier(
ClientData clientData) /* Pointer to notifier data. */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+ if (tclNotifierHooks.finalizeNotifierProc) {
+ tclNotifierHooks.finalizeNotifierProc(clientData);
+ return;
+ } else {
+ 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) {
- UnregisterClassA("TclNotifier", TclWinGetTclInstance());
+ Tcl_MutexLock(&notifierMutex);
+ notifierCount--;
+ if (notifierCount == 0) {
+ UnregisterClass(classname, TclWinGetTclInstance());
+ }
+ Tcl_MutexUnlock(&notifierMutex);
}
- Tcl_MutexUnlock(&notifierMutex);
}
/*
@@ -211,27 +218,32 @@ void
Tcl_AlertNotifier(
ClientData clientData) /* Pointer to thread data. */
{
- 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 (tclNotifierHooks.alertNotifierProc) {
+ tclNotifierHooks.alertNotifierProc(clientData);
+ return;
+ } else {
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
- if (tsdPtr->hwnd) {
/*
- * We do need to lock around access to the pending flag.
+ * 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.
*/
- EnterCriticalSection(&tsdPtr->crit);
- if (!tsdPtr->pending) {
- PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
+ 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);
}
- tsdPtr->pending = 1;
- LeaveCriticalSection(&tsdPtr->crit);
- } else {
- SetEvent(tsdPtr->event);
}
}
@@ -255,52 +267,47 @@ Tcl_AlertNotifier(
void
Tcl_SetTimer(
- Tcl_Time *timePtr) /* Maximum block time, or NULL. */
+ const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
- 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;
- }
-
- /*
- * 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) {
+ if (tclNotifierHooks.setTimerProc) {
+ tclNotifierHooks.setTimerProc(timePtr);
return;
- }
-
- if (!timePtr) {
- timeout = 0;
} else {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ UINT timeout;
+
/*
- * Make sure we pass a non-zero value into the timeout argument.
- * Windows seems to get confused by zero length timers.
+ * 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.
*/
- timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
- if (timeout == 0) {
- timeout = 1;
+ 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.
+ */
+
+ 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);
}
- }
- 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);
}
}
@@ -326,29 +333,36 @@ Tcl_ServiceModeHook(
int mode) /* Either TCL_SERVICE_ALL, or
* TCL_SERVICE_NONE. */
{
- 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 (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
- tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED,
- 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
+ if (tclNotifierHooks.serviceModeHookProc) {
+ tclNotifierHooks.serviceModeHookProc(mode);
+ return;
+ } else {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
- * 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.
+ * 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.
*/
- Tcl_AlertNotifier((ClientData)tsdPtr);
+ if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
+ tsdPtr->hwnd = CreateWindow(classname, classname,
+ 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.
+ */
+
+ Tcl_AlertNotifier(tsdPtr);
+ }
}
}
@@ -416,107 +430,102 @@ NotifierProc(
int
Tcl_WaitForEvent(
- Tcl_Time *timePtr) /* Maximum block time, or NULL. */
+ const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
- 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 (tclNotifierHooks.waitForEventProc) {
+ return tclNotifierHooks.waitForEventProc(timePtr);
+ } else {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ MSG msg;
+ DWORD timeout, result;
+ int status;
- if (timePtr) {
/*
- * TIP #233 (Virtualized Time). Convert virtual domain delay to
- * real-time.
+ * Compute the timeout in milliseconds.
*/
- Tcl_Time myTime;
+ if (timePtr) {
+ /*
+ * TIP #233 (Virtualized Time). Convert virtual domain delay to
+ * real-time.
+ */
- myTime.sec = timePtr->sec;
- myTime.usec = timePtr->usec;
+ Tcl_Time myTime;
- if (myTime.sec != 0 || myTime.usec != 0) {
- (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData);
- }
+ myTime.sec = timePtr->sec;
+ myTime.usec = timePtr->usec;
- timeout = myTime.sec * 1000 + myTime.usec / 1000;
- } else {
- timeout = INFINITE;
- }
+ if (myTime.sec != 0 || myTime.usec != 0) {
+ tclScaleTimeProcPtr(&myTime, tclTimeClientData);
+ }
- /*
- * 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.
- */
+ timeout = myTime.sec * 1000 + myTime.usec / 1000;
+ } else {
+ timeout = INFINITE;
+ }
- 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.
+ * 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.
*/
- 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;
- }
- }
+ 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.
+ */
- /*
- * Check to see if there are any messages to process.
- */
+ 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;
+ }
+ }
- if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
/*
- * Retrieve and dispatch the first message.
+ * Check to see if there are any messages to process.
*/
- 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) {
+ if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
/*
- * We got an error from the system. I have no idea why this would
- * happen, so we'll just unwind.
+ * Retrieve and dispatch the first message.
*/
- status = -1;
+ 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;
+ }
} else {
- TranslateMessage(&msg);
- DispatchMessage(&msg);
- status = 1;
+ status = 0;
}
- } else {
- status = 0;
- }
- end:
- ResetEvent(tsdPtr->event);
- return status;
+ end:
+ ResetEvent(tsdPtr->event);
+ return status;
+ }
}
/*
@@ -570,11 +579,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 (;;) {
- Sleep(sleepTime);
+ SleepEx(sleepTime, TRUE);
Tcl_GetTime(&now);
if (now.sec > desired.sec) {
break;
@@ -585,7 +594,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 b29dde4..f1b18df 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -194,7 +194,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(WCHAR name[MAX_PATH]);
+static int TempFileName(TCHAR name[MAX_PATH]);
static int WaitForRead(PipeInfo *infoPtr, int blocking);
static void PipeThreadActionProc(ClientData instanceData,
int action);
@@ -204,7 +204,7 @@ static void PipeThreadActionProc(ClientData instanceData,
* I/O.
*/
-static Tcl_ChannelType pipeChannelType = {
+static const Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
TCL_CLOSE2PROC, /* Close proc. */
@@ -221,7 +221,7 @@ static Tcl_ChannelType pipeChannelType = {
NULL, /* handler proc. */
NULL, /* wide seek proc */
PipeThreadActionProc, /* thread action proc */
- NULL, /* truncate */
+ NULL /* truncate */
};
/*
@@ -406,7 +406,7 @@ PipeCheckProc(
if (needEvent) {
infoPtr->flags |= PIPE_PENDING;
- evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
+ evPtr = ckalloc(sizeof(PipeEvent));
evPtr->header.proc = PipeEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -437,7 +437,7 @@ TclWinMakeFile(
{
WinFile *filePtr;
- filePtr = (WinFile *) ckalloc(sizeof(WinFile));
+ filePtr = ckalloc(sizeof(WinFile));
filePtr->type = WIN_FILE;
filePtr->handle = handle;
@@ -466,27 +466,18 @@ TclWinMakeFile(
static int
TempFileName(
- WCHAR name[MAX_PATH]) /* Buffer in which name for temporary file
+ TCHAR name[MAX_PATH]) /* Buffer in which name for temporary file
* gets stored. */
{
- 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) {
+ const TCHAR *prefix = TEXT("TCL");
+ if (GetTempPath(MAX_PATH, name) != 0) {
+ if (GetTempFileName(name, prefix, 0, name) != 0) {
return 1;
}
}
- 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);
+ name[0] = '.';
+ name[1] = '\0';
+ return GetTempFileName(name, prefix, 0, name);
}
/*
@@ -598,7 +589,7 @@ TclpOpenFile(
flags = 0;
if (!(mode & O_CREAT)) {
- flags = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ flags = GetFileAttributes(nativePath);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
@@ -614,8 +605,8 @@ TclpOpenFile(
* Now we get to create the file.
*/
- handle = (*tclWinProcs->createFileProc)(nativePath, accessMode,
- shareMode, NULL, createMode, flags, NULL);
+ handle = CreateFile(nativePath, accessMode, shareMode,
+ NULL, createMode, flags, NULL);
Tcl_DStringFree(&ds);
if (handle == INVALID_HANDLE_VALUE) {
@@ -662,7 +653,7 @@ TclFile
TclpCreateTempFile(
const char *contents) /* String to write into temp file, or NULL. */
{
- WCHAR name[MAX_PATH];
+ TCHAR name[MAX_PATH];
const char *native;
Tcl_DString dstring;
HANDLE handle;
@@ -671,7 +662,7 @@ TclpCreateTempFile(
return NULL;
}
- handle = (*tclWinProcs->createFileProc)((TCHAR *) name,
+ handle = CreateFile(name,
GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);
if (handle == INVALID_HANDLE_VALUE) {
@@ -731,7 +722,7 @@ TclpCreateTempFile(
TclWinConvertError(GetLastError());
CloseHandle(handle);
- (*tclWinProcs->deleteFileProc)((TCHAR *) name);
+ DeleteFile(name);
return NULL;
}
@@ -754,13 +745,13 @@ TclpCreateTempFile(
Tcl_Obj *
TclpTempFileName(void)
{
- WCHAR fileName[MAX_PATH];
+ TCHAR fileName[MAX_PATH];
if (TempFileName(fileName) == 0) {
return NULL;
}
- return TclpNativeToNormalized((ClientData) fileName);
+ return TclpNativeToNormalized(fileName);
}
/*
@@ -836,7 +827,7 @@ TclpCloseFile(
if (filePtr->handle != NULL &&
CloseHandle(filePtr->handle) == FALSE) {
TclWinConvertError(GetLastError());
- ckfree((char *) filePtr);
+ ckfree(filePtr);
return -1;
}
}
@@ -846,7 +837,7 @@ TclpCloseFile(
Tcl_Panic("TclpCloseFile: unexpected file type");
}
- ckfree((char *) filePtr);
+ ckfree(filePtr);
return 0;
}
@@ -947,7 +938,7 @@ TclpCreateProcess(
{
int result, applType, createFlags;
Tcl_DString cmdLine; /* Complete command line (TCHAR). */
- STARTUPINFOA startInfo;
+ STARTUPINFO startInfo;
PROCESS_INFORMATION procInfo;
SECURITY_ATTRIBUTES secAtts;
HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
@@ -1136,82 +1127,12 @@ TclpCreateProcess(
}
if (applType == APPL_DOS) {
- /*
- * 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);
+ Tcl_AppendResult(interp,
+ "DOS application process not supported on this platform",
+ (char *) NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP",
+ NULL);
+ goto end;
}
}
@@ -1235,7 +1156,7 @@ TclpCreateProcess(
BuildCommandLine(execPath, argc, argv, &cmdLine);
- if ((*tclWinProcs->createProcessProc)(NULL,
+ if (CreateProcess(NULL,
(TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
(DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
TclWinConvertError(GetLastError());
@@ -1368,7 +1289,7 @@ ApplicationType(
IMAGE_DOS_HEADER header;
Tcl_DString nameBuf, ds;
const TCHAR *nativeName;
- WCHAR nativeFullPath[MAX_PATH];
+ TCHAR nativeFullPath[MAX_PATH];
static char extensions[][5] = {"", ".com", ".exe", ".bat"};
/*
@@ -1394,8 +1315,8 @@ ApplicationType(
Tcl_DStringAppend(&nameBuf, extensions[i], -1);
nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),
Tcl_DStringLength(&nameBuf), &ds);
- found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL,
- MAX_PATH, nativeFullPath, &rest);
+ found = SearchPath(NULL, nativeName, NULL, MAX_PATH,
+ nativeFullPath, &rest);
Tcl_DStringFree(&ds);
if (found == 0) {
continue;
@@ -1406,11 +1327,11 @@ ApplicationType(
* known type.
*/
- attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath);
+ attr = GetFileAttributes(nativeFullPath);
if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
continue;
}
- strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
+ strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds));
Tcl_DStringFree(&ds);
ext = strrchr(fullName, '.');
@@ -1419,7 +1340,7 @@ ApplicationType(
break;
}
- hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath,
+ hFile = CreateFile(nativeFullPath,
GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
@@ -1499,9 +1420,8 @@ ApplicationType(
* application name from the arguments.
*/
- (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath,
- nativeFullPath, MAX_PATH);
- strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
+ GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH);
+ strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds));
Tcl_DStringFree(&ds);
}
return applType;
@@ -1564,6 +1484,7 @@ 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. */
@@ -1648,7 +1569,7 @@ TclpCreateCommandChannel(
{
char channelName[16 + TCL_INTEGER_SPACE];
DWORD id;
- PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));
+ PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo));
PipeInit();
@@ -1663,7 +1584,7 @@ TclpCreateCommandChannel(
infoPtr->writeBuf = 0;
infoPtr->writeBufLen = 0;
infoPtr->writeError = 0;
- infoPtr->channel = (Tcl_Channel) NULL;
+ infoPtr->channel = NULL;
infoPtr->validMask = 0;
@@ -1705,9 +1626,9 @@ TclpCreateCommandChannel(
* unique, in case channels share handles (stdin/stdout).
*/
- wsprintfA(channelName, "file%lx", infoPtr);
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
- (ClientData) infoPtr, infoPtr->validMask);
+ infoPtr, infoPtr->validMask);
/*
* Pipes have AUTO translation mode on Windows and ^Z eof char, which
@@ -1715,16 +1636,58 @@ TclpCreateCommandChannel(
* Windows programs that expect a ^Z at EOF.
*/
- Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
- "-translation", "auto");
- Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
- "-eofchar", "\032 {}");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(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_AppendResult(interp, "pipe creation failed: ",
+ Tcl_PosixError(interp), NULL);
+ 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
@@ -1765,7 +1728,7 @@ TclGetAndDetachPids(
Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
}
if (pipePtr->numPids > 0) {
- ckfree((char *) pipePtr->pidPtr);
+ ckfree(pipePtr->pidPtr);
pipePtr->numPids = 0;
}
}
@@ -2025,12 +1988,11 @@ PipeClose2Proc(
*/
if (pipePtr->errorFile) {
- WinFile *filePtr;
+ WinFile *filePtr = (WinFile *) pipePtr->errorFile;
- filePtr = (WinFile*)pipePtr->errorFile;
errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
TCL_READABLE);
- ckfree((char *) filePtr);
+ ckfree(filePtr);
} else {
errChan = NULL;
}
@@ -2040,14 +2002,14 @@ PipeClose2Proc(
}
if (pipePtr->numPids > 0) {
- ckfree((char *) pipePtr->pidPtr);
+ ckfree(pipePtr->pidPtr);
}
if (pipePtr->writeBuf != NULL) {
ckfree(pipePtr->writeBuf);
}
- ckfree((char*) pipePtr);
+ ckfree(pipePtr);
if (errorCode == 0) {
return result;
@@ -2215,7 +2177,7 @@ PipeOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
+ infoPtr->writeBuf = ckalloc(toWrite);
}
memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
@@ -2594,7 +2556,7 @@ Tcl_WaitPid(
*/
CloseHandle(infoPtr->hProcess);
- ckfree((char*)infoPtr);
+ ckfree(infoPtr);
return result;
}
@@ -2620,9 +2582,9 @@ Tcl_WaitPid(
void
TclWinAddProcess(
void *hProcess, /* Handle to process */
- unsigned long id) /* Global process identifier */
+ unsigned long id) /* Global process identifier */
{
- ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
+ ProcInfo *procPtr = ckalloc(sizeof(ProcInfo));
PipeInit();
@@ -3081,6 +3043,100 @@ 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_GetStringFromObj(basenameObj, &length);
+
+ Tcl_WinUtfToTChar(string, 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 e2cac52..e3c5a49 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -19,6 +19,19 @@
# 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
@@ -34,6 +47,10 @@ 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
@@ -45,22 +62,34 @@ 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.
*---------------------------------------------------------------------------
*/
+#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 strncasecmp
@@ -88,108 +117,158 @@ typedef DWORD_PTR * PDWORD_PTR;
#include <time.h>
/*
- * 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.
*/
-#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 */
+#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
+/* workaround for mingw-w64 bug 3407992 */
+#undef EOVERFLOW
+#define EOVERFLOW 132 /* File too big */
+#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 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 */
+#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT /* Socket type not supported */
#undef ESHUTDOWN
-#define ESHUTDOWN 143 /* Can't send after socket shutdown */
+#define ESHUTDOWN WSAESHUTDOWN /* 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 */
+#define ETOOMANYREFS WSAETOOMANYREFS /* Too many references: can't splice */
#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 */
+#define EHOSTDOWN WSAEHOSTDOWN /* Host is down */
#undef EUSERS
-#define EUSERS 94 /* Too many users (for UFS) */
+#define EUSERS WSAEUSERS /* Too many users (for UFS) */
#undef EDQUOT
-#define EDQUOT 69 /* Disc quota exceeded */
+#define EDQUOT WSAEDQUOT /* 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.
- */
-
-#undef EOVERFLOW
-#define EOVERFLOW EFBIG /* The object couldn't fit in the datatype */
+#define ESTALE WSAESTALE /* Stale NFS file handle */
/*
* Signals not known to the standard ANSI signal.h. These are used
@@ -351,9 +430,9 @@ typedef DWORD_PTR * PDWORD_PTR;
#if defined(_MSC_VER) || defined(__MINGW32__)
# define environ _environ
-# if defined(_MSC_VER) && (_MSC_VER < 1600)
+# if defined(_MSC_VER) && (_MSC_VER < 1600)
# define hypot _hypot
-# endif
+# endif
# define exception _exception
# undef EDEADLOCK
# if defined(__MINGW32__) && !defined(__MSVCRT__)
@@ -393,12 +472,6 @@ typedef DWORD_PTR * PDWORD_PTR;
/*
- * 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
* generic and windows-specific parts of Tcl. Some of the macros may
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 8eaf2a7..1390415 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -12,6 +12,10 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef STATIC_BUILD
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
#ifdef _MSC_VER
# pragma comment (lib, "advapi32.lib")
@@ -19,6 +23,17 @@
#include <stdlib.h>
/*
+ * Ensure that we can say which registry is being accessed.
+ */
+
+#ifndef KEY_WOW64_64KEY
+#define KEY_WOW64_64KEY (0x0100)
+#endif
+#ifndef KEY_WOW64_32KEY
+#define KEY_WOW64_32KEY (0x0200)
+#endif
+
+/*
* 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.
@@ -31,8 +46,8 @@
* 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
@@ -46,7 +61,7 @@
* system predefined keys.
*/
-static CONST char *rootKeyNames[] = {
+static const char *const rootKeyNames[] = {
"HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
"HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG",
"HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
@@ -57,7 +72,7 @@ static 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
@@ -65,7 +80,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 *typeNames[] = {
+static const char *const typeNames[] = {
"none", "sz", "expand_sz", "binary", "dword",
"dword_big_endian", "link", "multi_sz", "resource_list", NULL
};
@@ -73,109 +88,26 @@ static CONST char *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 *regQueryInfoKeyProc)(HKEY, TCHAR *, DWORD *, DWORD *,
- DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
- FILETIME *);
- 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, TCHAR *, DWORD *, DWORD *,
- DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
- FILETIME *)) RegQueryInfoKeyA,
- (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, TCHAR *, DWORD *, DWORD *,
- DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
- FILETIME *)) RegQueryInfoKeyW,
- (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);
+static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
+ REGSAM mode);
static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj);
+ Tcl_Obj *valueNameObj, REGSAM mode);
static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *patternObj);
+ Tcl_Obj *patternObj, REGSAM mode);
static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj);
+ Tcl_Obj *valueNameObj, REGSAM mode);
static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj);
+ Tcl_Obj *valueNameObj, REGSAM mode);
static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *patternObj);
+ Tcl_Obj *patternObj, REGSAM mode);
static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
REGSAM mode, int flags, HKEY *keyPtr);
static DWORD OpenSubKey(char *hostName, HKEY rootKey,
@@ -185,13 +117,13 @@ static int ParseKeyName(Tcl_Interp *interp, char *name,
char **hostNamePtr, HKEY *rootKeyPtr,
char **keyNamePtr);
static DWORD RecursiveDeleteKey(HKEY hStartKey,
- CONST TCHAR * pKeyName);
+ const TCHAR * pKeyName, REGSAM mode);
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);
+ Tcl_Obj *typeObj, REGSAM mode);
EXTERN int Registry_Init(Tcl_Interp *interp);
EXTERN int Registry_Unload(Tcl_Interp *interp, int flags);
@@ -222,21 +154,10 @@ Registry_Init(
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,
- (ClientData)interp, DeleteCmd);
- Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd);
- return Tcl_PkgProvide(interp, "registry", "1.2.1");
+ interp, DeleteCmd);
+ Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
+ return Tcl_PkgProvide(interp, "registry", "1.3");
}
/*
@@ -276,7 +197,7 @@ Registry_Unload(
* Delete the originally registered command.
*/
- cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
+ cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
if (cmd != NULL) {
Tcl_DeleteCommandFromToken(interp, cmd);
}
@@ -306,7 +227,8 @@ DeleteCmd(
ClientData clientData)
{
Tcl_Interp *interp = clientData;
- Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL);
+
+ Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL);
}
/*
@@ -330,89 +252,125 @@ 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 index;
- char *errString = NULL;
+ int n = 1;
+ int index, argc;
+ REGSAM mode = 0;
+ const char *errString = NULL;
- static CONST char *subcommands[] = {
+ static const char *const 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) {
- Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?");
+ wrongArgs:
+ Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index)
- != TCL_OK) {
+ 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) {
return TCL_ERROR;
}
+ argc = (objc - n);
switch (index) {
case BroadcastIdx: /* broadcast */
- return BroadcastValue(interp, objc, objv);
+ if (argc == 1 || argc == 3) {
+ int res = BroadcastValue(interp, argc, objv + n);
+
+ if (res != TCL_BREAK) {
+ return res;
+ }
+ }
+ errString = "keyName ?-timeout milliseconds?";
break;
case DeleteIdx: /* delete */
- if (objc == 3) {
- return DeleteKey(interp, objv[2]);
- } else if (objc == 4) {
- return DeleteValue(interp, objv[2], objv[3]);
+ if (argc == 1) {
+ return DeleteKey(interp, objv[n], mode);
+ } else if (argc == 2) {
+ return DeleteValue(interp, objv[n], objv[n+1], mode);
}
errString = "keyName ?valueName?";
break;
case GetIdx: /* get */
- if (objc == 4) {
- return GetValue(interp, objv[2], objv[3]);
+ if (argc == 2) {
+ return GetValue(interp, objv[n], objv[n+1], mode);
}
errString = "keyName valueName";
break;
case KeysIdx: /* keys */
- if (objc == 3) {
- return GetKeyNames(interp, objv[2], NULL);
- } else if (objc == 4) {
- return GetKeyNames(interp, objv[2], objv[3]);
+ if (argc == 1) {
+ return GetKeyNames(interp, objv[n], NULL, mode);
+ } else if (argc == 2) {
+ return GetKeyNames(interp, objv[n], objv[n+1], mode);
}
errString = "keyName ?pattern?";
break;
case SetIdx: /* set */
- if (objc == 3) {
+ if (argc == 1) {
HKEY key;
/*
* Create the key and then close it immediately.
*/
- if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
+ mode |= KEY_ALL_ACCESS;
+ if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) {
return TCL_ERROR;
}
RegCloseKey(key);
return TCL_OK;
- } else if (objc == 5 || objc == 6) {
- Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
- return SetValue(interp, objv[2], objv[3], objv[4], typeObj);
+ } 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);
}
errString = "keyName ?valueName data ?type??";
break;
case TypeIdx: /* type */
- if (objc == 4) {
- return GetType(interp, objv[2], objv[3]);
+ if (argc == 2) {
+ return GetType(interp, objv[n], objv[n+1], mode);
}
errString = "keyName valueName";
break;
case ValuesIdx: /* values */
- if (objc == 3) {
- return GetValueNames(interp, objv[2], NULL);
- } else if (objc == 4) {
- return GetValueNames(interp, objv[2], objv[3]);
+ if (argc == 1) {
+ return GetValueNames(interp, objv[n], NULL, mode);
+ } else if (argc == 2) {
+ return GetValueNames(interp, objv[n], objv[n+1], mode);
}
errString = "keyName ?pattern?";
break;
}
- Tcl_WrongNumArgs(interp, 2, objv, errString);
+ Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString);
return TCL_ERROR;
}
@@ -435,21 +393,23 @@ RegistryObjCmd(
static int
DeleteKey(
Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj) /* Name of key to delete. */
+ Tcl_Obj *keyNameObj, /* Name of key to delete. */
+ REGSAM mode) /* Mode flags to pass. */
{
char *tail, *buffer, *hostName, *keyName;
- CONST char *nativeTail;
+ const TCHAR *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_GetStringFromObj(keyNameObj, &length);
- buffer = ckalloc((unsigned int) length + 1);
+ buffer = ckalloc(length + 1);
strcpy(buffer, keyName);
if (ParseKeyName(interp, buffer, &hostName, &rootKey,
@@ -459,8 +419,9 @@ DeleteKey(
}
if (*keyName == '\0') {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "bad key: cannot delete root keys", -1));
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("bad key: cannot delete root keys", -1));
+ Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
ckfree(buffer);
return TCL_ERROR;
}
@@ -473,15 +434,15 @@ DeleteKey(
keyName = NULL;
}
- result = OpenSubKey(hostName, rootKey, keyName,
- KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey);
+ mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
+ result = OpenSubKey(hostName, rootKey, keyName, mode, 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;
}
@@ -491,7 +452,7 @@ DeleteKey(
*/
nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf);
- result = RecursiveDeleteKey(subkey, nativeTail);
+ result = RecursiveDeleteKey(subkey, nativeTail, saveMode);
Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
@@ -528,7 +489,8 @@ static int
DeleteValue(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj) /* Name of value to delete. */
+ Tcl_Obj *valueNameObj, /* Name of value to delete. */
+ REGSAM mode) /* Mode flags to pass. */
{
HKEY key;
char *valueName;
@@ -540,14 +502,14 @@ DeleteValue(
* Attempt to open the key for deletion.
*/
- if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key)
- != TCL_OK) {
+ mode |= KEY_SET_VALUE;
+ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
Tcl_WinUtfToTChar(valueName, length, &ds);
- result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds));
+ result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (result != ERROR_SUCCESS) {
Tcl_AppendResult(interp, "unable to delete value \"",
@@ -585,13 +547,14 @@ static int
GetKeyNames(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Key to enumerate. */
- Tcl_Obj *patternObj) /* Optional match pattern. */
+ Tcl_Obj *patternObj, /* Optional match pattern. */
+ REGSAM mode) /* Mode flags to pass. */
{
- char *pattern; /* Pattern being matched against subkeys */
+ const char *pattern; /* Pattern being matched against subkeys */
HKEY key; /* Handle to the key being examined */
DWORD subKeyCount; /* Number of subkeys to list */
DWORD maxSubKeyLen; /* Maximum string length of any subkey */
- char *buffer; /* Buffer to hold the subkey name */
+ TCHAR *buffer; /* Buffer to hold the subkey name */
DWORD bufSize; /* Size of the buffer */
DWORD index; /* Position of the current subkey */
char *name; /* Subkey name */
@@ -605,58 +568,50 @@ GetKeyNames(
pattern = NULL;
}
- /* Attempt to open the key for enumeration. */
+ /*
+ * Attempt to open the key for enumeration.
+ */
- if (OpenKey(interp, keyNameObj,
- KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS,
- 0, &key) != TCL_OK) {
+ mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS;
+ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
/*
- * Determine how big a buffer is needed for enumerating subkeys, and
- * how many subkeys there are
+ * Determine how big a buffer is needed for enumerating subkeys, and how
+ * many subkeys there are.
*/
- result = (*regWinProcs->regQueryInfoKeyProc)
- (key, NULL, NULL, NULL, &subKeyCount, &maxSubKeyLen, NULL, NULL,
- NULL, NULL, NULL, NULL);
+ result = RegQueryInfoKey(key, NULL, NULL, NULL,
+ &subKeyCount, &maxSubKeyLen, NULL, NULL, NULL, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
Tcl_SetObjResult(interp, Tcl_NewObj());
Tcl_AppendResult(interp, "unable to query key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
RegCloseKey(key);
return TCL_ERROR;
}
- if (regWinProcs->useWide) {
- buffer = ckalloc((maxSubKeyLen+1) * sizeof(WCHAR));
- } else {
- buffer = ckalloc(maxSubKeyLen+1);
- }
+ buffer = ckalloc((maxSubKeyLen+1) * sizeof(TCHAR));
- /* Enumerate the subkeys */
+ /*
+ * Enumerate the subkeys.
+ */
resultPtr = Tcl_NewObj();
for (index = 0; index < subKeyCount; ++index) {
bufSize = maxSubKeyLen+1;
- result = (*regWinProcs->regEnumKeyExProc)
- (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL);
+ result = RegEnumKeyEx(key, index, buffer, &bufSize,
+ NULL, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_AppendResult(interp,
- "unable to enumerate subkeys of \"",
- Tcl_GetString(keyNameObj),
- "\": ", NULL);
+ Tcl_AppendResult(interp, "unable to enumerate subkeys of \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
result = TCL_ERROR;
break;
}
- if (regWinProcs->useWide) {
- Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds);
- } else {
- Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds);
- }
+ Tcl_WinTCharToUtf(buffer, bufSize * sizeof(WCHAR), &ds);
name = Tcl_DStringValue(&ds);
if (pattern && !Tcl_StringMatch(name, pattern)) {
Tcl_DStringFree(&ds);
@@ -699,22 +654,22 @@ static int
GetType(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj) /* Name of value to get. */
+ Tcl_Obj *valueNameObj, /* Name of value to get. */
+ REGSAM mode) /* Mode flags to pass. */
{
HKEY key;
- DWORD result;
- DWORD type;
+ DWORD result, type;
Tcl_DString ds;
- char *valueName;
- CONST char *nativeValue;
+ const char *valueName;
+ const TCHAR *nativeValue;
int length;
/*
* Attempt to open the key for reading.
*/
- if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
- != TCL_OK) {
+ mode |= KEY_QUERY_VALUE;
+ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
@@ -724,7 +679,7 @@ GetType(
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
- result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
+ result = RegQueryValueEx(key, nativeValue, NULL, &type,
NULL, NULL);
Tcl_DStringFree(&ds);
RegCloseKey(key);
@@ -771,11 +726,12 @@ static int
GetValue(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj) /* Name of value to get. */
+ Tcl_Obj *valueNameObj, /* Name of value to get. */
+ REGSAM mode) /* Mode flags to pass. */
{
HKEY key;
- char *valueName;
- CONST char *nativeValue;
+ const char *valueName;
+ const TCHAR *nativeValue;
DWORD result, length, type;
Tcl_DString data, buf;
int nameLen;
@@ -784,7 +740,8 @@ GetValue(
* Attempt to open the key for reading.
*/
- if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) {
+ mode |= KEY_QUERY_VALUE;
+ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
@@ -805,7 +762,7 @@ GetValue(
valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
- result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
+ result = RegQueryValueEx(key, nativeValue, NULL, &type,
(BYTE *) Tcl_DStringValue(&data), &length);
while (result == ERROR_MORE_DATA) {
/*
@@ -816,7 +773,7 @@ GetValue(
length *= 2;
Tcl_DStringSetLength(&data, (int) length);
- result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
+ result = RegQueryValueEx(key, nativeValue,
NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
}
Tcl_DStringFree(&buf);
@@ -839,7 +796,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;
@@ -851,19 +808,17 @@ GetValue(
* we get bogus data.
*/
- while (p < end && ((regWinProcs->useWide)
- ? *((Tcl_UniChar *)p) : *p) != 0) {
+ while ((p < end)
+ && (*((Tcl_UniChar *) p)) != 0) {
+ Tcl_UniChar *up;
Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(Tcl_DStringValue(&buf),
Tcl_DStringLength(&buf)));
- if (regWinProcs->useWide) {
- Tcl_UniChar* up = (Tcl_UniChar*) p;
- while (*up++ != 0) {}
- p = (char*) up;
- } else {
- while (*p++ != '\0') {}
- }
+ up = (Tcl_UniChar *) p;
+
+ while (*up++ != 0) {}
+ p = (char *) up;
Tcl_DStringFree(&buf);
}
Tcl_SetObjResult(interp, resultPtr);
@@ -905,20 +860,21 @@ static int
GetValueNames(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Key to enumerate. */
- Tcl_Obj *patternObj) /* Optional match pattern. */
+ Tcl_Obj *patternObj, /* Optional match pattern. */
+ REGSAM mode) /* Mode flags to pass. */
{
HKEY key;
Tcl_Obj *resultPtr;
DWORD index, size, maxSize, result;
Tcl_DString buffer, ds;
- char *pattern, *name;
+ const char *pattern, *name;
/*
* Attempt to open the key for enumeration.
*/
- if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
- != TCL_OK) {
+ mode |= KEY_QUERY_VALUE;
+ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
@@ -927,7 +883,7 @@ GetValueNames(
* largest value name plus the terminating null.
*/
- result = (*regWinProcs->regQueryInfoKeyProc)(key, NULL, NULL, NULL, NULL,
+ result = RegQueryInfoKey(key, NULL, NULL, NULL, NULL,
NULL, NULL, &index, &maxSize, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
Tcl_AppendResult(interp, "unable to query key \"",
@@ -942,7 +898,7 @@ GetValueNames(
resultPtr = Tcl_NewObj();
Tcl_DStringInit(&buffer);
Tcl_DStringSetLength(&buffer,
- (int) ((regWinProcs->useWide) ? maxSize*2 : maxSize));
+ (int) (maxSize*sizeof(WCHAR)));
index = 0;
result = TCL_OK;
@@ -959,13 +915,9 @@ GetValueNames(
*/
size = maxSize;
- while ((*regWinProcs->regEnumValueProc)(key, index,
- Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL)
- == ERROR_SUCCESS) {
-
- if (regWinProcs->useWide) {
- size *= 2;
- }
+ while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer),
+ &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) {
+ size *= 2;
Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
&ds);
@@ -1022,7 +974,7 @@ OpenKey(
DWORD result;
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
- buffer = ckalloc((unsigned int) length + 1);
+ buffer = ckalloc(length + 1);
strcpy(buffer, keyName);
result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
@@ -1078,7 +1030,7 @@ OpenSubKey(
if (hostName) {
hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf);
- result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey,
+ result = RegConnectRegistry((TCHAR *)hostName, rootKey,
&rootKey);
Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS) {
@@ -1094,17 +1046,19 @@ OpenSubKey(
keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
if (flags & REG_CREATE) {
DWORD create;
- result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL,
+
+ result = RegCreateKeyEx(rootKey, (TCHAR *)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 = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode,
+ result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
keyPtr);
}
Tcl_DStringFree(&buf);
@@ -1170,6 +1124,7 @@ ParseKeyName(
if (!rootName) {
Tcl_AppendResult(interp, "bad key \"", name,
"\": must start with a valid root", NULL);
+ Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL);
return TCL_ERROR;
}
@@ -1221,12 +1176,16 @@ ParseKeyName(
static DWORD
RecursiveDeleteKey(
HKEY startKey, /* Parent of key to be deleted. */
- CONST char *keyName) /* Name of key to be deleted in external
+ const TCHAR *keyName, /* Name of key to be deleted in external
* encoding, not UTF. */
+ REGSAM mode) /* Mode flags to pass. */
{
DWORD result, size, maxSize;
Tcl_DString subkey;
HKEY hKey;
+ REGSAM saveMode = mode;
+ static int checkExProc = 0;
+ static FARPROC regDeleteKeyExProc = NULL;
/*
* Do not allow NULL or empty key name.
@@ -1236,12 +1195,12 @@ RecursiveDeleteKey(
return ERROR_BADKEY;
}
- result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0,
- KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey);
+ mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
+ result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey);
if (result != ERROR_SUCCESS) {
return result;
}
- result = (*regWinProcs->regQueryInfoKeyProc)(hKey, NULL, NULL, NULL, NULL,
+ result = RegQueryInfoKey(hKey, NULL, NULL, NULL, NULL,
&maxSize, NULL, NULL, NULL, NULL, NULL, NULL);
maxSize++;
if (result != ERROR_SUCCESS) {
@@ -1250,21 +1209,43 @@ RecursiveDeleteKey(
Tcl_DStringInit(&subkey);
Tcl_DStringSetLength(&subkey,
- (int) ((regWinProcs->useWide) ? maxSize * 2 : maxSize));
+ (int) (maxSize * sizeof(WCHAR)));
+ mode = saveMode;
while (result == ERROR_SUCCESS) {
/*
* Always get index 0 because key deletion changes ordering.
*/
size = maxSize;
- result=(*regWinProcs->regEnumKeyExProc)(hKey, 0,
- Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL);
+ result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey),
+ &size, NULL, NULL, NULL, NULL);
if (result == ERROR_NO_MORE_ITEMS) {
- result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName);
+ /*
+ * 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);
+ }
break;
} else if (result == ERROR_SUCCESS) {
- result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey));
+ result = RecursiveDeleteKey(hKey, (const TCHAR *) Tcl_DStringValue(&subkey),
+ mode);
}
}
Tcl_DStringFree(&subkey);
@@ -1296,25 +1277,26 @@ 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. */
+ Tcl_Obj *typeObj, /* Type of data to be written. */
+ REGSAM mode) /* Mode flags to pass. */
{
- int type;
+ int type, length;
DWORD result;
HKEY key;
- int length;
- char *valueName;
+ const 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);
}
- if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
+ mode |= KEY_ALL_ACCESS;
+ if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) {
return TCL_ERROR;
}
@@ -1331,7 +1313,7 @@ SetValue(
}
value = ConvertDWORD((DWORD)type, (DWORD)value);
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+ result = RegSetValueEx(key, (TCHAR *)valueName, 0,
(DWORD) type, (BYTE *) &value, sizeof(DWORD));
} else if (type == REG_MULTI_SZ) {
Tcl_DString data, buf;
@@ -1366,28 +1348,26 @@ SetValue(
Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
&buf);
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
- (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
+ result = RegSetValueEx(key, (TCHAR *)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_GetStringFromObj(dataObj, &length);
+ const char *data = Tcl_GetStringFromObj(dataObj, &length);
- data = Tcl_WinUtfToTChar(data, length, &buf);
+ data = (char *)Tcl_WinUtfToTChar(data, length, &buf);
/*
* Include the null in the length, padding if needed for Unicode.
*/
- if (regWinProcs->useWide) {
- Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
- }
+ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
length = Tcl_DStringLength(&buf) + 1;
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
- (DWORD) type, (BYTE *) data, (DWORD) length);
+ result = RegSetValueEx(key, (TCHAR *)valueName, 0,
+ (DWORD) type, (BYTE *) data, (DWORD) length);
Tcl_DStringFree(&buf);
} else {
BYTE *data;
@@ -1397,8 +1377,8 @@ SetValue(
*/
data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length);
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
- (DWORD) type, data, (DWORD) length);
+ result = RegSetValueEx(key, (TCHAR *)valueName, 0,
+ (DWORD) type, data, (DWORD) length);
}
Tcl_DStringFree(&nameBuf);
@@ -1434,33 +1414,27 @@ 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;
UINT timeout = 3000;
int len;
- CONST char *str;
+ const char *str;
Tcl_Obj *objPtr;
- 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 (objc == 3) {
+ str = Tcl_GetStringFromObj(objv[1], &len);
if ((len < 2) || (*str != '-')
|| strncmp(str, "-timeout", (size_t) len)) {
- Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
- return TCL_ERROR;
+ return TCL_BREAK;
}
- if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, objv[2], (int *) &timeout) != TCL_OK) {
return TCL_ERROR;
}
}
- str = Tcl_GetStringFromObj(objv[2], &len);
+ str = Tcl_GetStringFromObj(objv[0], &len);
if (len == 0) {
str = NULL;
}
@@ -1469,7 +1443,7 @@ BroadcastValue(
* Use the ignore the result.
*/
- result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
+ result = SendMessageTimeoutA(HWND_BROADCAST, WM_SETTINGCHANGE,
(WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
objPtr = Tcl_NewObj();
@@ -1503,8 +1477,8 @@ AppendSystemError(
DWORD error) /* Result code from error. */
{
int length;
- WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr;
- char *msg;
+ TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
+ const char *msg;
char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
Tcl_DString ds;
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
@@ -1512,52 +1486,34 @@ AppendSystemError(
if (Tcl_IsShared(resultPtr)) {
resultPtr = Tcl_DuplicateObj(resultPtr);
}
- length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
+ length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,
0, NULL);
if (length == 0) {
- char *msgPtr;
-
- 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;
- }
+ sprintf(msgBuf, "unknown error: %ld", error);
+ msg = msgBuf;
} else {
- Tcl_Encoding encoding;
+ char *msgPtr;
- encoding = Tcl_GetEncoding(NULL, "unicode");
- Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
- Tcl_FreeEncoding(encoding);
- LocalFree(wMsgPtr);
+ Tcl_WinTCharToUtf(tMsgPtr, -1, &ds);
+ LocalFree(tMsgPtr);
- msg = Tcl_DStringValue(&ds);
+ msgPtr = Tcl_DStringValue(&ds);
length = Tcl_DStringLength(&ds);
/*
* Trim the trailing CR/LF from the system message.
*/
- if (msg[length-1] == '\n') {
- msg[--length] = 0;
+ if (msgPtr[length-1] == '\n') {
+ --length;
}
- if (msg[length-1] == '\r') {
- msg[--length] = 0;
+ if (msgPtr[length-1] == '\r') {
+ --length;
}
+ msgPtr[length] = 0;
+ msg = msgPtr;
}
sprintf(id, "%ld", error);
@@ -1599,7 +1555,7 @@ ConvertDWORD(
* Check to see if the low bit is in the first byte.
*/
- localType = (*((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 fb092ff..58a9eb4 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -175,16 +175,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);
@@ -199,7 +199,7 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
* based IO.
*/
-static Tcl_ChannelType serialChannelType = {
+static const Tcl_ChannelType serialChannelType = {
"serial", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
SerialCloseProc, /* Close proc. */
@@ -216,7 +216,7 @@ static Tcl_ChannelType serialChannelType = {
NULL, /* handler proc. */
NULL, /* wide seek proc */
SerialThreadActionProc, /* thread action proc */
- NULL, /* truncate */
+ NULL /* truncate */
};
/*
@@ -529,7 +529,7 @@ SerialCheckProc(
if (needEvent) {
infoPtr->flags |= SERIAL_PENDING;
- evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
+ evPtr = ckalloc(sizeof(SerialEvent));
evPtr->header.proc = SerialEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -708,7 +708,7 @@ SerialCloseProc(
ckfree(serialPtr->writeBuf);
serialPtr->writeBuf = NULL;
}
- ckfree((char*) serialPtr);
+ ckfree(serialPtr);
if (errorCode == 0) {
return result;
@@ -998,7 +998,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. */
{
@@ -1036,7 +1036,7 @@ SerialOutputProc(
* the channel is in non-blocking mode.
*/
- errno = EWOULDBLOCK;
+ errno = EAGAIN;
goto error1;
}
@@ -1073,7 +1073,7 @@ SerialOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
+ infoPtr->writeBuf = ckalloc(toWrite);
}
memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
@@ -1430,7 +1430,7 @@ SerialWriterThread(
HANDLE
TclWinSerialReopen(
HANDLE handle,
- CONST TCHAR *name,
+ const TCHAR *name,
DWORD access)
{
SerialInit();
@@ -1444,8 +1444,8 @@ TclWinSerialReopen(
if (CloseHandle(handle) == FALSE) {
return INVALID_HANDLE_VALUE;
}
- handle = (*tclWinProcs->createFileProc)(name, access, 0, 0,
- OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
+ handle = CreateFile(name, access, 0, 0, OPEN_EXISTING,
+ FILE_FLAG_OVERLAPPED, 0);
return handle;
}
@@ -1478,7 +1478,7 @@ TclWinOpenSerialChannel(
SerialInit();
- infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
+ infoPtr = ckalloc(sizeof(SerialInfo));
memset(infoPtr, 0, sizeof(SerialInfo));
infoPtr->validMask = permissions;
@@ -1499,10 +1499,10 @@ TclWinOpenSerialChannel(
* are shared between multiple channels (stdin/stdout).
*/
- wsprintfA(channelName, "file%lx", PTR2INT(infoPtr));
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
- (ClientData) infoPtr, permissions);
+ infoPtr, permissions);
SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
@@ -1645,17 +1645,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;
@@ -1674,18 +1674,21 @@ SerialSetOptionProc(
if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't get comm state: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
native = Tcl_WinUtfToTChar(value, -1, &ds);
- result = (*tclWinProcs->buildCommDCBProc)(native, &dcb);
+ result = BuildCommDCB(native, &dcb);
Tcl_DStringFree(&ds);
if (result == FALSE) {
if (interp != NULL) {
Tcl_AppendResult(interp, "bad value \"", value,
"\" for -mode: should be baud,parity,data,stop", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
}
@@ -1701,7 +1704,9 @@ SerialSetOptionProc(
if (!SetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't set comm state: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -1715,7 +1720,9 @@ SerialSetOptionProc(
if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't get comm state: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -1755,13 +1762,16 @@ SerialSetOptionProc(
Tcl_AppendResult(interp, "bad value \"", value,
"\" for -handshake: must be one of xonxoff, rtscts, "
"dtrdsr or none", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL);
}
return TCL_ERROR;
}
if (!SetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't set comm state: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -1775,7 +1785,9 @@ SerialSetOptionProc(
if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't get comm state: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -1789,8 +1801,9 @@ SerialSetOptionProc(
Tcl_AppendResult(interp, "bad value for -xchar: should be "
"a list of two elements with each a single character",
NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
@@ -1821,11 +1834,13 @@ SerialSetOptionProc(
}
dcb.XoffChar = (char) character;
}
- ckfree((char *) argv);
+ ckfree(argv);
if (!SetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't set comm state: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -1847,8 +1862,9 @@ SerialSetOptionProc(
Tcl_AppendResult(interp, "bad value \"", value,
"\" for -ttycontrol: should be a list of "
"signal,value pairs", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
@@ -1862,6 +1878,8 @@ SerialSetOptionProc(
(DWORD) (flag ? SETDTR : CLRDTR))) {
if (interp != NULL) {
Tcl_AppendResult(interp, "can't set DTR signal", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ "FCONFIGURE", "TTY_SIGNAL", NULL);
}
result = TCL_ERROR;
break;
@@ -1871,6 +1889,8 @@ SerialSetOptionProc(
(DWORD) (flag ? SETRTS : CLRRTS))) {
if (interp != NULL) {
Tcl_AppendResult(interp, "can't set RTS signal", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ "FCONFIGURE", "TTY_SIGNAL", NULL);
}
result = TCL_ERROR;
break;
@@ -1880,6 +1900,8 @@ SerialSetOptionProc(
(DWORD) (flag ? SETBREAK : CLRBREAK))) {
if (interp != NULL) {
Tcl_AppendResult(interp,"can't set BREAK signal",NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ "FCONFIGURE", "TTY_SIGNAL", NULL);
}
result = TCL_ERROR;
break;
@@ -1889,13 +1911,15 @@ SerialSetOptionProc(
Tcl_AppendResult(interp, "bad signal name \"", argv[i],
"\" for -ttycontrol: must be DTR, RTS or BREAK",
NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
+ NULL);
}
result = TCL_ERROR;
break;
}
}
- ckfree((char *) argv);
+ ckfree(argv);
return result;
}
@@ -1921,20 +1945,23 @@ SerialSetOptionProc(
inSize = atoi(argv[0]);
outSize = atoi(argv[1]);
}
- ckfree((char *) argv);
+ ckfree(argv);
if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
if (interp != NULL) {
Tcl_AppendResult(interp, "bad value \"", value,
"\" for -sysbuffer: should be a list of one or two "
"integers > 0", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
}
return TCL_ERROR;
}
if (!SetupComm(infoPtr->handle, inSize, outSize)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't setup comm buffers", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't setup comm buffers: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -1948,7 +1975,9 @@ SerialSetOptionProc(
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't get comm state: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -1956,7 +1985,9 @@ SerialSetOptionProc(
dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
if (!SetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't set comm state: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -1988,7 +2019,9 @@ SerialSetOptionProc(
tout.ReadTotalTimeoutConstant = msec;
if (!SetCommTimeouts(infoPtr->handle, &tout)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set comm timeouts", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't set comm timeouts: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -2025,7 +2058,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;
@@ -2050,12 +2083,14 @@ SerialGetOptionProc(
}
if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) {
char parity;
- char *stop;
+ const char *stop;
char buf[2 * TCL_INTEGER_SPACE + 16];
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't get comm state: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -2123,7 +2158,9 @@ SerialGetOptionProc(
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't get comm state: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -2199,7 +2236,9 @@ SerialGetOptionProc(
if (!GetCommModemStatus(infoPtr->handle, &status)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get tty status", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "can't get tty status: ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 1bf4f97..60cc313 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -75,6 +75,7 @@
*/
static int initialized = 0;
+static const TCHAR classname[] = TEXT("TclSocket");
TCL_DECLARE_MUTEX(socketMutex)
/*
@@ -97,13 +98,36 @@ static ProcessGlobalValue hostName = {
#define UNSELECT FALSE
/*
+ * This is needed to comply with the strict aliasing rules of GCC, but it also
+ * simplifies casting between the different sockaddr types.
+ */
+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
+
+typedef struct SocketInfo SocketInfo;
+
+typedef struct TcpFdList {
+ SocketInfo *infoPtr;
+ SOCKET fd;
+ struct TcpFdList *next;
+} TcpFdList;
+
+/*
* The following structure is used to store the data associated with each
* socket.
*/
-typedef struct SocketInfo {
+struct SocketInfo {
Tcl_Channel channel; /* Channel associated with this socket. */
- SOCKET socket; /* Windows SOCKET handle. */
+ struct TcpFdList *sockets; /* Windows SOCKET handle. */
int flags; /* Bit field comprised of the flags described
* below. */
int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE,
@@ -124,7 +148,7 @@ typedef struct SocketInfo {
int lastError; /* Error code from last message. */
struct SocketInfo *nextPtr; /* The next socket on the per-thread socket
* list. */
-} SocketInfo;
+};
/*
* The following structure is what is added to the Tcl event queue when a
@@ -182,15 +206,17 @@ static WNDCLASS windowClass;
static SocketInfo * CreateSocket(Tcl_Interp *interp, int port,
const char *host, int server, const char *myaddr,
int myport, int async);
+#if 0
static int CreateSocketAddress(LPSOCKADDR_IN sockaddrPtr,
const char *host, int port);
+#endif
static void InitSockets(void);
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(SocketInfo *infoPtr);
+static void TcpAccept(TcpFdList *fds);
static int WaitForSocketEvent(SocketInfo *infoPtr, int events,
int *errorCodePtr);
static DWORD WINAPI SocketThread(LPVOID arg);
@@ -202,6 +228,7 @@ static Tcl_EventProc SocketEventProc;
static Tcl_EventSetupProc SocketSetupProc;
static Tcl_DriverBlockModeProc TcpBlockProc;
static Tcl_DriverCloseProc TcpCloseProc;
+static Tcl_DriverClose2Proc TcpClose2Proc;
static Tcl_DriverSetOptionProc TcpSetOptionProc;
static Tcl_DriverGetOptionProc TcpGetOptionProc;
static Tcl_DriverInputProc TcpInputProc;
@@ -214,7 +241,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc;
* based IO.
*/
-static Tcl_ChannelType tcpChannelType = {
+static const Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
TcpCloseProc, /* Close proc. */
@@ -225,13 +252,13 @@ static Tcl_ChannelType tcpChannelType = {
TcpGetOptionProc, /* Get option proc. */
TcpWatchProc, /* Set up notifier to watch this channel. */
TcpGetHandleProc, /* Get an OS handle from channel. */
- NULL, /* close2proc. */
+ TcpClose2Proc, /* Close2proc. */
TcpBlockProc, /* Set socket into (non-)blocking mode. */
NULL, /* flush proc. */
NULL, /* handler proc. */
NULL, /* wide seek proc */
TcpThreadActionProc, /* thread action proc */
- NULL, /* truncate */
+ NULL /* truncate */
};
/*
@@ -260,12 +287,11 @@ InitSockets(void)
DWORD id;
WSADATA wsaData;
DWORD err;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
if (!initialized) {
initialized = 1;
- TclCreateLateExitHandler(SocketExitHandler, (ClientData) NULL);
+ TclCreateLateExitHandler(SocketExitHandler, NULL);
/*
* Create the async notification window with a new class. We must
@@ -280,12 +306,12 @@ InitSockets(void)
windowClass.hInstance = TclWinGetTclInstance();
windowClass.hbrBackground = NULL;
windowClass.lpszMenuName = NULL;
- windowClass.lpszClassName = "TclSocket";
+ windowClass.lpszClassName = classname;
windowClass.lpfnWndProc = SocketProc;
windowClass.hIcon = NULL;
windowClass.hCursor = NULL;
- if (!RegisterClassA(&windowClass)) {
+ if (!RegisterClass(&windowClass)) {
TclWinConvertError(GetLastError());
goto initFailure;
}
@@ -427,7 +453,7 @@ SocketExitHandler(
*/
TclpFinalizeSockets();
- UnregisterClass("TclSocket", TclWinGetTclInstance());
+ UnregisterClass(classname, TclWinGetTclInstance());
WSACleanup();
initialized = 0;
Tcl_MutexUnlock(&socketMutex);
@@ -455,9 +481,8 @@ SocketExitHandler(
void
TclpFinalizeSockets(void)
{
- ThreadSpecificData *tsdPtr;
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
- tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
if (tsdPtr != NULL) {
if (tsdPtr->socketThread != NULL) {
if (tsdPtr->hwnd != NULL) {
@@ -614,9 +639,9 @@ SocketCheckProc(
if ((infoPtr->readyEvents & infoPtr->watchEvents)
&& !(infoPtr->flags & SOCKET_PENDING)) {
infoPtr->flags |= SOCKET_PENDING;
- evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
+ evPtr = ckalloc(sizeof(SocketEvent));
evPtr->header.proc = SocketEventProc;
- evPtr->socket = infoPtr->socket;
+ evPtr->socket = infoPtr->sockets->fd;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
}
}
@@ -655,6 +680,7 @@ SocketEventProc(
int mask = 0;
int events;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ TcpFdList *fds;
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -667,7 +693,7 @@ SocketEventProc(
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
- if (infoPtr->socket == eventPtr->socket) {
+ if (infoPtr->sockets->fd == eventPtr->socket) {
break;
}
}
@@ -688,7 +714,9 @@ SocketEventProc(
*/
if (infoPtr->readyEvents & FD_ACCEPT) {
- TcpAccept(infoPtr);
+ for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+ TcpAccept(fds);
+ }
return 1;
}
@@ -729,7 +757,7 @@ SocketEventProc(
(WPARAM) UNSELECT, (LPARAM) infoPtr);
FD_ZERO(&readFds);
- FD_SET(infoPtr->socket, &readFds);
+ FD_SET(infoPtr->sockets->fd, &readFds);
timeout.tv_usec = 0;
timeout.tv_sec = 0;
@@ -780,7 +808,7 @@ TcpBlockProc(
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
if (mode == TCL_MODE_NONBLOCKING) {
infoPtr->flags |= SOCKET_ASYNC;
@@ -814,7 +842,7 @@ TcpCloseProc(
ClientData instanceData, /* The socket to close. */
Tcl_Interp *interp) /* Unused. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
/* TIP #218 */
int errorCode = 0;
/* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
@@ -832,7 +860,7 @@ TcpCloseProc(
* background.
*/
- if (closesocket(infoPtr->socket) == SOCKET_ERROR) {
+ if (closesocket(infoPtr->sockets->fd) == SOCKET_ERROR) {
TclWinConvertWSAError((DWORD) WSAGetLastError());
errorCode = Tcl_GetErrno();
}
@@ -845,7 +873,60 @@ TcpCloseProc(
* fear of damaging the list.
*/
- ckfree((char *) infoPtr);
+ ckfree(infoPtr);
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpClose2Proc --
+ *
+ * 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.
+ *
+ * Results:
+ * 0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ * Shuts down one side of the socket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpClose2Proc(
+ ClientData instanceData, /* The socket to close. */
+ Tcl_Interp *interp, /* For error reporting. */
+ int flags) /* Flags that indicate which side to close. */
+{
+ SocketInfo *infoPtr = instanceData;
+ int errorCode = 0;
+ int sd;
+
+ /*
+ * Shutdown the OS socket handle.
+ */
+ switch(flags)
+ {
+ case TCL_CLOSE_READ:
+ sd=SD_RECEIVE;
+ break;
+ case TCL_CLOSE_WRITE:
+ sd=SD_SEND;
+ break;
+ default:
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "Socket close2proc called bidirectionally", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (shutdown(infoPtr->sockets->fd,sd) == SOCKET_ERROR) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ errorCode = Tcl_GetErrno();
+ }
+
return errorCode;
}
@@ -869,12 +950,15 @@ static SocketInfo *
NewSocketInfo(
SOCKET socket)
{
- SocketInfo *infoPtr;
- /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
+ SocketInfo *infoPtr = ckalloc(sizeof(SocketInfo));
+ TcpFdList *fds = ckalloc(sizeof(TcpFdList));
- infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
+ fds->fd = socket;
+ fds->next = NULL;
+ fds->infoPtr = infoPtr;
+ /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
infoPtr->channel = 0;
- infoPtr->socket = socket;
+ infoPtr->sockets = fds;
infoPtr->flags = 0;
infoPtr->watchEvents = 0;
infoPtr->readyEvents = 0;
@@ -927,12 +1011,13 @@ CreateSocket(
u_long flag = 1; /* Indicates nonblocking mode. */
int asyncConnect = 0; /* Will be 1 if async connect is in
* progress. */
- SOCKADDR_IN sockaddr; /* Socket address */
- SOCKADDR_IN mysockaddr; /* Socket address for client */
+ unsigned short chosenport = 0;
+ struct addrinfo *addrlist = NULL, *addrPtr; /* socket address */
+ struct addrinfo *myaddrlist = NULL, *myaddrPtr; /* Socket address for client */
+ const char *errorMsg = NULL;
SOCKET sock = INVALID_SOCKET;
- SocketInfo *infoPtr; /* The returned value. */
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ SocketInfo *infoPtr = NULL; /* The returned value. */
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
/*
* Check that WinSock is initialized; do not call it if not, to prevent
@@ -944,112 +1029,195 @@ CreateSocket(
return NULL;
}
- if (!CreateSocketAddress(&sockaddr, host, port)) {
+ if (!TclCreateSocketAddress(interp, &addrlist, host, port, server, &errorMsg)) {
goto error;
}
- if ((myaddr != NULL || myport != 0) &&
- !CreateSocketAddress(&mysockaddr, myaddr, myport)) {
+ if (!TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, &errorMsg)) {
goto error;
}
- sock = socket(AF_INET, SOCK_STREAM, 0);
- if (sock == INVALID_SOCKET) {
- goto error;
- }
+ if (server) {
+ TcpFdList *fds = NULL, *newfds;
+ for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
+ sock = socket(addrPtr->ai_family, SOCK_STREAM, 0);
+ if (sock == INVALID_SOCKET) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ continue;
+ }
- /*
- * Win-NT has a misfeature that sockets are inherited in child processes
- * by default. Turn off the inherit bit.
- */
+ /*
+ * 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);
+ SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
- /*
- * Set kernel space buffering
- */
+ /*
+ * Set kernel space buffering
+ */
- TclSockMinimumBuffers((int) sock, TCP_BUFFER_SIZE);
+ TclSockMinimumBuffers((ClientData)sock, TCP_BUFFER_SIZE);
- 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.
- */
+ /*
+ * 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);
+ }
- if (bind(sock, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN))
- == SOCKET_ERROR) {
- goto error;
- }
+ /*
+ * 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.
+ */
- /*
- * 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 (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
+ == SOCKET_ERROR) {
+ TclWinConvertWSAError((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);
+ }
+ }
- if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
- goto error;
- }
+ /*
+ * 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).
+ */
- /*
- * Add this socket to the global list of sockets.
- */
+ if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ closesocket(sock);
+ continue;
+ }
- infoPtr = NewSocketInfo(sock);
+ if (infoPtr == NULL) {
+ /*
+ * Add this socket to the global list of sockets.
+ */
- /*
- * Set up the select mask for connection request events.
- */
+ infoPtr = NewSocketInfo(sock);
+ fds = infoPtr->sockets;
- infoPtr->selectEvents = FD_ACCEPT;
- infoPtr->watchEvents |= FD_ACCEPT;
+ /*
+ * Set up the select mask for connection request events.
+ */
- } else {
- /*
- * Try to bind to a local port, if specified.
- */
+ infoPtr->selectEvents = FD_ACCEPT;
+ infoPtr->watchEvents |= FD_ACCEPT;
- if (myaddr != NULL || myport != 0) {
- if (bind(sock, (SOCKADDR *) &mysockaddr, sizeof(SOCKADDR_IN))
- == SOCKET_ERROR) {
- goto error;
+ } else {
+ newfds = ckalloc(sizeof(TcpFdList));
+ memset(newfds, (int) 0, sizeof(TcpFdList));
+ newfds->fd = sock;
+ newfds->infoPtr = infoPtr;
+ newfds->next = NULL;
+ fds->next = newfds;
+ fds = newfds;
}
}
+ } else {
+ for (addrPtr = addrlist; addrPtr != NULL;
+ addrPtr = addrPtr->ai_next) {
+ for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
+ myaddrPtr = myaddrPtr->ai_next) {
+ /*
+ * No need to try combinations of local and remote addresses
+ * of different families.
+ */
+ if (myaddrPtr->ai_family != addrPtr->ai_family) {
+ continue;
+ }
- /*
- * Set the socket into nonblocking mode if the connect should be done
- * in the background.
- */
+ sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
+ if (sock == INVALID_SOCKET) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ continue;
+ }
- if (async) {
- if (ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) {
- goto error;
- }
- }
+ /*
+ * Win-NT has a misfeature that sockets are inherited in child
+ * processes by default. Turn off the inherit bit.
+ */
- /*
- * Attempt to connect to the remote socket.
- */
+ SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
- if (connect(sock, (SOCKADDR *) &sockaddr,
- sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
- TclWinConvertWSAError((DWORD) WSAGetLastError());
- if (Tcl_GetErrno() != EWOULDBLOCK) {
- goto error;
- }
+ /*
+ * Set kernel space buffering
+ */
- /*
- * The connection is progressing in the background.
- */
+ TclSockMinimumBuffers((ClientData)sock, TCP_BUFFER_SIZE);
+
+ /*
+ * Try to bind to a local port.
+ */
+
+ if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
+ == SOCKET_ERROR) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ goto looperror;
+ }
+ /*
+ * Set the socket into nonblocking mode if the connect should
+ * be done in the background.
+ */
+ if (async) {
+ if (ioctlsocket(sock, (long) FIONBIO, &flag)
+ == SOCKET_ERROR) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ goto looperror;
+ }
+ }
+
+ /*
+ * Attempt to connect to the remote socket.
+ */
+
+ if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
+ == SOCKET_ERROR) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ if (Tcl_GetErrno() != EAGAIN) {
+ goto looperror;
+ }
+
+ /*
+ * The connection is progressing in the background.
+ */
- asyncConnect = 1;
+ asyncConnect = 1;
+ goto connected;
+ } else {
+ goto connected;
+ }
+ looperror:
+ if (sock != INVALID_SOCKET) {
+ closesocket(sock);
+ sock = INVALID_SOCKET;
+ }
+ }
}
+ goto error;
+ connected:
/*
* Add this socket to the global list of sockets.
*/
@@ -1057,8 +1225,8 @@ CreateSocket(
infoPtr = NewSocketInfo(sock);
/*
- * Set up the select mask for read/write events. If the connect
- * attempt has not completed, include connect events.
+ * Set up the select mask for read/write events. If the
+ * connect attempt has not completed, include connect events.
*/
infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
@@ -1068,18 +1236,24 @@ CreateSocket(
}
}
+ error:
+ if (addrlist == NULL)
+ freeaddrinfo(addrlist);
+ if (myaddrlist == NULL)
+ freeaddrinfo(myaddrlist);
+
/*
* 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);
+ if (infoPtr != NULL) {
+ ioctlsocket(sock, (long) FIONBIO, &flag);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr);
- return infoPtr;
+ return infoPtr;
+ }
- error:
- TclWinConvertWSAError((DWORD) WSAGetLastError());
if (interp != NULL) {
Tcl_AppendResult(interp, "couldn't open socket: ",
Tcl_PosixError(interp), NULL);
@@ -1090,6 +1264,7 @@ CreateSocket(
return NULL;
}
+#if 0
/*
*----------------------------------------------------------------------
*
@@ -1161,6 +1336,7 @@ CreateSocketAddress(
sockaddrPtr->sin_addr.s_addr = addr.s_addr;
return 1; /* Success. */
}
+#endif
/*
*----------------------------------------------------------------------
@@ -1187,8 +1363,7 @@ WaitForSocketEvent(
{
int result = 1;
int oldMode;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
/*
* Be sure to disable event servicing so we are truly modal.
@@ -1214,7 +1389,7 @@ WaitForSocketEvent(
} else if (infoPtr->readyEvents & events) {
break;
} else if (infoPtr->flags & SOCKET_ASYNC) {
- *errorCodePtr = EWOULDBLOCK;
+ *errorCodePtr = EAGAIN;
result = 0;
break;
}
@@ -1273,10 +1448,10 @@ Tcl_OpenTcpClient(
return NULL;
}
- wsprintfA(channelName, "sock%d", infoPtr->socket);
+ sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
+ infoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
@@ -1320,13 +1495,13 @@ Tcl_MakeTcpClientChannel(
return NULL;
}
- tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ tsdPtr = TclThreadDataKeyGet(&dataKey);
/*
* Set kernel space buffering and non-blocking.
*/
- TclSockMinimumBuffers(PTR2INT(sock), TCP_BUFFER_SIZE);
+ TclSockMinimumBuffers((ClientData) sock, TCP_BUFFER_SIZE);
infoPtr = NewSocketInfo((SOCKET) sock);
@@ -1338,9 +1513,9 @@ Tcl_MakeTcpClientChannel(
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) SELECT, (LPARAM) infoPtr);
- wsprintfA(channelName, "sock%d", infoPtr->socket);
+ sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
+ infoPtr, (TCL_READABLE | TCL_WRITABLE));
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
return infoPtr->channel;
}
@@ -1391,10 +1566,10 @@ Tcl_OpenTcpServer(
infoPtr->acceptProc = acceptProc;
infoPtr->acceptProcData = acceptProcData;
- wsprintfA(channelName, "sock%d", infoPtr->socket);
+ sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) infoPtr, 0);
+ infoPtr, 0);
if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
@@ -1423,15 +1598,15 @@ Tcl_OpenTcpServer(
static void
TcpAccept(
- SocketInfo *infoPtr) /* Socket to accept. */
+ TcpFdList *fds) /* Socket to accept. */
{
SOCKET newSocket;
SocketInfo *newInfoPtr;
+ SocketInfo *infoPtr = fds->infoPtr;
SOCKADDR_IN addr;
int len;
char channelName[16 + TCL_INTEGER_SPACE];
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
/*
* Accept the incoming connection request.
@@ -1439,8 +1614,7 @@ TcpAccept(
len = sizeof(SOCKADDR_IN);
- newSocket = accept(infoPtr->socket, (SOCKADDR *)&addr,
- &len);
+ newSocket = accept(fds->fd, (SOCKADDR *)&addr, &len);
/*
* Protect access to sockets (acceptEventCount, readyEvents) in socketList
@@ -1497,9 +1671,9 @@ TcpAccept(
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) SELECT, (LPARAM) newInfoPtr);
- wsprintfA(channelName, "sock%d", newInfoPtr->socket);
+ sprintf(channelName, "sock%Id", (size_t) newInfoPtr->sockets->fd);
newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
+ newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
@@ -1516,7 +1690,7 @@ TcpAccept(
*/
if (infoPtr->acceptProc != NULL) {
- (infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel,
+ infoPtr->acceptProc(infoPtr->acceptProcData, newInfoPtr->channel,
inet_ntoa(addr.sin_addr), ntohs(addr.sin_port));
}
}
@@ -1545,11 +1719,10 @@ TcpInputProc(
int toRead, /* Maximum number of bytes to read. */
int *errorCodePtr) /* Where to store error codes. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
int bytesRead;
DWORD error;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
*errorCodePtr = 0;
@@ -1593,7 +1766,7 @@ TcpInputProc(
while (1) {
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) UNSELECT, (LPARAM) infoPtr);
- bytesRead = recv(infoPtr->socket, buf, toRead, 0);
+ bytesRead = recv(infoPtr->sockets->fd, buf, toRead, 0);
infoPtr->readyEvents &= ~(FD_READ);
/*
@@ -1683,11 +1856,10 @@ TcpOutputProc(
int toWrite, /* Maximum number of bytes to write. */
int *errorCodePtr) /* Where to store error codes. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
int bytesWritten;
DWORD error;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
*errorCodePtr = 0;
@@ -1715,7 +1887,7 @@ TcpOutputProc(
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) UNSELECT, (LPARAM) infoPtr);
- bytesWritten = send(infoPtr->socket, buf, toWrite, 0);
+ bytesWritten = send(infoPtr->sockets->fd, buf, toWrite, 0);
if (bytesWritten != SOCKET_ERROR) {
/*
* Since Windows won't generate a new write event until we hit an
@@ -1741,7 +1913,7 @@ TcpOutputProc(
if (error == WSAEWOULDBLOCK) {
infoPtr->readyEvents &= ~(FD_WRITE);
if (infoPtr->flags & SOCKET_ASYNC) {
- *errorCodePtr = EWOULDBLOCK;
+ *errorCodePtr = EAGAIN;
bytesWritten = -1;
break;
}
@@ -1793,9 +1965,9 @@ TcpSetOptionProc(
const char *value) /* New value for option. */
{
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- SocketInfo *infoPtr;
+ SocketInfo *infoPtr = instanceData;
SOCKET sock;
-#endif
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
/*
* Check that WinSock is initialized; do not call it if not, to prevent
@@ -1811,8 +1983,7 @@ TcpSetOptionProc(
}
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- infoPtr = (SocketInfo *) instanceData;
- sock = infoPtr->socket;
+ sock = infoPtr->sockets->fd;
if (!strcasecmp(optionName, "-keepalive")) {
BOOL val = FALSE;
@@ -1894,14 +2065,12 @@ TcpGetOptionProc(
Tcl_DString *dsPtr) /* Where to store the computed value;
* initialized by caller. */
{
- SocketInfo *infoPtr;
- SOCKADDR_IN sockname;
- SOCKADDR_IN peername;
- struct hostent *hostEntPtr;
+ SocketInfo *infoPtr = instanceData;
+ char host[NI_MAXHOST], port[NI_MAXSERV];
SOCKET sock;
- int size = sizeof(SOCKADDR_IN);
size_t len = 0;
- char buf[TCL_INTEGER_SPACE];
+ int reverseDNS = 0;
+#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
/*
* Check that WinSock is initialized; do not call it if not, to prevent
@@ -1916,8 +2085,7 @@ TcpGetOptionProc(
return TCL_ERROR;
}
- infoPtr = (SocketInfo *) instanceData;
- sock = (int) infoPtr->socket;
+ sock = infoPtr->sockets->fd;
if (optionName != NULL) {
len = strlen(optionName);
}
@@ -1929,7 +2097,7 @@ TcpGetOptionProc(
int ret;
optlen = sizeof(int);
- ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR,
+ ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
(char *)&err, &optlen);
if (ret == SOCKET_ERROR) {
err = WSAGetLastError();
@@ -1941,28 +2109,27 @@ TcpGetOptionProc(
return TCL_OK;
}
+ if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
+ reverseDNS = NI_NUMERICHOST;
+ }
+
if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
(strncmp(optionName, "-peername", len) == 0))) {
- if (getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) {
+ address peername;
+ socklen_t size = sizeof(peername);
+ if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &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);
+ 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 {
@@ -1989,25 +2156,53 @@ TcpGetOptionProc(
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);
- }
- 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);
- }
- if (hostEntPtr != NULL) {
- Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
- } else {
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+ TcpFdList *fds;
+ address sockname;
+ socklen_t size;
+ int found = 0;
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-sockname");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ for (fds = infoPtr->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);
+
+ /*
+ * 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);
}
- TclFormatInt(buf, ntohs(sockname.sin_port));
- Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ if (found) {
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
} else {
@@ -2051,8 +2246,7 @@ TcpGetOptionProc(
Tcl_DStringAppendElement(dsPtr, "-nagle");
}
optlen = sizeof(BOOL);
- getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt,
- &optlen);
+ getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
if (opt) {
Tcl_DStringAppendElement(dsPtr, "0");
} else {
@@ -2101,7 +2295,7 @@ TcpWatchProc(
* TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
/*
* Update the watch events mask. Only if the socket is not a server
@@ -2152,9 +2346,9 @@ TcpGetHandleProc(
int direction, /* Not used. */
ClientData *handlePtr) /* Where to store the handle. */
{
- SocketInfo *statePtr = (SocketInfo *) instanceData;
+ SocketInfo *statePtr = instanceData;
- *handlePtr = (ClientData) statePtr->socket;
+ *handlePtr = INT2PTR(statePtr->sockets->fd);
return TCL_OK;
}
@@ -2179,13 +2373,13 @@ SocketThread(
LPVOID arg)
{
MSG msg;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg);
+ ThreadSpecificData *tsdPtr = arg;
/*
* Create a dummy window receiving socket events.
*/
- tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket",
+ tsdPtr->hwnd = CreateWindow(classname, classname,
WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg);
/*
@@ -2294,7 +2488,7 @@ SocketProc(
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
- if (infoPtr->socket == socket) {
+ if (infoPtr->sockets->fd == socket) {
/*
* Update the socket state.
*
@@ -2354,14 +2548,14 @@ SocketProc(
case SOCKET_SELECT:
infoPtr = (SocketInfo *) lParam;
if (wParam == SELECT) {
- WSAAsyncSelect(infoPtr->socket, hwnd,
+ WSAAsyncSelect(infoPtr->sockets->fd, hwnd,
SOCKET_MESSAGE, infoPtr->selectEvents);
} else {
/*
* Clear the selection mask
*/
- WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0);
+ WSAAsyncSelect(infoPtr->sockets->fd, hwnd, 0, 0);
}
break;
@@ -2416,16 +2610,16 @@ InitializeHostName(
int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
- WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1];
- DWORD length = sizeof(wbuf) / sizeof(WCHAR);
+ TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1];
+ DWORD length = MAX_COMPUTERNAME_LENGTH + 1;
Tcl_DString ds;
- if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) {
+ if (GetComputerName(tbuf, &length) != 0) {
/*
* Convert string from native to UTF then change to lowercase.
*/
- Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds));
+ Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds));
} else {
Tcl_DStringInit(&ds);
@@ -2454,7 +2648,7 @@ InitializeHostName(
*encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
*lengthPtr = Tcl_DStringLength(&ds);
- *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
+ *valuePtr = ckalloc((*lengthPtr) + 1);
memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
Tcl_DStringFree(&ds);
}
@@ -2480,7 +2674,7 @@ InitializeHostName(
int
TclWinGetSockOpt(
- int s,
+ SOCKET s,
int level,
int optname,
char * optval,
@@ -2496,12 +2690,12 @@ TclWinGetSockOpt(
return SOCKET_ERROR;
}
- return getsockopt((SOCKET)s, level, optname, optval, optlen);
+ return getsockopt(s, level, optname, optval, optlen);
}
int
TclWinSetSockOpt(
- int s,
+ SOCKET s,
int level,
int optname,
const char * optval,
@@ -2517,7 +2711,7 @@ TclWinSetSockOpt(
return SOCKET_ERROR;
}
- return setsockopt((SOCKET)s, level, optname, optval, optlen);
+ return setsockopt(s, level, optname, optval, optlen);
}
u_short
@@ -2577,7 +2771,7 @@ TcpThreadActionProc(
int action)
{
ThreadSpecificData *tsdPtr;
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
int notifyCmd;
if (action == TCL_CHANNEL_THREAD_INSERT) {
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index d0bbb09..6ef1157 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -9,6 +9,9 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
/*
@@ -29,7 +32,6 @@
* Forward declarations of functions defined later in this file:
*/
-int TclplatformtestInit(Tcl_Interp *interp);
static int TesteventloopCmd(ClientData dummy, Tcl_Interp *interp,
int argc, const char **argv);
static int TestvolumetypeCmd(ClientData dummy,
@@ -187,7 +189,7 @@ TestvolumetypeCmd(
#define VOL_BUF_SIZE 32
int found;
char volType[VOL_BUF_SIZE];
- char *path;
+ const char *path;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?name?");
@@ -419,7 +421,7 @@ TestExceptionCmd(
int objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
{
- static const char *cmds[] = {
+ static const char *const cmds[] = {
"access_violation", "datatype_misalignment", "array_bounds",
"float_denormal", "float_divbyzero", "float_inexact",
"float_invalidop", "float_overflow", "float_stack", "float_underflow",
@@ -476,28 +478,6 @@ 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
@@ -508,22 +488,6 @@ 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 = {
@@ -535,72 +499,14 @@ TestplatformChmod(
PACL curAcl, newAcl = 0;
WORD j;
SID *userSid = 0;
- TCHAR *userDomain = 0;
+ char *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 = GetFileAttributes(nativePath);
+ attr = GetFileAttributesA(nativePath);
/*
* nativePath not found
@@ -612,11 +518,10 @@ TestplatformChmod(
}
/*
- * If no ACL API is present or nativePath is not a directory, there is no
- * special handling.
+ * If nativePath is not a directory, there is no special handling.
*/
- if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
+ if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
goto done;
}
@@ -632,15 +537,15 @@ TestplatformChmod(
* obtains the size of the security descriptor.
*/
- if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) {
+ if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
DWORD secDescLen2 = 0;
if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
goto done;
}
- secDesc = (BYTE *) ckalloc(secDescLen);
- if (!getFileSecurityProc(nativePath, infoBits,
+ secDesc = ckalloc(secDescLen);
+ if (!GetFileSecurityA(nativePath, infoBits,
(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
|| (secDescLen < secDescLen2)) {
goto done;
@@ -651,22 +556,22 @@ TestplatformChmod(
* Get the World SID.
*/
- userSid = (SID *) ckalloc(getSidLengthRequiredProc((UCHAR) 1));
- initializeSidProc(userSid, &userSidAuthority, (BYTE) 1);
- *(getSidSubAuthorityProc(userSid, 0)) = SECURITY_WORLD_RID;
+ userSid = ckalloc(GetSidLengthRequired((UCHAR) 1));
+ InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
+ *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;
/*
* If curAclPresent == false then curAcl and curAclDefaulted not valid.
*/
- if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR) secDesc,
+ if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc,
&curAclPresent, &curAcl, &curAclDefaulted)) {
goto done;
}
if (!curAclPresent || !curAcl) {
ACLSize.AclBytesInUse = 0;
ACLSize.AceCount = 0;
- } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize),
+ } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize),
AclSizeInformation)) {
goto done;
}
@@ -676,14 +581,14 @@ TestplatformChmod(
*/
newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
- + getLengthSidProc(userSid) - sizeof(DWORD);
- newAcl = (ACL *) ckalloc(newAclSize);
+ + GetLengthSid(userSid) - sizeof(DWORD);
+ newAcl = ckalloc(newAclSize);
/*
* Initialize the new ACL.
*/
- if (!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) {
+ if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
goto done;
}
@@ -691,7 +596,7 @@ TestplatformChmod(
* Add denied to make readonly, this will be known as a "read-only tag".
*/
- if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION,
+ if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION,
readOnlyMask, userSid)) {
goto done;
}
@@ -701,7 +606,7 @@ TestplatformChmod(
LPVOID pACE2;
ACE_HEADER *phACE2;
- if (!getAceProc(curAcl, j, &pACE2)) {
+ if (!GetAce(curAcl, j, &pACE2)) {
goto done;
}
@@ -724,7 +629,7 @@ TestplatformChmod(
ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2;
if (pACEd->Mask == readOnlyMask
- && equalSidProc(userSid, (PSID) &pACEd->SidStart)) {
+ && EqualSid(userSid, (PSID) &pACEd->SidStart)) {
acl_readOnly_found = TRUE;
continue;
}
@@ -734,7 +639,7 @@ TestplatformChmod(
* Copy the current ACE from the old to the new ACL.
*/
- if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, (PACL *)pACE2,
+ if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
((PACE_HEADER) pACE2)->AceSize)) {
goto done;
}
@@ -744,7 +649,7 @@ TestplatformChmod(
* Apply the new ACL.
*/
- if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc(
+ if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
(LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION,
NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
res = 0;
@@ -752,13 +657,13 @@ TestplatformChmod(
done:
if (secDesc) {
- ckfree((char *) secDesc);
+ ckfree(secDesc);
}
if (newAcl) {
- ckfree((char *) newAcl);
+ ckfree(newAcl);
}
if (userSid) {
- ckfree((char *) userSid);
+ ckfree(userSid);
}
if (userDomain) {
ckfree(userDomain);
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 8544e71..102fd40 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -5,6 +5,7 @@
*
* 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.
@@ -142,7 +143,7 @@ typedef struct allocMutex {
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
@@ -260,7 +261,7 @@ TclpThreadExit(
Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
- return (Tcl_ThreadId) INT2PTR(GetCurrentThreadId());
+ return (Tcl_ThreadId)(size_t)GetCurrentThreadId();
}
/*
@@ -502,7 +503,7 @@ Tcl_MutexLock(
*/
if (*mutexPtr == NULL) {
- csPtr = (CRITICAL_SECTION *) ckalloc(sizeof(CRITICAL_SECTION));
+ csPtr = ckalloc(sizeof(CRITICAL_SECTION));
InitializeCriticalSection(csPtr);
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
@@ -563,7 +564,7 @@ TclpFinalizeMutex(
if (csPtr != NULL) {
DeleteCriticalSection(csPtr);
- ckfree((char *) csPtr);
+ ckfree(csPtr);
*mutexPtr = NULL;
}
}
@@ -594,7 +595,7 @@ void
Tcl_ConditionWait(
Tcl_Condition *condPtr, /* Really (WinCondition **) */
Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */
- Tcl_Time *timePtr) /* Timeout on waiting period */
+ const Tcl_Time *timePtr) /* Timeout on waiting period */
{
WinCondition *winCondPtr; /* Per-condition queue head */
CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */
@@ -633,8 +634,7 @@ Tcl_ConditionWait(
* and initializing that may drop back into the Master Lock.
*/
- Tcl_CreateThreadExitHandler(FinalizeConditionEvent,
- (ClientData) tsdPtr);
+ Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr);
}
}
@@ -646,7 +646,7 @@ Tcl_ConditionWait(
*/
if (*condPtr == NULL) {
- winCondPtr = (WinCondition *) ckalloc(sizeof(WinCondition));
+ winCondPtr = ckalloc(sizeof(WinCondition));
InitializeCriticalSection(&winCondPtr->condLock);
winCondPtr->firstPtr = NULL;
winCondPtr->lastPtr = NULL;
@@ -695,7 +695,8 @@ Tcl_ConditionWait(
while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) {
ResetEvent(tsdPtr->condEvent);
LeaveCriticalSection(&winCondPtr->condLock);
- if (WaitForSingleObject(tsdPtr->condEvent, wtime) == WAIT_TIMEOUT) {
+ if (WaitForSingleObjectEx(tsdPtr->condEvent, wtime,
+ TRUE) == WAIT_TIMEOUT) {
timeout = 1;
}
EnterCriticalSection(&winCondPtr->condLock);
@@ -856,7 +857,7 @@ TclpFinalizeCondition(
if (winCondPtr != NULL) {
DeleteCriticalSection(&winCondPtr->condLock);
- ckfree((char *) winCondPtr);
+ ckfree(winCondPtr);
*condPtr = NULL;
}
}
@@ -899,7 +900,7 @@ TclpFreeAllocMutex(
void *
TclpGetAllocCache(void)
{
- VOID *result;
+ void *result;
if (!once) {
/*
@@ -964,6 +965,61 @@ 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
deleted file mode 100644
index 41bc7aa..0000000
--- a/win/tclWinThrd.h
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * 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 3ae108b..d3e19c0 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -27,11 +27,11 @@
* month, where index 1 is January.
*/
-static int normalDays[] = {
+static const int normalDays[] = {
-1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364
};
-static int leapDays[] = {
+static const int leapDays[] = {
-1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365
};
@@ -87,7 +87,7 @@ typedef struct TimeInfo {
} TimeInfo;
static TimeInfo timeInfo = {
- { NULL },
+ { NULL, 0, 0, NULL, NULL, 0 },
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;
@@ -252,7 +252,7 @@ void
Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
- (*tclGetTimeProcPtr) (timePtr, tclTimeClientData);
+ tclGetTimeProcPtr(timePtr, tclTimeClientData);
}
/*
@@ -414,7 +414,7 @@ NativeGetTime(
WaitForSingleObject(timeInfo.readyEvent, INFINITE);
CloseHandle(timeInfo.readyEvent);
- Tcl_CreateExitHandler(StopCalibration, (ClientData) NULL);
+ Tcl_CreateExitHandler(StopCalibration, NULL);
}
timeInfo.initialized = TRUE;
}
@@ -622,7 +622,7 @@ TclpGetTZName(
struct tm *
TclpGetDate(
- CONST time_t *t,
+ const time_t *t,
int useGMT)
{
struct tm *tmPtr;
@@ -734,7 +734,7 @@ ComputeGMT(
struct tm *tmPtr;
long tmp, rem;
int isLeap;
- int *days;
+ const int *days;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
tmPtr = &tsdPtr->tm;
@@ -1168,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 */
{
/*
@@ -1199,9 +1199,8 @@ 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
new file mode 100644
index 0000000..68de106
--- /dev/null
+++ b/win/tclooConfig.sh
@@ -0,0 +1,19 @@
+# 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=-DUSE_TCLOO_STUBS
+TCLOO_VERSION=0.6.3
diff --git a/win/tclsh.ico b/win/tclsh.ico
index 8bcaf48..e254318 100644
--- a/win/tclsh.ico
+++ b/win/tclsh.ico
Binary files differ